651 files changed, 79784 insertions, 24841 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index 4a176334c..d76101e98 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -34,6 +34,8 @@
      (eval . (put '$letk*              'scheme-indent-function 1))
      (eval . (put '$letconst           'scheme-indent-function 1))
      (eval . (put '$continue           'scheme-indent-function 2))
+     (eval . (put '$branch             'scheme-indent-function 3))
+     (eval . (put '$prompt             'scheme-indent-function 3))
      (eval . (put '$kargs              'scheme-indent-function 2))
      (eval . (put '$kfun               'scheme-indent-function 4))
      (eval . (put '$letrec             'scheme-indent-function 3))
diff --git a/.gitignore b/.gitignore
index 36f897261..dc8eedaf4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -67,8 +67,8 @@ guile-procedures.txt
 guile-config/guile-config
 *.go
 TAGS
-/meta/guile-2.2.pc
-/meta/guile-2.2-uninstalled.pc
+/meta/guile-3.0.pc
+/meta/guile-3.0-uninstalled.pc
 gdb-pre-inst-guile
 cscope.out
 cscope.files
diff --git a/GUILE-VERSION b/GUILE-VERSION
index 32c124c84..595e59f9c 100644
--- a/GUILE-VERSION
+++ b/GUILE-VERSION
@@ -2,10 +2,10 @@
 
 # Note: `GUILE_VERSION' is defined in `configure.ac' using `git-version-gen'.
 GUILE_MAJOR_VERSION=2
-GUILE_MINOR_VERSION=2
-GUILE_MICRO_VERSION=4
+GUILE_MINOR_VERSION=9
+GUILE_MICRO_VERSION=2
 
-GUILE_EFFECTIVE_VERSION=2.2
+GUILE_EFFECTIVE_VERSION=3.0
 
 
 # All of the shared lib versioning info.  Right now, for this to work
@@ -16,7 +16,7 @@ GUILE_EFFECTIVE_VERSION=2.2
 # See libtool info pages for more information on how and when to
 # change these.
 
-LIBGUILE_INTERFACE_CURRENT=4
-LIBGUILE_INTERFACE_REVISION=1
-LIBGUILE_INTERFACE_AGE=3
+LIBGUILE_INTERFACE_CURRENT=0
+LIBGUILE_INTERFACE_REVISION=0
+LIBGUILE_INTERFACE_AGE=0
 LIBGUILE_INTERFACE="${LIBGUILE_INTERFACE_CURRENT}:${LIBGUILE_INTERFACE_REVISION}:${LIBGUILE_INTERFACE_AGE}"
diff --git a/NEWS b/NEWS
index c20a1b5da..4ac418e76 100644
--- a/NEWS
+++ b/NEWS
@@ -1,11 +1,121 @@
 Guile NEWS --- history of user-visible changes.
-Copyright (C) 1996-2018 Free Software Foundation, Inc.
+Copyright (C) 1996-2019 Free Software Foundation, Inc.
 See the end for copying conditions.
 
 Please send Guile bug reports to bug-guile@gnu.org.
 
 
 
+Changes in alpha 2.9.3 (since alpha 2.9.2):
+
+* Notable changes
+
+** Improved just-in-time machine code generation
+
+Guile's JIT compiler emits better code for indirect procedure calls,
+atomic instructions, numeric comparisons, procedure prologues,
+well-known closures with no free variables, calls and returns, and
+allocations.  Together these improvements can speed up some benchmarks
+by up to 50%.
+
+
+
+Changes in alpha 2.9.x (since the stable 2.2 series):
+
+* Notable changes
+
+** Just-in-time code generation
+
+Guile programs now run up to 4 times faster, relative to Guile 2.2,
+thanks to just-in-time (JIT) native code generation.  Notably, this
+brings the performance of "eval" as written in Scheme back to the level
+of "eval" written in C, as in the days of Guile 1.8.
+
+See "Just-In-Time Native Code" in the manual, for more information.  JIT
+compilation will be enabled automatically and transparently.  To disable
+JIT compilation, configure Guile with `--enable-jit=no' or
+`--disable-jit'.  The default is `--enable-jit=auto', which enables the
+JIT if it is available.  See `./configure --help' for more.
+
+JIT compilation is enabled by default on x86-64, i686, ARMv7, and
+AArch64 targets.
+
+** Lower-level bytecode
+
+Relative to the virtual machine in Guile 2.2, Guile's VM instruction set
+is now more low-level.  This allows it to express more advanced
+optimizations, for example type check elision or integer
+devirtualization, and makes the task of JIT code generation easier.
+
+Note that this change can mean that for a given function, the
+corresponding number of instructions in Guile 3.0 may be higher than
+Guile 2.2, which can lead to slowdowns when the function is interpreted.
+We hope that JIT compilation more than makes up for this slight
+slowdown.
+
+** By default, GOOPS classes are not redefinable
+
+It used to be that all GOOPS classes were redefinable, at least in
+theory.  This facility was supported by an indirection in all "struct"
+instances, even though only a subset of structs would need redefinition.
+We wanted to remove this indirection, in order to speed up Guile
+records, allow immutable Guile records to eventually be described by
+classes, and allow for some optimizations in core GOOPS classes that
+shouldn't be redefined anyway.
+
+Thus in GOOPS now there are classes that are redefinable and classes
+that aren't.  By default, classes created with GOOPS are not
+redefinable.  To make a class redefinable, it should be an instance of
+`<redefinable-class>'.  See "Redefining a Class" in the manual for more
+information.
+
+* New deprecations
+
+** scm_t_uint8, etc deprecated in favor of C99 stdint.h
+
+It used to be that Guile defined its own `scm_t_uint8' because C99
+`uint8_t' wasn't widely enough available.  Now Guile finally made the
+change to use C99 types, both internally and in Guile's public headers.
+
+Note that this also applies to SCM_T_UINT8_MAX, SCM_T_INT8_MIN, for intN
+and uintN for N in 8, 16, 32, and 64.  Guile also now uses ptrdiff_t
+instead of scm_t_ptrdiff, and similarly for intmax_t, uintmax_t,
+intptr_t, and uintptr_t.
+
+* Incompatible changes
+
+** All deprecated code removed
+
+All code deprecated in Guile 2.2 has been removed.  See older NEWS, and
+check that your programs can compile without linker warnings and run
+without runtime warnings.  See "Deprecation" in the manual.
+
+In particular, the function `scm_generalized_vector_get_handle' which
+was deprecated in 2.0.9 but remained in 2.2, has now finally been
+removed. As a replacement, use `scm_array_get_handle' to get a handle
+and `scm_array_handle_rank' to check the rank.
+
+** Remove "self" field from vtables and "redefined" field from classes
+
+These fields were used as part of the machinery for class redefinition
+and is no longer needed.
+
+** VM hook manipulation simplified
+
+The low-level mechanism to instrument a running virtual machine for
+debugging and tracing has been simplified.  See "VM Hooks" in the
+manual, for more.
+
+* Changes to the distribution
+
+** New effective version
+
+The "effective version" of Guile is now 3.0, which allows parallel
+installation with other effective versions (for example, the older Guile
+2.2).  See "Parallel Installations" in the manual for full details.
+Notably, the `pkg-config' file is now `guile-3.0'.
+
+
 Changes in 2.2.4 (since 2.2.3):
 
 * New interfaces and functionality
diff --git a/README b/README
index 88da4b7f6..68c02519e 100644
--- a/README
+++ b/README
@@ -1,8 +1,8 @@
-This is version 2.2 of Guile, Project GNU's extension language library.
-Guile is an implementation of the Scheme programming language, packaged
-as a library that can be linked into applications to give them their own
-extension language.  Guile supports other languages as well, giving
-users of Guile-based applications a choice of languages.
+This is a prerelease of version 3.0 of Guile, Project GNU's extension
+language library.  Guile is an implementation of the Scheme programming
+language, packaged as a library that can be linked into applications to
+give them their own extension language.  Guile supports other languages
+as well, giving users of Guile-based applications a choice of languages.
 
 Please send bug reports to bug-guile@gnu.org.
 
@@ -263,7 +263,7 @@ switches specific to Guile you may find useful in some circumstances.
 
 Cross building Guile  =====================================================
 
-As of Guile 2.2.x, the build process produces a library, libguile-2.2,
+As of Guile 3.0.x, the build process produces a library, libguile-3.0,
 along with Guile "object files" containing bytecode to be interpreted by
 Guile's virtual machine.  The bytecode format depends on the endianness
 and word size of the host CPU.
diff --git a/acinclude.m4 b/acinclude.m4
index 70cb247aa..631f9b064 100644
--- a/acinclude.m4
+++ b/acinclude.m4
@@ -1,7 +1,7 @@
 dnl -*- Autoconf -*-
 
-dnl Copyright (C) 1997, 1999, 2000, 2001, 2002, 2004, 2006,
-dnl   2007, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+dnl Copyright (C) 1997,1999-2002,2004,2006-2011,2013,2018-2019
+dnl   Free Software Foundation, Inc.
 dnl
 dnl This file is part of GUILE
 dnl
@@ -578,3 +578,41 @@ AC_DEFUN([GUILE_CHECK_GUILE_FOR_BUILD], [
 dnl Declare file $1 to be a script that needs configuring,
 dnl and arrange to make it executable in the process.
 AC_DEFUN([GUILE_CONFIG_SCRIPT],[AC_CONFIG_FILES([$1],[chmod +x $1])])
+
+AC_DEFUN([GUILE_ENABLE_JIT], [
+  JIT_AVAILABLE=no
+  AC_MSG_CHECKING([if JIT code generation supported for target CPU])
+  case "$target_cpu" in
+    i?86|x86_64|amd64)    JIT_AVAILABLE=yes ;;
+    *arm*)                JIT_AVAILABLE=yes ;;
+    aarch64)              JIT_AVAILABLE=yes ;;
+    *)                                      ;;
+  esac
+  AC_MSG_RESULT($JIT_AVAILABLE)
+
+  AC_ARG_ENABLE(jit,
+    [AS_HELP_STRING([--enable-jit[=yes/no/auto]],
+                    [enable just-in-time code generation [default=auto]])])
+
+  AC_MSG_CHECKING([whether to enable JIT code generation])
+  case "x$enable_jit" in
+    xy*) enable_jit=yes ;;
+    xn*) enable_jit=no ;;
+    xa* | x) enable_jit=$JIT_AVAILABLE ;;
+    *)  AC_MSG_ERROR(bad value $enable_jit for --enable-jit) ;;
+  esac
+  AC_MSG_RESULT($enable_jit)
+
+  if test $enable_jit = yes; then
+    if test $JIT_AVAILABLE = no; then
+      AC_MSG_ERROR(
+        [JIT explicitly enabled with --enable-jit but not supported on $target_cpu])
+    fi
+    AC_CHECK_FUNCS(mremap ffsl isnan isinf,,)
+  fi
+
+  AM_CONDITIONAL([ENABLE_JIT], [test "$enable_jit" = "yes"])
+  ENABLE_JIT_VAL=$(if test "$enable_jit" = "yes"; then echo 1; else echo 0; fi)
+  AC_DEFINE_UNQUOTED([ENABLE_JIT], [$ENABLE_JIT_VAL],
+    [Define to 1 if JIT compilation is enabled, or 0 otherwise.])
+])
diff --git a/am/bootstrap.am b/am/bootstrap.am
index e0d4764f5..e2367b793 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -1,5 +1,5 @@
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015 Free Software Foundation, Inc.
+##        2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 ##
 ##   This file is part of GNU Guile.
 ##
@@ -64,6 +64,7 @@ SOURCES =					\
   language/tree-il/analyze.scm			\
   language/tree-il/canonicalize.scm		\
   language/tree-il/compile-cps.scm		\
+  language/tree-il/cps-primitives.scm		\
   language/tree-il/debug.scm			\
   language/tree-il/effects.scm			\
   language/tree-il/fix-letrec.scm		\
@@ -75,17 +76,14 @@ SOURCES =					\
   language/cps.scm				\
   language/cps/closure-conversion.scm		\
   language/cps/compile-bytecode.scm		\
-  language/cps/constructors.scm			\
   language/cps/contification.scm		\
   language/cps/cse.scm				\
   language/cps/dce.scm				\
+  language/cps/devirtualize-integers.scm	\
   language/cps/effects-analysis.scm		\
-  language/cps/elide-values.scm			\
-  language/cps/handle-interrupts.scm		\
   language/cps/licm.scm				\
+  language/cps/loop-instrumentation.scm		\
   language/cps/peel-loops.scm			\
-  language/cps/primitives.scm			\
-  language/cps/prune-bailouts.scm		\
   language/cps/prune-top-level-scopes.scm	\
   language/cps/reify-primitives.scm		\
   language/cps/renumber.scm			\
@@ -116,11 +114,13 @@ SOURCES =					\
   system/base/pmatch.scm			\
   system/base/syntax.scm			\
   system/base/compile.scm			\
+  system/base/optimize.scm			\
   system/base/language.scm			\
   system/base/lalr.scm				\
   system/base/message.scm			\
   system/base/target.scm			\
   system/base/types.scm				\
+  system/base/types/internal.scm		\
   system/base/ck.scm				\
 						\
   ice-9/boot-9.scm				\
diff --git a/benchmark-suite/benchmarks/structs.bm b/benchmark-suite/benchmarks/structs.bm
index 65c8e975e..465afbd24 100644
--- a/benchmark-suite/benchmarks/structs.bm
+++ b/benchmark-suite/benchmarks/structs.bm
@@ -1,7 +1,7 @@
 ;;; -*- mode: scheme; coding: iso-8859-1; -*-
 ;;; Structs.
 ;;;
-;;; Copyright 2009 Free Software Foundation, Inc.
+;;; Copyright 2009, 2017 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -25,44 +25,27 @@
 (define iterations 2000000)
 
 (define vtable2
-  (make-vtable "prpr"))
+  (make-vtable "pwpw"))
 
 (define vtable7
-  (make-vtable (string-concatenate (make-list 7 "pr"))))
+  (make-vtable (string-concatenate (make-list 7 "pw"))))
 
 
 (with-benchmark-prefix "constructors"
 
-  (benchmark "make-struct2 (opcode)" iterations
-    (make-struct vtable2 0 1 2))
+  (benchmark "make-struct2" iterations
+    (make-struct/no-tail vtable2 1 2))
 
-  (benchmark "make-struct2 (procedure)" iterations
-    (let ((s make-struct))
-      (s vtable2 0 1 2)))
-
-  (benchmark "make-struct7 (opcode)" iterations
-    (make-struct vtable7 0 1 2 3 4 5 6 7))
-
-  (benchmark "make-struct7 (procedure)" iterations
-    (let ((s make-struct))
-      (s vtable7 0 1 2 3 4 5 6 7))))
+  (benchmark "make-struct7" iterations
+    (make-struct/no-tail vtable7 1 2 3 4 5 6 7)))
 
 
 (with-benchmark-prefix "pairs" ;; for comparison
-
-  (benchmark "cons (opcode)" iterations
+  (benchmark "cons" iterations
     (cons 1 2))
 
-  (benchmark "cons (procedure)" iterations
-    (let ((c cons))
-      (c 1 2)))
-
-  (benchmark "list (opcode)" iterations
+  (benchmark "list" iterations
     (list 1 2 3 4 5 6 7))
 
-  (benchmark "list (procedure)" iterations
-    (let ((l list))
-      (l 1 2 3 4 5 6 7)))
-
   (benchmark "make-list" iterations
     (make-list 7)))
diff --git a/bootstrap/Makefile.am b/bootstrap/Makefile.am
index 91c3b93f5..bcb22cdbc 100644
--- a/bootstrap/Makefile.am
+++ b/bootstrap/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015 Free Software Foundation, Inc.
+##        2014, 2015, 2018 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -22,7 +22,12 @@
 
 
 GUILE_WARNINGS =
-GUILE_OPTIMIZATIONS = -O1
+# Loading eval.go happens before boot and therefore before modules are
+# resolved.  For some reason if compiled without resolve-primitives,
+# attempts to resolve primitives at boot fail; weird.  Should fix this
+# but in the meantime we turn on primitive resolution (which normally
+# only happens at -O2).
+GUILE_OPTIMIZATIONS = -O1 -Oresolve-primitives
 
 include $(top_srcdir)/am/bootstrap.am
 
diff --git a/configure.ac b/configure.ac
index 9073deba0..089903527 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3,39 +3,36 @@ dnl   Process this file with autoconf to produce configure.
 dnl
 
 define(GUILE_CONFIGURE_COPYRIGHT,[[
+Copyright 1998-2019 Free Software Foundation, Inc.
 
-Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-  2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017,
-  2018, 2019 Free Software Foundation, Inc.
+This file is part of Guile.
 
-This file is part of GUILE
+Guile is free software: you can redistribute it and/or modify it
+under the terms of the GNU Lesser General Public License as published
+by the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
 
-GUILE is free software; you can redistribute it and/or modify it under
-the terms of the GNU Lesser General Public License as published by the
-Free Software Foundation; either version 3, or (at your option) any
-later version.
-
-GUILE is distributed in the hope that it will be useful, but WITHOUT
+Guile is distributed in the hope that it will be useful, but WITHOUT
 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
 License for more details.
 
 You should have received a copy of the GNU Lesser General Public
-License along with GUILE; see the file COPYING.LESSER.  If not, write
-to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-Floor, Boston, MA 02110-1301, USA.
-
+License along with Guile.  If not, see
+<https://www.gnu.org/licenses/>.
 ]])
 
 AC_PREREQ(2.61)
 
 AC_INIT([GNU Guile],
-        m4_esyscmd([build-aux/git-version-gen --match  v2.\[12\].\* .tarball-version]),
+        m4_esyscmd([build-aux/git-version-gen --match v2.9.\* .tarball-version]),
         [bug-guile@gnu.org])
 AC_CONFIG_AUX_DIR([build-aux])
 AC_CONFIG_MACRO_DIR([m4])
 AC_CONFIG_SRCDIR(GUILE-VERSION)
 
+AC_CANONICAL_TARGET
+
 dnl Use `serial-tests' so the output `check-guile' is not hidden
 dnl (`parallel-tests' is the default in Automake 1.13.)
 dnl `serial-tests' was introduced in Automake 1.12.
@@ -76,7 +73,11 @@ if test "$GCC" = yes; then
   AC_MSG_RESULT([-std=gnu11])
   CC="$CC -std=gnu11"
 else
-  AC_MSG_RESULT([assuming $CC supports C11 by default])
+  dnl Guile requires C99 or later.
+  AC_PROG_CC_C99
+  if test "$ac_cv_prog_cc_c99" = "xno"; then
+    AC_MSG_ERROR([Support for C99 required but not found.])
+  fi
 fi
 
 gl_EARLY
@@ -96,9 +97,6 @@ AC_DEFINE([GNULIB_LOCK], [1],
   [Define to allow Gnulib modules to use Guile's locks.])
 
 
-dnl Guile needs C99 or later.
-gl_PROG_CC_C99
-
 # for per-target cflags in the libguile subdir
 AM_PROG_CC_C_O
 
@@ -145,6 +143,9 @@ AC_ARG_ENABLE(debug-malloc,
       [Define this if you want to debug scm_must_malloc/realloc/free calls.])
   fi)
 
+# Check if JIT is available.
+GUILE_ENABLE_JIT
+
 SCM_I_GSC_GUILE_DEBUG=0
 AC_ARG_ENABLE(guile-debug,
   [AS_HELP_STRING([--enable-guile-debug],
@@ -325,313 +326,8 @@ else
 fi
 AC_SUBST([SCM_I_GSC_T_PTRDIFF])
 
-AC_CHECK_HEADERS([stdint.h])
-AC_CHECK_HEADERS([inttypes.h])
 AC_CHECK_HEADERS([stdatomic.h])
 
-AC_CHECK_SIZEOF(intmax_t)
-
-SCM_I_GSC_NEEDS_STDINT_H=0
-SCM_I_GSC_NEEDS_INTTYPES_H=0
-
-### intptr and uintptr (try not to use inttypes if we don't have to)
-if test "$ac_cv_header_inttypes_h" = yes; then
-  if test "$ac_cv_sizeof_intptr_t" -eq 0; then
-    AC_CHECK_SIZEOF([intptr_t],,[#include <inttypes.h>
-#include <stdio.h>])
-    if test "$ac_cv_sizeof_intptr_t" -ne 0; then
-      SCM_I_GSC_NEEDS_INTTYPES_H=1
-    fi
-  fi
-  if test "$ac_cv_sizeof_uintptr_t" -eq 0; then
-    AC_CHECK_SIZEOF([uintptr_t],,[#include <inttypes.h>
-#include <stdio.h>])
-    if test "$ac_cv_sizeof_uintptr_t" -ne 0; then
-      SCM_I_GSC_NEEDS_INTTYPES_H=1
-    fi
-  fi
-fi
-
-### See what's provided by stdint.h
-if test "$ac_cv_header_stdint_h" = yes; then
-   AC_CHECK_TYPE([int8_t],[scm_stdint_has_int8=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uint8_t],[scm_stdint_has_uint8=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([int16_t],[scm_stdint_has_int16=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uint16_t],[scm_stdint_has_uint16=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([int32_t],[scm_stdint_has_int32=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uint32_t],[scm_stdint_has_uint32=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([int64_t],[scm_stdint_has_int64=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uint64_t],[scm_stdint_has_uint64=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([intmax_t],[scm_stdint_has_intmax=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uintmax_t],[scm_stdint_has_uintmax=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([intptr_t],[scm_stdint_has_intptr=1],,[#include <stdint.h>])
-   AC_CHECK_TYPE([uintptr_t],[scm_stdint_has_uintptr=1],,[#include <stdint.h>])
-fi
-
-# so we don't get confused by the cache (wish there was a better way
-# to check particular headers for the same type...)
-
-unset ac_cv_type_int8_t
-unset ac_cv_type_uint8_t
-unset ac_cv_type_int16_t
-unset ac_cv_type_uint16_t
-unset ac_cv_type_int32_t
-unset ac_cv_type_uint32_t
-unset ac_cv_type_int64_t
-unset ac_cv_type_uint64_t
-unset ac_cv_type_intmax_t
-unset ac_cv_type_uintmax_t
-
-### See what's provided by inttypes.h
-if test "$ac_cv_header_inttypes_h" = yes; then
-  AC_CHECK_TYPE([int8_t],[scm_inttypes_has_int8=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uint8_t],[scm_inttypes_has_uint8=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([int16_t],[scm_inttypes_has_int16=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uint16_t],[scm_inttypes_has_uint16=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([int32_t],[scm_inttypes_has_int32=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uint32_t],[scm_inttypes_has_uint32=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([int64_t],[scm_inttypes_has_int64=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uint64_t],[scm_inttypes_has_uint64=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([intmax_t],[scm_inttypes_has_intmax=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uintmax_t],[scm_inttypes_has_uintmax=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([intptr_t],[scm_inttypes_has_intptr=1],,[#include <inttypes.h>])
-  AC_CHECK_TYPE([uintptr_t],[scm_inttypes_has_uintptr=1],,[#include <inttypes.h>])
-fi
-
-# Try hard to find definitions for some required scm_t_*int* types.
-
-### Required type scm_t_int8
-if test "$scm_stdint_has_int8"; then
-  SCM_I_GSC_T_INT8='"int8_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_int8"; then
-  SCM_I_GSC_T_INT8='"int8_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_char" -eq 1; then
-  SCM_I_GSC_T_INT8='"signed char"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_int8.])
-fi
-AC_SUBST([SCM_I_GSC_T_INT8])
-
-### Required type scm_t_uint8
-if test "$scm_stdint_has_uint8"; then
-  SCM_I_GSC_T_UINT8='"uint8_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uint8"; then
-  SCM_I_GSC_T_UINT8='"uint8_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_unsigned_char" -eq 1; then
-  SCM_I_GSC_T_UINT8='"unsigned char"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_uint8.])
-fi
-AC_SUBST([SCM_I_GSC_T_UINT8])
-
-### Required type scm_t_int16 (ANSI C says int or short might work)
-if test "$scm_stdint_has_int16"; then
-  SCM_I_GSC_T_INT16='"int16_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_int16"; then
-  SCM_I_GSC_T_INT16='"int16_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_int" -eq 2; then
-  SCM_I_GSC_T_INT16='"int"'
-elif test "$ac_cv_sizeof_short" -eq 2; then
-  SCM_I_GSC_T_INT16='"short"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_int16.])
-fi
-AC_SUBST([SCM_I_GSC_T_INT16])
-
-### Required type scm_t_uint16 (ANSI C says int or short might work)
-if test "$scm_stdint_has_uint16"; then
-  SCM_I_GSC_T_UINT16='"uint16_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uint16"; then
-  SCM_I_GSC_T_UINT16='"uint16_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_unsigned_int" -eq 2; then
-  SCM_I_GSC_T_UINT16='"unsigned int"'
-elif test "$ac_cv_sizeof_unsigned_short" -eq 2; then
-  SCM_I_GSC_T_UINT16='"unsigned short"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_uint16.])
-fi
-AC_SUBST([SCM_I_GSC_T_UINT16])
-
-
-### Required type scm_t_int32 (ANSI C says int, short, or long might work)
-if test "$scm_stdint_has_int32"; then
-  SCM_I_GSC_T_INT32='"int32_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_int32"; then
-  SCM_I_GSC_T_INT32='"int32_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_int" -eq 4; then
-  SCM_I_GSC_T_INT32='"int"'
-elif test "$ac_cv_sizeof_long" -eq 4; then
-  SCM_I_GSC_T_INT32='"long"'
-elif test "$ac_cv_sizeof_short" -eq 4; then
-  SCM_I_GSC_T_INT32='"short"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_int32.])
-fi
-AC_SUBST([SCM_I_GSC_T_INT32])
-
-### Required type scm_t_uint32 (ANSI C says int, short, or long might work)
-if test "$scm_stdint_has_uint32"; then
-  SCM_I_GSC_T_UINT32='"uint32_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uint32"; then
-  SCM_I_GSC_T_UINT32='"uint32_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_unsigned_int" -eq 4; then
-  SCM_I_GSC_T_UINT32='"unsigned int"'
-elif test "$ac_cv_sizeof_unsigned_long" -eq 4; then
-  SCM_I_GSC_T_UINT32='"unsigned long"'
-elif test "$ac_cv_sizeof_unsigned_short" -eq 4; then
-  SCM_I_GSC_T_UINT32='"unsigned short"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_uint32.])
-fi
-AC_SUBST([SCM_I_GSC_T_UINT32])
-
-### Optional type scm_t_int64 (ANSI C says int, short, or long might work)
-### Also try 'long long' and '__int64' if we have it.
-SCM_I_GSC_T_INT64=0
-if test "$scm_stdint_has_int64"; then
-  SCM_I_GSC_T_INT64='"int64_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_int64"; then
-  SCM_I_GSC_T_INT64='"int64_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_int" -eq 8; then
-  SCM_I_GSC_T_INT64='"int"'
-elif test "$ac_cv_sizeof_long" -eq 8; then
-  SCM_I_GSC_T_INT64='"long"'
-elif test "$ac_cv_sizeof_short" -eq 8; then
-  SCM_I_GSC_T_INT64='"short"'
-elif test "$ac_cv_sizeof_long_long" -eq 8; then
-  SCM_I_GSC_T_INT64='"long long"'
-elif test "$ac_cv_sizeof___int64" -eq 8; then
-  SCM_I_GSC_T_INT64='"__int64"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_int64.])
-fi
-AC_SUBST([SCM_I_GSC_T_INT64])
-
-
-### Optional type scm_t_uint64 (ANSI C says int, short, or long might work)
-### Also try 'long long' and '__int64' if we have it.
-SCM_I_GSC_T_UINT64=0
-if test "$scm_stdint_has_uint64"; then
-  SCM_I_GSC_T_UINT64='"uint64_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uint64"; then
-  SCM_I_GSC_T_UINT64='"uint64_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_unsigned_int" -eq 8; then
-  SCM_I_GSC_T_UINT64='"unsigned int"'
-elif test "$ac_cv_sizeof_unsigned_long" -eq 8; then
-  SCM_I_GSC_T_UINT64='"unsigned long"'
-elif test "$ac_cv_sizeof_unsigned_short" -eq 8; then
-  SCM_I_GSC_T_UINT64='"unsigned short"'
-elif test "$ac_cv_sizeof_unsigned_long_long" -eq 8; then
-  SCM_I_GSC_T_UINT64='"unsigned long long"'
-elif test "$ac_cv_sizeof_unsigned___int64" -eq 8; then
-  SCM_I_GSC_T_UINT64='"unsigned __int64"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for scm_t_uint64.])
-fi
-AC_SUBST([SCM_I_GSC_T_UINT64])
-
-### Required type scm_t_intmax
-###
-### We try 'intmax_t', '__int64', 'long long' in this order.  When
-### none of them is available, we use 'long'.
-###
-SCM_I_GSC_T_INTMAX=0
-if test "$scm_stdint_has_intmax"; then
-  SCM_I_GSC_T_INTMAX='"intmax_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_intmax"; then
-  SCM_I_GSC_T_INTMAX='"intmax_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof___int64" -ne 0; then
-  SCM_I_GSC_T_INTMAX='"__int64"'
-elif test "$ac_cv_sizeof_long_long" -ne 0; then
-  SCM_I_GSC_T_INTMAX='"long long"'
-else
-  SCM_I_GSC_T_INTMAX='"long"'
-fi
-AC_SUBST([SCM_I_GSC_T_INTMAX])
-
-### Required type scm_t_uintmax
-###
-### We try 'uintmax_t', 'unsigned __int64', 'unsigned long long' in
-### this order.  When none of them is available, we use 'unsigned long'.
-###
-SCM_I_GSC_T_UINTMAX=0
-if test "$scm_stdint_has_uintmax"; then
-  SCM_I_GSC_T_UINTMAX='"uintmax_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uintmax"; then
-  SCM_I_GSC_T_UINTMAX='"uintmax_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_unsigned___int64" -ne 0; then
-  SCM_I_GSC_T_UINTMAX='"unsigned __int64"'
-elif test "$ac_cv_sizeof_unsigned_long_long" -ne 0; then
-  SCM_I_GSC_T_UINTMAX='"unsigned long long"'
-else
-  SCM_I_GSC_T_UINTMAX='"unsigned long"'
-fi
-AC_SUBST([SCM_I_GSC_T_UINTMAX])
-
-### Required type scm_t_intptr
-###
-SCM_I_GSC_T_INTPTR=0
-if test "$scm_stdint_has_intptr"; then
-  SCM_I_GSC_T_INTPTR='"intptr_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_intptr"; then
-  SCM_I_GSC_T_INTPTR='"intptr_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_int" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_INTPTR='"int"'
-elif test "$ac_cv_sizeof_long" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_INTPTR='"long"'
-elif test "$ac_cv_sizeof_long_long" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_INTPTR='"long long"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for `scm_t_intptr'.])
-fi
-AC_SUBST([SCM_I_GSC_T_INTPTR])
-
-### Required type scm_t_uintptr
-###
-SCM_I_GSC_T_UINTPTR=0
-if test "$scm_stdint_has_uintptr"; then
-  SCM_I_GSC_T_UINTPTR='"uintptr_t"'
-  SCM_I_GSC_NEEDS_STDINT_H=1
-elif test "$scm_inttypes_has_uintptr"; then
-  SCM_I_GSC_T_UINTPTR='"uintptr_t"'
-  SCM_I_GSC_NEEDS_INTTYPES_H=1
-elif test "$ac_cv_sizeof_int" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_UINTPTR='"unsigned int"'
-elif test "$ac_cv_sizeof_long" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_UINTPTR='"unsigned long"'
-elif test "$ac_cv_sizeof_long_long" = "$ac_cv_sizeof_void_p"; then
-  SCM_I_GSC_T_UINTPTR='"unsigned long long"'
-else
-  AC_MSG_ERROR([Can't find appropriate type for `scm_t_uintptr'.])
-fi
-AC_SUBST([SCM_I_GSC_T_UINTPTR])
-
-
-AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H])
-AC_SUBST([SCM_I_GSC_NEEDS_INTTYPES_H])
-
 AC_MSG_CHECKING([for which prebuilt binary set to use during bootstrap])
 SCM_PREBUILT_BINARIES=
 case "$ac_cv_c_bigendian-$ac_cv_sizeof_void_p" in
@@ -1352,6 +1048,12 @@ AC_CHECK_FUNCS([GC_pthread_exit GC_pthread_cancel GC_pthread_sigmask])
 # Functions from GC 7.3.
 AC_CHECK_FUNCS([GC_move_disappearing_link GC_is_heap_ptr])
 
+# See if there's an auxiliary stack, as in ia64.
+AC_CHECK_MEMBER([struct GC_stack_base.reg_base],
+  [SCM_I_GSC_HAVE_AUXILIARY_STACK=1], [SCM_I_GSC_HAVE_AUXILIARY_STACK=0],
+  [#include <gc/gc.h>])
+AC_SUBST([SCM_I_GSC_HAVE_AUXILIARY_STACK])
+
 LIBS="$save_LIBS"
 
 
@@ -1610,8 +1312,7 @@ case "$GCC" in
     ## <http://lists.gnu.org/archive/html/guile-devel/2012-01/msg00487.html>.
 
     POTENTIAL_GCC_CFLAGS="-Wall -Wmissing-prototypes \
-      -Wdeclaration-after-statement -Wpointer-arith \
-      -Wswitch-enum -fno-strict-aliasing -fwrapv"
+      -Wpointer-arith -fno-strict-aliasing -fwrapv"
     # Do this here so we don't screw up any of the tests above that might
     # not be "warning free"
     if test "${GUILE_ERROR_ON_WARNING}" = yes
diff --git a/doc/guile.1 b/doc/guile.1
index 7b3d23292..6097ac2e9 100644
--- a/doc/guile.1
+++ b/doc/guile.1
@@ -4,7 +4,7 @@
 .\" groff -man -Tascii foo.1
 .\"
 .\" title section date source manual
-.TH GUILE 1 "2011-03-04" GNU "GNU Guile 2.2"
+.TH GUILE 1 "2017-05-22" GNU "GNU Guile 3.0"
 .
 .SH NAME
 guile \- The GNU Project Extension Language
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 5b8db940c..5b9c5654e 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -8765,22 +8765,24 @@ for ``unboxed'', as it's stored as a raw value without additional type
 annotations.
 @end itemize
 
-The second letter for each field is a permission code,
-
-@itemize @bullet{}
-@item
-@code{w} -- writable, the field can be read and written.
-@item
-@code{r} -- read-only, the field can be read but not written.
-@item
-@end itemize
-
-Here are some examples.
+It used to be that the second letter for each field was a permission
+code, such as @code{w} for writable or @code{r} for read-only.  However
+over time structs have become more of a raw low-level facility; access
+control is better implemented as a layer on top.  After all,
+@code{struct-set!} is a cross-cutting operator that can bypass
+abstractions made by higher-level record facilities; it's not generally
+safe (in the sense of abstraction-preserving) to expose
+@code{struct-set!} to ``untrusted'' code, even if the fields happen to
+be writable.  Additionally, permission checks added overhead to every
+structure access in a way that couldn't be optimized out, hampering the
+ability of structs to act as a low-level building block.  For all of
+these reasons, all fields in Guile structs are now writable; attempting
+to make a read-only field will now issue a deprecation warning, and the
+field will be writable regardless.
 
 @example
-(make-vtable "pw")      ;; one writable field
-(make-vtable "prpw")    ;; one read-only and one writable
-(make-vtable "pwuwuw")  ;; one scheme and two unboxed
+(make-vtable "pw")      ;; one scheme field
+(make-vtable "pwuwuw")  ;; one scheme and two unboxed fields
 @end example
 
 The optional @var{print} argument is a function called by
@@ -8794,7 +8796,7 @@ The following print function for example shows the two fields of its
 structure.
 
 @example
-(make-vtable "prpw"
+(make-vtable "pwpw"
              (lambda (struct port)
                (format port "#<~a and ~a>"
                        (struct-ref struct 0)
@@ -8828,7 +8830,7 @@ new name for this functionality.
 For example,
 
 @example
-(define v (make-vtable "prpwpw"))
+(define v (make-vtable "pwpwpw"))
 (define s (make-struct/no-tail v 123 "abc" 456))
 (struct-ref s 0) @result{} 123
 (struct-ref s 1) @result{} "abc"
@@ -9024,11 +9026,11 @@ vtables with additional data:
 
 @example
 scheme@@(guile-user)> (struct-ref $3 vtable-index-layout)
-$6 = pruhsruhpwphuhuhprprpw
+$6 = pwuhuhpwphuhuhpwpwpw
 scheme@@(guile-user)> (struct-ref $4 vtable-index-layout)
-$7 = pruhsruhpwphuhuh
+$7 = pwuhuhpwphuhuh
 scheme@@(guile-user)> standard-vtable-fields 
-$8 = "pruhsruhpwphuhuh"
+$8 = "pwuhuhpwphuhuh"
 scheme@@(guile-user)> (struct-ref $2 vtable-offset-user)
 $9 = module
 @end example
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index a6cfd7b03..4fc295dc5 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2010, 2011, 2012, 2013, 2014
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2010, 2011, 2012, 2013, 2014, 2018
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -938,15 +938,15 @@ when running your program, or otherwise use the @code{call-with-vm} and
 @code{set-vm-engine!}  procedures to ensure that you are running in a VM
 with the @code{debug} engine.
 
-To digress, Guile's VM has 6 different hooks (@pxref{Hooks}) that can be
-fired at different times, which may be accessed with the following
-procedures.
+To digress, Guile's VM has 4 different hooks that can be fired at
+different times.  For implementation reasons, these hooks are not
+actually implemented with first-class Scheme hooks (@pxref{Hooks}); they
+are managed using an ad-hoc interface.
 
-The first argument of calls to these hooks is the frame in question.
-@xref{Frames}.  Some hooks may call their procedures with more
-arguments.  Since these hooks may be fired very frequently, Guile does a
-terrible thing: it allocates the frames on the C stack instead of the
-garbage-collected heap.
+VM hooks are called with one argument: the current frame.
+@xref{Frames}.  Since these hooks may be fired very frequently, Guile
+does a terrible thing: it allocates the frames on the C stack instead of
+the garbage-collected heap.
 
 The upshot here is that the frames are only valid within the dynamic
 extent of the call to the hook. If a hook procedure keeps a reference to
@@ -962,48 +962,44 @@ The interface to hooks is provided by the @code{(system vm vm)} module:
 All of these functions implicitly act on the VM for the current thread
 only.
 
-@deffn {Scheme Procedure} vm-next-hook
-The hook that will be fired before an instruction is retired (and
+@deffn {Scheme Procedure} vm-add-next-hook! f
+Arrange to call @var{f} when before an instruction is retired (and
 executed).
 @end deffn
 
-@deffn {Scheme Procedure} vm-push-continuation-hook
-The hook that will be fired after preparing a new frame. Fires just
-before applying a procedure in a non-tail context, just before the
-corresponding apply-hook.
-@end deffn
-
-@deffn {Scheme Procedure} vm-pop-continuation-hook
-The hook that will be fired before returning from a frame.
+@deffn {Scheme Procedure} vm-add-apply-hook! f
+Arrange to call @var{f} whenever a procedure is applied.  The frame
+locals will be the callee, followed by the arguments to the call.
 
-This hook fires with a variable number of arguments, corresponding to
-the values that the frame returns to its continuation.
+Note that procedure application is somewhat orthogonal to continuation
+pushes and pops.  To know whether a call is a tail call or not, with
+respect to the frame previously in place, check the value of the frame
+pointer compared the previous frame pointer.
 @end deffn
 
-@deffn {Scheme Procedure} vm-apply-hook
-The hook that will be fired before a procedure is applied. The frame's
-procedure will have already been set to the new procedure.
+@deffn {Scheme Procedure} vm-add-return-hook! f
+Arrange to call @var{f} before returning from a frame.  The values in
+the frame will be the frame's return values.
 
-Note that procedure application is somewhat orthogonal to continuation
-pushes and pops. A non-tail call to a procedure will result first in a
-firing of the push-continuation hook, then this application hook,
-whereas a tail call will run without having fired a push-continuation
-hook.
+Note that it's possible to return from an ``inner'' frame: one that was
+not immediately proceeded by a call with that frame pointer.  In that
+case, it corresponds to a non-local control flow jump, either because of
+applying a composable continuation or because of restoring a saved
+undelimited continuation.
 @end deffn
 
-@deffn {Scheme Procedure} vm-abort-continuation-hook
-The hook that will be called after aborting to a
-prompt.  @xref{Prompts}.
+@deffn {Scheme Procedure} vm-add-abort-hook!
+Arrange to call @var{f} after aborting to a prompt.  @xref{Prompts}.
 
-Like the pop-continuation hook, this hook fires with a variable number
-of arguments, corresponding to the values that returned to the
-continuation.
+Unfortunately, the values passed to the prompt handler are not easily
+available to @var{f}.
 @end deffn
 
-@deffn {Scheme Procedure} vm-restore-continuation-hook
-The hook that will be called after restoring an undelimited
-continuation. Unfortunately it's not currently possible to introspect on
-the values that were given to the continuation.
+@deffn {Scheme Procedure} vm-remove-next-hook! f
+@deffnx {Scheme Procedure} vm-remove-apply-hook! f
+@deffnx {Scheme Procedure} vm-remove-return-hook! f
+@deffnx {Scheme Procedure} vm-remove-abort-hook! f
+Remove @var{f} from the corresponding VM hook for the current thread.
 @end deffn
 
 @cindex VM trace level
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index c5f1f0dc1..cfae07fcf 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -943,8 +943,8 @@ When @code{primitive-load-path} searches the @code{%load-compiled-path}
 for a corresponding compiled file for a relative path it does so by
 appending @code{.go} to the relative path.  For example, searching for
 @code{ice-9/popen} could find
-@code{/usr/lib/guile/2.2/ccache/ice-9/popen.go}, and use it instead of
-@code{/usr/share/guile/2.2/ice-9/popen.scm}.
+@code{/usr/lib/guile/3.0/ccache/ice-9/popen.go}, and use it instead of
+@code{/usr/share/guile/3.0/ice-9/popen.scm}.
 
 If @code{primitive-load-path} does not find a corresponding @code{.go}
 file in the @code{%load-compiled-path}, or the @code{.go} file is out of
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 0b009a120..2e0036932 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -791,44 +791,6 @@ Return the source properties that correspond to the syntax object
 @var{x}.  @xref{Source Properties}, for more information.
 @end deffn
 
-And now, a bit of confession time.  Guile's syntax expander originates
-in code from Chez Scheme: a version of the expander in Chez Scheme that
-was made portable to other Scheme systems.  Way back in the mid-1990s,
-some Scheme systems didn't even have the ability to define new abstract
-data types.  For this reason, the portable expander from Chez Scheme
-that Guile inherited used tagged vectors as syntax objects: vectors
-whose first element was the symbol, @code{syntax-object}.
-
-At the time of this writing it is 2017 and Guile still has support for
-this strategy.  It worked for this long because no one ever puts a
-literal vector in the operator position:
-
-@example
-(#(syntax-object ...) 1 2 3)
-@end example
-
-But this state of affairs was an error.  Because syntax objects are just
-vectors, this makes it possible for any Scheme code to forge a syntax
-object which might cause it to violate abstraction boundaries.  You
-can't build a sandboxing facility that limits the set of bindings in
-scope when one can always escape that limit just by evaluating a special
-vector.  To fix this problem, Guile 2.2.1 finally migrated to represent
-syntax objects as a distinct type with a distinct constructor that is
-unavailable to user code.
-
-However, Guile still has to support ``legacy'' syntax objects, because
-it could be that a file compiled with Guile 2.2.0 embeds syntax objects
-of the vector kind.  Whether the expander treats the special tagged
-vectors as syntax objects is now controllable by the
-@code{allow-legacy-syntax-objects?} parameter:
-
-@deffn {Scheme Procedure} allow-legacy-syntax-objects?
-A parameter that indicates whether the expander should support legacy
-syntax objects, as described above.  For ABI stability reasons, the
-default is @code{#t}.  Use @code{parameterize} to bind it to @code{#f}.
-@xref{Parameters}.
-@end deffn
-
 Guile also offers some more experimental interfaces in a separate
 module.  As was the case with the Large Hadron Collider, it is unclear
 to our senior macrologists whether adding these interfaces will result
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index 0259b4b21..4a9125e42 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -60,13 +60,13 @@ The @code{effective-version} function returns the version name that
 should remain unchanged during a stable series.  Currently that means
 that it omits the micro version.  The effective version should be used
 for items like the versioned share directory name
-i.e.@: @file{/usr/share/guile/2.2/}
+i.e.@: @file{/usr/share/guile/3.0/}
 
 @lisp
-(version) @result{} "2.2.0"
-(effective-version) @result{} "2.2"
-(major-version) @result{} "2"
-(minor-version) @result{} "2"
+(version) @result{} "3.0.0"
+(effective-version) @result{} "3.0"
+(major-version) @result{} "3"
+(minor-version) @result{} "0"
 (micro-version) @result{} "0"
 @end lisp
 @end deffn
@@ -87,7 +87,7 @@ party package) are installed.  On Unix-like systems this is usually
 @file{/usr/share/guile/@var{GUILE_EFFECTIVE_VERSION}};
 
 @noindent
-for example @file{/usr/local/share/guile/2.2}.
+for example @file{/usr/local/share/guile/3.0}.
 @end deffn
 
 @deffn {Scheme Procedure} %site-dir
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index b3080143c..cb6b1ad35 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008-2016
+@c Copyright (C)  2008-2016, 2018
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -654,7 +654,7 @@ them together can be matched like this, using the @code{match} form from
 @smallexample
 (match cont
   (($ $kargs (x-name y-name) (x-var y-var)
-      ($ $continue k src ($ $primcall '+ (x-var y-var))))
+      ($ $continue k src ($ $primcall '+ #f (x-var y-var))))
    (format #t "Add ~a and ~a and pass the result to label ~a"
            x-var y-var k)))
 @end smallexample
@@ -684,12 +684,22 @@ source.
 There are a number of expression kinds.  Above you see an example of
 @code{$primcall}.
 
-@deftp {CPS Expression} $primcall name args
+@deftp {CPS Expression} $primcall name param args
 Perform the primitive operation identified by @code{name}, a well-known
 symbol, passing it the arguments @var{args}, and pass all resulting
-values to the continuation.  The set of available primitives includes
-all primitives known to Tree-IL and then some more; see the source code
-for details.
+values to the continuation.
+
+@var{param} is a constant parameter whose interpretation is up to the
+primcall in question.  Usually it's @code{#f} but for a primcall that
+might need some compile-time constant information -- such as
+@code{add/immediate}, which adds a constant number to a value -- the
+parameter holds this information.
+
+The set of available primitives includes many primitives known to
+Tree-IL and then some more; see the source code for details.  Note that
+some Tree-IL primcalls need to be converted to a sequence of lower-level
+CPS primcalls.  Again, see @code{(language tree-il compile-cps)} for
+full details.
 @end deftp
 
 @cindex dominate, CPS
@@ -729,29 +739,7 @@ should all be variable names.  The continuation identified by the term's
 Pass the values named by the list @var{args} to the continuation.
 @end deftp
 
-@deftp {CPS Expression} $branch kt exp
-Evaluate the branching expression @var{exp}, and continue to @var{kt}
-with zero values if the test evaluates to true.  Otherwise continue to
-the continuation named in the outer @code{$continue} term.
-
-Only certain expressions are valid in a @var{$branch}.  Compiling a
-@code{$branch} avoids allocating space for the test variable, so the
-expression should be evaluatable without temporary values.  In practice
-this condition is true for @code{$primcall}s to @code{null?}, @code{=},
-and similar primitives that have corresponding @code{br-if-@var{foo}} VM
-operations; see the source code for full details.  When in doubt, bind
-the test expression to a variable, and branch on a @code{$values}
-expression that references that variable.  The optimizer should inline
-the reference if possible.
-@end deftp
-
 @deftp {CPS Expression} $prompt escape? tag handler
-Push a prompt on the stack identified by the variable name @var{tag},
-which may be escape-only if @var{escape?} is true, and continue with
-zero values.  If the body aborts to this prompt, control will proceed at
-the continuation labelled @var{handler}, which should be a
-@code{$kreceive} continuation.  Prompts are later popped by
-@code{pop-prompt} primcalls.
 @end deftp
 
 @cindex higher-order CPS
@@ -784,21 +772,36 @@ continuation should also define @var{names}/@var{vars} bindings.
 
 The contification pass will attempt to transform the functions declared
 in a @code{$rec} into local continuations.  Any remaining @code{$fun}
-instances are later removed by the closure conversion pass.  By default,
-a closure is represented as an object built by a @code{$closure}
-expression.
-
-@deftp {CPS Expression} $closure label nfree
-Build a closure that joins the code at the continuation named
-@var{label} with space for @var{nfree} free variables.  The variables
-will be initialized later via @code{free-set!} primcalls.  This
-expression kind is part of first-order CPS.
+instances are later removed by the closure conversion pass.  If the
+function has no free variables, it gets allocated as a constant.
+
+@deftp {CPS Expression} $const-fun label
+A constant which is a function whose entry point is @var{label}.  As a
+constant, instances of @code{$const-fun} with the same @var{label} will
+not allocate; the space for the function is allocated as part of the
+compilation unit.
+
+In practice, @code{$const-fun} expressions are reified by CPS-conversion
+for functions whose call sites are not all visible within the
+compilation unit and which have no free variables.  This expression kind
+is part of first-order CPS.
 @end deftp
 
-If the closure can be proven to never escape its scope then other
-lighter-weight representations can be chosen.  Additionally, if all call
-sites are known, closure conversion will hard-wire the calls by lowering
-@code{$call} to @code{$callk}.
+Otherwise, if the closure has free variables, it will be allocated at
+its definition site via an @code{allocate-words} primcall and its free
+variables initialized there.  The code pointer in the closure is
+initialized from a @code{$code} expression.
+
+@deftp {CPS Expression} $code label
+Continue with the value of @var{label}, which should denote some
+@code{$kfun} continuation in the program.  Used when initializing the
+code pointer of closure objects.
+@end deftp
+
+However, If the closure can be proven to never escape its scope then
+other lighter-weight representations can be chosen.  Additionally, if
+all call sites are known, closure conversion will hard-wire the calls by
+lowering @code{$call} to @code{$callk}.
 
 @deftp {CPS Expression} $callk label proc args
 Like @code{$call}, but for the case where the call target is known to be
@@ -808,6 +811,52 @@ is simply an additional argument, since it is not used to determine the
 call target at run-time.
 @end deftp
 
+To summarize: a @code{$continue} is a CPS term that continues to a
+single label.  But there are other kinds of CPS terms that can continue
+to a different number of labels: @code{$branch}, @code{$throw}, and
+@code{$prompt}.
+
+@deftp {CPS Term} $branch kf kt src op param args
+Evaluate the branching primcall @var{op}, with arguments @var{args} and
+constant parameter @var{param}, and continue to @var{kt} with zero
+values if the test is true.  Otherwise continue to @var{kf}.
+
+The @code{$branch} term is like a @code{$continue} term with a
+@code{$primcall} expression, except that instead of binding a value and
+continuing to a single label, the result of the test is not bound but
+instead used to choose the continuation label.
+
+The set of operations (corresponding to @var{op} values) that are valid
+in a @var{$branch} is limited.  In the general case, bind the result of
+a test expression to a variable, and then make a @code{$branch} on a
+@code{true?} op referencing that variable.  The optimizer should inline
+the branch if possible.
+@end deftp
+
+@deftp {CPS Term} $throw src op param args
+Throw a non-resumable exception.  Throw terms do not continue at all.
+The usual value of @var{op} is @code{throw}, with two arguments
+@var{key} and @var{args}.  There are also some specific primcalls that
+compile to the VM @code{throw/value} and @code{throw/value+data}
+instructions; see the code for full details.
+
+The advantage of having @code{$throw} as a term is that, because it does
+not continue, this allows the optimizer to gather more information from
+type predicates.  For example, if the predicate is @code{char?} and the
+@var{kf} continues to a throw, the set of labels dominated by @var{kt}
+is larger than if the throw notationally continued to some label that
+would never be reached by the throw.
+@end deftp
+
+@deftp {CPS Term} $prompt k kh src escape? tag
+Push a prompt on the stack identified by the variable name @var{tag},
+which may be escape-only if @var{escape?} is true, and continue to
+@var{kh} with zero values.  If the body aborts to this prompt, control
+will proceed at the continuation labelled @var{kh}, which should be a
+@code{$kreceive} continuation.  Prompts are later popped by
+@code{pop-prompt} primcalls.
+@end deftp
+
 At this point we have described terms, expressions, and the most common
 kind of continuation, @code{$kargs}.  @code{$kargs} is used when the
 predecessors of the continuation can be instructed to pass the values
@@ -896,19 +945,24 @@ below for full details.
 @deffnx {Scheme Syntax} build-exp ,val
 @deffnx {Scheme Syntax} build-exp ($const val)
 @deffnx {Scheme Syntax} build-exp ($prim name)
-@deffnx {Scheme Syntax} build-exp ($branch kt exp)
 @deffnx {Scheme Syntax} build-exp ($fun kentry)
+@deffnx {Scheme Syntax} build-exp ($const-fun kentry)
+@deffnx {Scheme Syntax} build-exp ($code kentry)
 @deffnx {Scheme Syntax} build-exp ($rec names syms funs)
-@deffnx {Scheme Syntax} build-exp ($closure k nfree)
 @deffnx {Scheme Syntax} build-exp ($call proc (arg ...))
 @deffnx {Scheme Syntax} build-exp ($call proc args)
 @deffnx {Scheme Syntax} build-exp ($callk k proc (arg ...))
 @deffnx {Scheme Syntax} build-exp ($callk k proc args)
-@deffnx {Scheme Syntax} build-exp ($primcall name (arg ...))
-@deffnx {Scheme Syntax} build-exp ($primcall name args)
+@deffnx {Scheme Syntax} build-exp ($primcall name param (arg ...))
+@deffnx {Scheme Syntax} build-exp ($primcall name param args)
 @deffnx {Scheme Syntax} build-exp ($values (arg ...))
 @deffnx {Scheme Syntax} build-exp ($values args)
 @deffnx {Scheme Syntax} build-exp ($prompt escape? tag handler)
+@deffnx {Scheme Syntax} build-term ($branch kf kt src op param (arg ...))
+@deffnx {Scheme Syntax} build-term ($branch kf kt src op param args)
+@deffnx {Scheme Syntax} build-term ($throw src op param (arg ...))
+@deffnx {Scheme Syntax} build-term ($throw src op param args)
+@deffnx {Scheme Syntax} build-term ($prompt k kh src escape? tag)
 @deffnx {Scheme Syntax} build-cont ,val
 @deffnx {Scheme Syntax} build-cont ($kargs (name ...) (sym ...) term)
 @deffnx {Scheme Syntax} build-cont ($kargs names syms term)
@@ -949,14 +1003,15 @@ continuation of the entry to the program, which should be a function of
 no arguments.  The body of a function consists of the labelled
 continuations that are reachable from the function entry.  A program can
 refer to other functions, either via @code{$fun} and @code{$rec} in
-higher-order CPS, or via @code{$closure} and @code{$callk} in
-first-order CPS.  The program logically contains all continuations of
-all functions reachable from the entry function.  A compiler pass may
-leave unreachable continuations in a program; subsequent compiler passes
-should ensure that their transformations and analyses only take
-reachable continuations into account.  It's OK though if transformation
-runs over all continuations if including the unreachable continuations
-has no effect on the transformations on the live continuations.
+higher-order CPS, or via @code{$const-fun}, @code{$callk}, and allocated
+closures in first-order CPS.  The program logically contains all
+continuations of all functions reachable from the entry function.  A
+compiler pass may leave unreachable continuations in a program;
+subsequent compiler passes should ensure that their transformations and
+analyses only take reachable continuations into account.  It's OK though
+if transformation runs over all continuations if including the
+unreachable continuations has no effect on the transformations on the
+live continuations.
 
 @cindex intmap
 The ``soup'' itself is implemented as an @dfn{intmap}, a functional
@@ -1175,15 +1230,15 @@ compile-time from a machine-readable description of the VM.  With a few
 exceptions for certain operand types, each operand of an emit procedure
 corresponds to an operand of the corresponding instruction.
 
-Consider @code{vector-length}, from @pxref{Miscellaneous Instructions}.
+Consider @code{allocate-words}, from @pxref{Memory Access Instructions}.
 It is documented as:
 
-@deftypefn Instruction {} vector-length u12:@var{dst} u12:@var{src}
+@deftypefn Instruction {} allocate-words s12:@var{dst} s12:@var{nwords}
 @end deftypefn
 
 Therefore the emit procedure has the form:
 
-@deffn {Scheme Procedure} emit-vector-length asm dst src
+@deffn {Scheme Procedure} emit-allocate-words asm dst nwords
 @end deffn
 
 All emit procedure take the assembler as their first argument, and
@@ -1191,9 +1246,9 @@ return no useful values.
 
 The argument types depend on the operand types.  @xref{Instruction Set}.
 Most are integers within a restricted range, though labels are generally
-expressed as opaque symbols.
-
-There are a few macro-instructions as well.
+expressed as opaque symbols.  Besides the emitters that correspond to
+instructions, there are a few additional helpers defined in the
+assembler module.
 
 @deffn {Scheme Procedure} emit-label asm label
 Define a label at the current program point.
@@ -1203,15 +1258,11 @@ Define a label at the current program point.
 Associate @var{source} with the current program point.
 @end deffn
 
-@deffn {Scheme Procedure} emit-cache-current-module! asm module scope
-@deffnx {Scheme Procedure} emit-cached-toplevel-box asm dst scope sym bound?
-@deffnx {Scheme Procedure} emit-cached-module-box asm dst module-name sym public? bound?
-Macro-instructions to implement caching of top-level variables.  The
-first takes the current module, in the slot @var{module}, and associates
-it with a cache location identified by @var{scope}.  The second takes a
-@var{scope}, and resolves the variable.  @xref{Top-Level Environment
-Instructions}.  The last does not need a cached module, rather taking
-the module name directly.
+@deffn {Scheme Procedure} emit-cache-ref asm dst key
+@deffnx {Scheme Procedure} emit-cache-set! asm key val
+Macro-instructions to implement compilation-unit caches.  A single cache
+cell corresponding to @var{key} will be allocated for the compilation
+unit.
 @end deffn
 
 @deffn {Scheme Procedure} emit-load-constant asm dst constant
@@ -1237,17 +1288,6 @@ variables -- procedures that are not closures.
 Delimit a clause of a procedure.
 @end deffn
 
-@deffn {Scheme Procedure} emit-br-if-symbol asm slot invert? label
-@deffnx {Scheme Procedure} emit-br-if-variable asm slot invert? label
-@deffnx {Scheme Procedure} emit-br-if-vector asm slot invert? label
-@deffnx {Scheme Procedure} emit-br-if-string asm slot invert? label
-@deffnx {Scheme Procedure} emit-br-if-bytevector asm slot invert? label
-@deffnx {Scheme Procedure} emit-br-if-bitvector asm slot invert? label
-TC7-specific test-and-branch instructions.  The TC7 is a 7-bit code that
-is part of a heap object's type.  @xref{The SCM Type in Guile}.  Also,
-@xref{Branch Instructions}.
-@end deffn
-
 The linker is a complicated beast.  Hackers interested in how it works
 would do well do read Ian Lance Taylor's series of articles on linkers.
 Searching the internet should find them easily.  From the user's
@@ -1332,20 +1372,14 @@ company, and in a good position.  Guile's compiler needs your help.
 
 There are many possible avenues for improving Guile's compiler.
 Probably the most important improvement, speed-wise, will be some form
-of native compilation, both just-in-time and ahead-of-time. This could
-be done in many ways. Probably the easiest strategy would be to extend
-the compiled procedure structure to include a pointer to a native code
-vector, and compile from bytecode to native code at run-time after a
-procedure is called a certain number of times.
-
-The name of the game is a profiling-based harvest of the low-hanging
-fruit, running programs of interest under a system-level profiler and
-determining which improvements would give the most bang for the buck.
-It's really getting to the point though that native compilation is the
-next step.
+of optimized ahead-of-time native compilation with global register
+allocation.  A first pass could simply extend the compiler to also emit
+machine code in addition to bytecode, pre-filling the corresponding JIT
+data structures referenced by the @code{instrument-entry} bytecodes.
+@xref{Instrumentation Instructions}.
 
 The compiler also needs help at the top end, enhancing the Scheme that
-it knows to also understand R6RS, and adding new high-level compilers.
+it knows to also understand R7RS, and adding new high-level compilers.
 We have JavaScript and Emacs Lisp mostly complete, but they could use
 some love; Lua would be nice as well, but whatever language it is
 that strikes your fancy would be welcome too.
diff --git a/doc/ref/data-rep.texi b/doc/ref/data-rep.texi
index bb7f74afe..23a1bb4bf 100644
--- a/doc/ref/data-rep.texi
+++ b/doc/ref/data-rep.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2010, 2015
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2010, 2015, 2018
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -324,24 +324,28 @@ is a nightmare to maintain. Thus, the BDW-GC uses a technique called
 @dfn{conservative garbage collection}, to make the local variable list
 unnecessary.
 
-The trick to conservative collection is to treat the stack as an
-ordinary range of memory, and assume that @emph{every} word on the stack
-is a pointer into the heap.  Thus, the collector marks all objects whose
-addresses appear anywhere in the stack, without knowing for sure how
-that word is meant to be interpreted.
+The trick to conservative collection is to treat the C stack as an
+ordinary range of memory, and assume that @emph{every} word on the C
+stack is a pointer into the heap.  Thus, the collector marks all objects
+whose addresses appear anywhere in the C stack, without knowing for sure
+how that word is meant to be interpreted.
 
 In addition to the stack, the BDW-GC will also scan static data
 sections. This means that global variables are also scanned when looking
 for live Scheme objects.
 
 Obviously, such a system will occasionally retain objects that are
-actually garbage, and should be freed. In practice, this is not a
-problem. The alternative, an explicitly maintained list of local
-variable addresses, is effectively much less reliable, due to programmer
-error. Interested readers should see the BDW-GC web page at
-@uref{http://www.hboehm.info/gc/}, for more
-information.
-
+actually garbage, and should be freed.  In practice, this is not a
+problem, as the set of conservatively-scanned locations is fixed; the
+Scheme stack is maintained apart from the C stack, and is scanned
+precisely (as opposed to conservatively).  The GC-managed heap is also
+partitioned into parts that can contain pointers (such as vectors) and
+parts that can't (such as bytevectors), limiting the potential for
+confusing a raw integer with a pointer to a live object.
+
+Interested readers should see the BDW-GC web page at
+@uref{http://www.hboehm.info/gc/}, for more information on conservative
+GC in general and the BDW-GC implementation in particular.
 
 @node The SCM Type in Guile
 @subsection The SCM Type in Guile
@@ -361,24 +365,24 @@ in question is stored in that data.
 
 This section describes how the @code{SCM} type is actually represented
 and used at the C level. Interested readers should see
-@code{libguile/tags.h} for an exposition of how Guile stores type
+@code{libguile/scm.h} for an exposition of how Guile stores type
 information.
 
 In fact, there are two basic C data types to represent objects in
 Guile: @code{SCM} and @code{scm_t_bits}.
 
 @menu
-* Relationship between SCM and scm_t_bits::
-* Immediate objects::
-* Non-immediate objects::
-* Allocating Cells::
-* Heap Cell Type Information::
-* Accessing Cell Entries::
+* Relationship Between SCM and scm_t_bits::
+* Immediate Objects::
+* Non-Immediate Objects::
+* Allocating Heap Objects::
+* Heap Object Type Information::
+* Accessing Heap Object Fields::
 @end menu
 
 
-@node Relationship between SCM and scm_t_bits
-@subsubsection Relationship between @code{SCM} and @code{scm_t_bits}
+@node Relationship Between SCM and scm_t_bits
+@subsubsection Relationship Between @code{SCM} and @code{scm_t_bits}
 
 A variable of type @code{SCM} is guaranteed to hold a valid Scheme
 object.  A variable of type @code{scm_t_bits}, on the other hand, may
@@ -398,19 +402,20 @@ chapter (@pxref{Cheaper Pairs}).  Conversely, a valid bit encoding of a
 Scheme value as a @code{scm_t_bits} variable can be transformed into the
 corresponding @code{SCM} value using the @code{SCM_PACK} macro.
 
-@node Immediate objects
-@subsubsection Immediate objects
+@node Immediate Objects
+@subsubsection Immediate Objects
 
-A Scheme object may either be an immediate, i.e.@: carrying all necessary
-information by itself, or it may contain a reference to a @dfn{cell}
-with additional information on the heap.  Although in general it should
-be irrelevant for user code whether an object is an immediate or not,
-within Guile's own code the distinction is sometimes of importance.
-Thus, the following low level macro is provided:
+A Scheme object may either be an immediate, i.e.@: carrying all
+necessary information by itself, or it may contain a reference to a
+@dfn{heap object} which is, as the name implies, data on the heap.
+Although in general it should be irrelevant for user code whether an
+object is an immediate or not, within Guile's own code the distinction
+is sometimes of importance.  Thus, the following low level macro is
+provided:
 
 @deftypefn Macro int SCM_IMP (SCM @var{x})
 A Scheme object is an immediate if it fulfills the @code{SCM_IMP}
-predicate, otherwise it holds an encoded reference to a heap cell.  The
+predicate, otherwise it holds an encoded reference to a heap object.  The
 result of the predicate is delivered as a C style boolean value.  User
 code and code that extends Guile should normally not be required to use
 this macro.
@@ -471,67 +476,88 @@ to us.
 @end deftypefn
 
 
-@node Non-immediate objects
-@subsubsection Non-immediate objects
+@node Non-Immediate Objects
+@subsubsection Non-Immediate Objects
 
 A Scheme object of type @code{SCM} that does not fulfill the
-@code{SCM_IMP} predicate holds an encoded reference to a heap cell.
-This reference can be decoded to a C pointer to a heap cell using the
-@code{SCM2PTR} macro.  The encoding of a pointer to a heap cell into a
-@code{SCM} value is done using the @code{PTR2SCM} macro.
-
-@c (FIXME:: this name should be changed)
-@deftypefn Macro {scm_t_cell *} SCM2PTR (SCM @var{x})
-Extract and return the heap cell pointer from a non-immediate @code{SCM}
-object @var{x}.
+@code{SCM_IMP} predicate holds an encoded reference to a heap object.
+This reference can be decoded to a C pointer to a heap object using the
+@code{SCM_UNPACK_POINTER} macro.  The encoding of a pointer to a heap
+object into a @code{SCM} value is done using the @code{SCM_PACK_POINTER}
+macro.
+
+@cindex cells, deprecated concept
+Before Guile 2.0, Guile had a custom garbage collector that allocated
+heap objects in units of 2-word @dfn{cells}.  With the move to the
+BDW-GC collector in Guile 2.0, Guile can allocate heap objects of any
+size, and the concept of a cell is now obsolete.  Still, we mention
+it here as the name still appears in various low-level interfaces.
+
+@deftypefn Macro {scm_t_bits *} SCM_UNPACK_POINTER (SCM @var{x})
+@deftypefnx Macro {scm_t_cell *} SCM2PTR (SCM @var{x})
+Extract and return the heap object pointer from a non-immediate
+@code{SCM} object @var{x}.  The name @code{SCM2PTR} is deprecated but
+still common.
 @end deftypefn
 
-@c (FIXME:: this name should be changed)
-@deftypefn Macro SCM PTR2SCM (scm_t_cell * @var{x})
-Return a @code{SCM} value that encodes a reference to the heap cell
-pointer @var{x}.
+@deftypefn Macro SCM_PACK_POINTER (scm_t_bits * @var{x})
+@deftypefnx Macro SCM PTR2SCM (scm_t_cell * @var{x})
+Return a @code{SCM} value that encodes a reference to the heap object
+pointer @var{x}.  The name @code{PTR2SCM} is deprecated but still
+common.
 @end deftypefn
 
 Note that it is also possible to transform a non-immediate @code{SCM}
 value by using @code{SCM_UNPACK} into a @code{scm_t_bits} variable.
 However, the result of @code{SCM_UNPACK} may not be used as a pointer to
-a @code{scm_t_cell}: only @code{SCM2PTR} is guaranteed to transform a
-@code{SCM} object into a valid pointer to a heap cell.  Also, it is not
-allowed to apply @code{PTR2SCM} to anything that is not a valid pointer
-to a heap cell.
+a heap object: only @code{SCM_UNPACK_POINTER} is guaranteed to transform
+a @code{SCM} object into a valid pointer to a heap object.  Also, it is
+not allowed to apply @code{SCM_PACK_POINTER} to anything that is not a
+valid pointer to a heap object.
 
 @noindent
 Summary:  
 @itemize @bullet
 @item
-Only use @code{SCM2PTR} on @code{SCM} values for which @code{SCM_IMP} is
-false!
+Only use @code{SCM_UNPACK_POINTER} on @code{SCM} values for which
+@code{SCM_IMP} is false!
 @item
-Don't use @code{(scm_t_cell *) SCM_UNPACK (@var{x})}!  Use @code{SCM2PTR
-(@var{x})} instead!
+Don't use @code{(scm_t_cell *) SCM_UNPACK (@var{x})}!  Use
+@code{SCM_UNPACK_POINTER (@var{x})} instead!
 @item
-Don't use @code{PTR2SCM} for anything but a cell pointer!
+Don't use @code{SCM_PACK_POINTER} for anything but a heap object pointer!
 @end itemize
 
-@node Allocating Cells
-@subsubsection Allocating Cells
+@node Allocating Heap Objects
+@subsubsection Allocating Heap Objects
 
-Guile provides both ordinary cells with two slots, and double cells
-with four slots.  The following two function are the most primitive
-way to allocate such cells.
+Heap objects are heap-allocated data pointed to by non-immediate
+@code{SCM} value.  The first word of the heap object should contain a
+type code.  The object may be any number of words in length, and is
+generally scanned by the garbage collector for additional unless the
+object was allocated using a ``pointerless'' allocation function.
 
-If the caller intends to use it as a header for some other type, she
-must pass an appropriate magic value in @var{word_0}, to mark it as a
-member of that type, and pass whatever value as @var{word_1}, etc that
-the type expects.  You should generally not need these functions,
-unless you are implementing a new datatype, and thoroughly understand
-the code in @code{<libguile/tags.h>}.
+You should generally not need these functions, unless you are
+implementing a new data type, and thoroughly understand the code in
+@code{<libguile/scm.h>}.
 
 If you just want to allocate pairs, use @code{scm_cons}.
 
+@deftypefn Function SCM scm_words (scm_t_bits word_0, uint32_t n_words)
+Allocate a new heap object containing @var{n_words}, and initialize the
+first slot to @var{word_0}, and return a non-immediate @code{SCM} value
+encoding a pointer to the object.  Typically @var{word_0} will contain
+the type tag.
+@end deftypefn
+
+There are also deprecated but common variants of @code{scm_words} that
+use the term ``cell'' to indicate 2-word objects.
+
 @deftypefn Function SCM scm_cell (scm_t_bits word_0, scm_t_bits word_1)
-Allocate a new cell, initialize the two slots with @var{word_0} and
-@var{word_1}, and return it.
+Allocate a new 2-word heap object, initialize the two slots with
+@var{word_0} and @var{word_1}, and return it.  Just like calling
+@code{scm_words (@var{word_0}, 2)}, then initializing the second slot to
+@var{word_1}.
 
 Note that @var{word_0} and @var{word_1} are of type @code{scm_t_bits}.
 If you want to pass a @code{SCM} object, you need to use
@@ -539,123 +565,80 @@ If you want to pass a @code{SCM} object, you need to use
 @end deftypefn
 
 @deftypefn Function SCM scm_double_cell (scm_t_bits word_0, scm_t_bits word_1, scm_t_bits word_2, scm_t_bits word_3)
-Like @code{scm_cell}, but allocates a double cell with four
-slots.
+Like @code{scm_cell}, but allocates a 4-word heap object.
 @end deftypefn
 
-@node Heap Cell Type Information
-@subsubsection Heap Cell Type Information
+@node Heap Object Type Information
+@subsubsection Heap Object Type Information
 
-Heap cells contain a number of entries, each of which is either a scheme
-object of type @code{SCM} or a raw C value of type @code{scm_t_bits}.
-Which of the cell entries contain Scheme objects and which contain raw C
-values is determined by the first entry of the cell, which holds the
-cell type information.
+Heap objects contain a type tag and are followed by a number of
+word-sized slots.  The interpretation of the object contents depends on
+the type of the object.
 
 @deftypefn Macro scm_t_bits SCM_CELL_TYPE (SCM @var{x})
-For a non-immediate Scheme object @var{x}, deliver the content of the
-first entry of the heap cell referenced by @var{x}.  This value holds
-the information about the cell type.
+Extract the first word of the heap object pointed to by @var{x}.  This
+value holds the information about the cell type.
 @end deftypefn
 
 @deftypefn Macro void SCM_SET_CELL_TYPE (SCM @var{x}, scm_t_bits @var{t})
 For a non-immediate Scheme object @var{x}, write the value @var{t} into
-the first entry of the heap cell referenced by @var{x}.  The value
+the first word of the heap object referenced by @var{x}.  The value
 @var{t} must hold a valid cell type.
 @end deftypefn
 
 
-@node Accessing Cell Entries
-@subsubsection Accessing Cell Entries
+@node Accessing Heap Object Fields
+@subsubsection Accessing Heap Object Fields
 
 For a non-immediate Scheme object @var{x}, the object type can be
-determined by reading the cell type entry using the @code{SCM_CELL_TYPE}
-macro.  For each different type of cell it is known which cell entries
-hold Scheme objects and which cell entries hold raw C data.  To access
-the different cell entries appropriately, the following macros are
-provided.
+determined by using the @code{SCM_CELL_TYPE} macro described in the
+previous section.  For each different type of heap object it is known
+which fields hold tagged Scheme objects and which fields hold untagged
+raw data.  To access the different fields appropriately, the following
+macros are provided.
 
 @deftypefn Macro scm_t_bits SCM_CELL_WORD (SCM @var{x}, unsigned int @var{n})
-Deliver the cell entry @var{n} of the heap cell referenced by the
-non-immediate Scheme object @var{x} as raw data.  It is illegal, to
-access cell entries that hold Scheme objects by using these macros.  For
-convenience, the following macros are also provided.
-@itemize @bullet
-@item
-SCM_CELL_WORD_0 (@var{x}) @result{} SCM_CELL_WORD (@var{x}, 0)
-@item
-SCM_CELL_WORD_1 (@var{x}) @result{} SCM_CELL_WORD (@var{x}, 1)
-@item
-@dots{}
-@item
-SCM_CELL_WORD_@var{n} (@var{x}) @result{} SCM_CELL_WORD (@var{x}, @var{n})
-@end itemize
+@deftypefnx Macro scm_t_bits SCM_CELL_WORD_0 (@var{x})
+@deftypefnx Macro scm_t_bits SCM_CELL_WORD_1 (@var{x})
+@deftypefnx Macro scm_t_bits SCM_CELL_WORD_2 (@var{x})
+@deftypefnx Macro scm_t_bits SCM_CELL_WORD_3 (@var{x})
+Deliver the field @var{n} of the heap object referenced by the
+non-immediate Scheme object @var{x} as raw untagged data.  Only use this
+macro for fields containing untagged data; don't use it for fields
+containing tagged @code{SCM} objects.
 @end deftypefn
 
 @deftypefn Macro SCM SCM_CELL_OBJECT (SCM @var{x}, unsigned int @var{n})
-Deliver the cell entry @var{n} of the heap cell referenced by the
-non-immediate Scheme object @var{x} as a Scheme object.  It is illegal,
-to access cell entries that do not hold Scheme objects by using these
-macros.  For convenience, the following macros are also provided.
-@itemize @bullet
-@item
-SCM_CELL_OBJECT_0 (@var{x}) @result{} SCM_CELL_OBJECT (@var{x}, 0)
-@item
-SCM_CELL_OBJECT_1 (@var{x}) @result{} SCM_CELL_OBJECT (@var{x}, 1)
-@item
-@dots{}
-@item
-SCM_CELL_OBJECT_@var{n} (@var{x}) @result{} SCM_CELL_OBJECT (@var{x},
-@var{n})
-@end itemize
+@deftypefnx Macro SCM SCM_CELL_OBJECT_0 (SCM @var{x})
+@deftypefnx Macro SCM SCM_CELL_OBJECT_1 (SCM @var{x})
+@deftypefnx Macro SCM SCM_CELL_OBJECT_2 (SCM @var{x})
+@deftypefnx Macro SCM SCM_CELL_OBJECT_3 (SCM @var{x})
+Deliver the field @var{n} of the heap object referenced by the
+non-immediate Scheme object @var{x} as a Scheme object.  Only use this
+macro for fields containing tagged @code{SCM} objects; don't use it for
+fields containing untagged data.
 @end deftypefn
 
 @deftypefn Macro void SCM_SET_CELL_WORD (SCM @var{x}, unsigned int @var{n}, scm_t_bits @var{w})
-Write the raw C value @var{w} into entry number @var{n} of the heap cell
+@deftypefnx Macro void SCM_SET_CELL_WORD_0 (@var{x}, @var{w})
+@deftypefnx Macro void SCM_SET_CELL_WORD_1 (@var{x}, @var{w})
+@deftypefnx Macro void SCM_SET_CELL_WORD_2 (@var{x}, @var{w})
+@deftypefnx Macro void SCM_SET_CELL_WORD_3 (@var{x}, @var{w})
+Write the raw value @var{w} into field number @var{n} of the heap object
 referenced by the non-immediate Scheme value @var{x}.  Values that are
-written into cells this way may only be read from the cells using the
-@code{SCM_CELL_WORD} macros or, in case cell entry 0 is written, using
-the @code{SCM_CELL_TYPE} macro.  For the special case of cell entry 0 it
-has to be made sure that @var{w} contains a cell type information which
-does not describe a Scheme object.  For convenience, the following
-macros are also provided.
-@itemize @bullet
-@item
-SCM_SET_CELL_WORD_0 (@var{x}, @var{w}) @result{} SCM_SET_CELL_WORD
-(@var{x}, 0, @var{w})
-@item
-SCM_SET_CELL_WORD_1 (@var{x}, @var{w}) @result{} SCM_SET_CELL_WORD
-(@var{x}, 1, @var{w})
-@item
-@dots{}
-@item
-SCM_SET_CELL_WORD_@var{n} (@var{x}, @var{w}) @result{} SCM_SET_CELL_WORD
-(@var{x}, @var{n}, @var{w})
-@end itemize
+written into heap objects as raw values should only be read later using
+the @code{SCM_CELL_WORD} macros.
 @end deftypefn
 
 @deftypefn Macro void SCM_SET_CELL_OBJECT (SCM @var{x}, unsigned int @var{n}, SCM @var{o})
-Write the Scheme object @var{o} into entry number @var{n} of the heap
-cell referenced by the non-immediate Scheme value @var{x}.  Values that
-are written into cells this way may only be read from the cells using
-the @code{SCM_CELL_OBJECT} macros or, in case cell entry 0 is written,
-using the @code{SCM_CELL_TYPE} macro.  For the special case of cell
-entry 0 the writing of a Scheme object into this cell is only allowed
-if the cell forms a Scheme pair.  For convenience, the following macros
-are also provided.
-@itemize @bullet
-@item
-SCM_SET_CELL_OBJECT_0 (@var{x}, @var{o}) @result{} SCM_SET_CELL_OBJECT
-(@var{x}, 0, @var{o})
-@item
-SCM_SET_CELL_OBJECT_1 (@var{x}, @var{o}) @result{} SCM_SET_CELL_OBJECT
-(@var{x}, 1, @var{o})
-@item
-@dots{}
-@item
-SCM_SET_CELL_OBJECT_@var{n} (@var{x}, @var{o}) @result{}
-SCM_SET_CELL_OBJECT (@var{x}, @var{n}, @var{o})
-@end itemize
+@deftypefnx Macro void SCM_SET_CELL_OBJECT_0 (SCM @var{x}, SCM @var{o})
+@deftypefnx Macro void SCM_SET_CELL_OBJECT_1 (SCM @var{x}, SCM @var{o})
+@deftypefnx Macro void SCM_SET_CELL_OBJECT_2 (SCM @var{x}, SCM @var{o})
+@deftypefnx Macro void SCM_SET_CELL_OBJECT_3 (SCM @var{x}, SCM @var{o})
+Write the Scheme object @var{o} into field number @var{n} of the heap
+object referenced by the non-immediate Scheme value @var{x}.  Values
+that are written into heap objects as objects should only be read using
+the @code{SCM_CELL_OBJECT} macros.
 @end deftypefn
 
 @noindent
@@ -665,9 +648,13 @@ Summary:
 For a non-immediate Scheme object @var{x} of unknown type, get the type
 information by using @code{SCM_CELL_TYPE (@var{x})}.
 @item
-As soon as the cell type information is available, only use the
-appropriate access methods to read and write data to the different cell
-entries.
+As soon as the type information is available, only use the appropriate
+access methods to read and write data to the different heap object
+fields.
+@item
+Note that field 0 stores the cell type information.  Generally speaking,
+other data associated with a heap object is stored starting from field
+1.
 @end itemize
 
 
diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi
index ce0b76bb2..91902e492 100644
--- a/doc/ref/goops.texi
+++ b/doc/ref/goops.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008, 2009, 2011
+@c Copyright (C)  2008, 2009, 2011, 2017
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -2758,14 +2758,55 @@ make}).  What then happens if @code{<my-class>} is redefined by calling
 @code{define-class} again?
 
 @menu
+* Redefinable Classes::
 * Default Class Redefinition Behaviour::
 * Customizing Class Redefinition::
 @end menu
 
+@node Redefinable Classes
+@subsection Redefinable Classes
+
+The ability for a class to be redefined is a choice for a class author
+to make.  By default, classes in GOOPS are @emph{not} redefinable.  A
+redefinable class is an instance of @code{<redefinable-class>}; that is
+to say, a class with @code{<redefinable-class>} as its metaclass.
+Accordingly, to define a redefinable class, add @code{#:metaclass
+<redefinable-class>} to its class definition:
+
+@example
+(define-class <foo> ()
+  #:metaclass <redefinable-class>)
+@end example
+
+Note that any subclass of @code{<foo>} is also redefinable, without the
+need to explicitly pass the @code{#:metaclass} argument, so you only
+need to specify @code{#:metaclass} for the roots of your application's
+class hierarchy.
+
+@example
+(define-class <bar> (<foo>))
+(class-of <bar>) @result{} <redefinable-class>
+@end example
+
+Note that prior to Guile 3.0, all GOOPS classes were redefinable in
+theory.  In practice, attempting to, for example, redefine
+@code{<class>} itself would almost certainly not do what you want.
+Still, redefinition is an interesting capability when building
+long-lived resilient systems, so GOOPS does offer this facility.
+
 @node Default Class Redefinition Behaviour
 @subsection Default Class Redefinition Behaviour
 
-GOOPS' default answer to this question is as follows.
+When a class is defined using @code{define-class} and the class name was
+previously defined, by default the new binding just replaces the old
+binding.  This is the normal behavior for @code{define}.  However if
+both the old and new bindings are redefinable classes (instances of
+@code{<redefinable-class>}), then the class will be updated in place,
+and its instances lazily migrated over.
+
+The way that the class is updated and the way that the instances migrate
+over are of course part of the meta-object protocol.  However the
+default behavior usually suffices, and it goes as follows.
 
 @itemize @bullet
 @item
@@ -2822,25 +2863,31 @@ When @code{define-class} notices that a class is being redefined, it
 constructs the new class metaobject as usual, then invokes the
 @code{class-redefinition} generic function with the old and new classes
 as arguments.  Therefore, if the old or new classes have metaclasses
-other than the default @code{<class>}, class redefinition behaviour can
-be customized by defining a @code{class-redefinition} method that is
-specialized for the relevant metaclasses.
+other than the default @code{<redefinable-class>}, class redefinition
+behaviour can be customized by defining a @code{class-redefinition}
+method that is specialized for the relevant metaclasses.
 
 @deffn generic class-redefinition
-Handle the class redefinition from @var{old-class} to @var{new-class},
-and return the new class metaobject that should be bound to the
-variable specified by @code{define-class}'s first argument.
+Handle the class redefinition from @var{old} to @var{new}, and return
+the new class metaobject that should be bound to the variable specified
+by @code{define-class}'s first argument.
+@end deffn
+
+@deffn method class-redefinition (old <top>) (new <class>)
+Not all classes are redefinable, and not all previous bindings are
+classes.  @xref{Redefinable Classes}.  This default method just returns
+@var{new}.
 @end deffn
 
-@deffn method class-redefinition (old-class <class>) (new-class <class>)
-Implements GOOPS' default class redefinition behaviour, as described in
-@ref{Default Class Redefinition Behaviour}.  Returns the metaobject
-for the new class definition.
+@deffn method class-redefinition (old <redefinable-class>) (new <redefinable-class>)
+This method implements GOOPS' default class redefinition behaviour, as
+described in @ref{Default Class Redefinition Behaviour}.  Returns the
+metaobject for the new class definition.
 @end deffn
 
-The default @code{class-redefinition} method, for classes with the
-default metaclass @code{<class>}, calls the following generic functions,
-which could of course be individually customized.
+The @code{class-redefinition} method for classes with metaclass
+@code{<redefinable-class>} calls the following generic functions, which
+could of course be individually customized.
 
 @deffn generic remove-class-accessors! old
 The default @code{remove-class-accessors!} method removes the accessor
@@ -2871,7 +2918,7 @@ should apply, and then defining a @code{class-redefinition} method that
 is specialized for this metaclass:
 
 @example
-(define-class <can-be-nameless> (<class>))
+(define-class <can-be-nameless> (<redefinable-class>))
 
 (define-method (class-redefinition (old <can-be-nameless>)
                                    (new <class>))
@@ -2885,10 +2932,11 @@ implements the far more difficult strategy as its default!
 @node Changing the Class of an Instance
 @section Changing the Class of an Instance
 
-When a class is redefined, any existing instance of the redefined class
-will be modified for the new class definition before the next time that
-any of the instance's slots is referenced or set.  GOOPS modifies each
-instance by calling the generic function @code{change-class}.
+When a redefinable class is redefined, any existing instance of the
+redefined class will be modified for the new class definition before the
+next time that any of the instance's slots is referenced or set.  GOOPS
+modifies each instance by calling the generic function
+@code{change-class}.
 
 More generally, you can change the class of an existing instance at any
 time by invoking the generic function @code{change-class} with two
@@ -2906,8 +2954,9 @@ slot-init-function}).
 @deffn generic change-class instance new-class
 @end deffn
 
-@deffn {method} change-class (obj <object>) (new <class>)
+@deffn {method} change-class (obj <object>) (new <redefinable-class>)
 Modify instance @var{obj} to make it an instance of class @var{new}.
+@var{obj} itself must already be an instance of a redefinable class.
 
 The value of each of @var{obj}'s slots is preserved only if a similarly named
 slot exists in @var{new}; any other slot values are discarded.
diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi
index a18984f31..171a30ada 100644
--- a/doc/ref/guile-invoke.texi
+++ b/doc/ref/guile-invoke.texi
@@ -373,7 +373,7 @@ Here is an example using the Bash shell that adds the current directory,
 @example
 $ export GUILE_LOAD_COMPILED_PATH=".:../my-library"
 $ guile -c '(display %load-compiled-path) (newline)'
-(. ../my-library /usr/local/lib/guile/2.2/ccache)
+(. ../my-library /usr/local/lib/guile/3.0/ccache)
 @end example
 
 @item GUILE_LOAD_PATH
@@ -392,8 +392,8 @@ directory to @code{%load-path}, and adds the relative directory
 @example
 $ env GUILE_LOAD_PATH=".:...:../srfi" \
 guile -c '(display %load-path) (newline)'
-(. /usr/local/share/guile/2.2 \
-/usr/local/share/guile/site/2.2 \
+(. /usr/local/share/guile/3.0 \
+/usr/local/share/guile/site/3.0 \
 /usr/local/share/guile/site \
 /usr/local/share/guile \
 ../srfi)
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index ee5c10d36..7f77cb430 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -13,9 +13,8 @@
 @copying
 This manual documents Guile version @value{VERSION}.
 
-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009,
-2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Free Software
-Foundation, Inc.
+Copyright (C) 1996-1997, 2000-2005, 2009-2019 Free Software Foundation,
+Inc.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
diff --git a/doc/ref/history.texi b/doc/ref/history.texi
index f7fc4cbf2..d23d5a08d 100644
--- a/doc/ref/history.texi
+++ b/doc/ref/history.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008, 2010, 2011, 2013
+@c Copyright (C)  2008, 2010, 2011, 2013, 2018
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -212,12 +212,17 @@ Schemes: SRFI-18 threads, module-hygienic macros, a profiler, tracer,
 and debugger, SSAX XML integration, bytevectors, a dynamic FFI,
 delimited continuations, module versions, and partial support for R6RS.
 
-@item 2.2 --- mid-2014
+@item 2.2 --- 15 March 2017
 The virtual machine and introduced in 2.0 was completely rewritten,
 along with much of the compiler and toolchain.  This speeds up many
-Guile programs as well as reducing startup time and memory usage.  A PEG
-parser toolkit was added, making it easier to write other language
-frontends.
+Guile programs as well as reducing startup time and memory usage.
+Guile's POSIX multithreading was improved, stacks became dynamically
+expandable, the ports facility gained support for non-blocking I/O.
+
+@item 3.0 -- early 2019 (unreleased at time of writing)
+Guile gained support for native code generation via a simple
+just-in-time (JIT) compiler, further improving the speed of its virtual
+machine.
 @end table
 
 @node Status
@@ -259,11 +264,12 @@ entirely from high-level languages, through byte-code and native
 compilation, speed gains in the underlying hardware, and foreign call
 interfaces in the high-level language.  Smalltalk systems are like this,
 as are Common Lisp-based systems.  While there already are a number of
-pure-Guile applications out there, users still need to drop down to C
-for some tasks: interfacing to system libraries that don't have prebuilt
-Guile interfaces, and for some tasks requiring high performance.  Native
-ahead-of-time compilation, planned for Guile 3.0, should help with
-this.
+pure-Guile applications out there, in the past users have still needed
+to drop down to C for some tasks: interfacing to system libraries that
+don't have prebuilt Guile interfaces, and for some tasks requiring high
+performance.  With the arrival of native code generation via a JIT
+compiler in Guile 3.0, most of these older applications can now be
+updated to move more C code to Scheme.
 
 Still, even with an all-Guile application, sometimes you want to
 provide an opportunity for users to extend your program from a
diff --git a/doc/ref/libguile-foreign-objects.texi b/doc/ref/libguile-foreign-objects.texi
index f29646ca0..f668eedca 100644
--- a/doc/ref/libguile-foreign-objects.texi
+++ b/doc/ref/libguile-foreign-objects.texi
@@ -276,13 +276,11 @@ make_file (int fd)
 @cindex finalization
 
 Note that the finalizer may be invoked in ways and at times you might
-not expect.  In particular, if the user's Guile is built with support
-for threads, the finalizer may be called from any thread that is running
-Guile.  In Guile 2.0, finalizers are invoked via ``asyncs'', which
-interleaves them with running Scheme code; @pxref{Asyncs}.  In Guile 2.2
-there will be a dedicated finalization thread, to ensure that the
-finalization doesn't run within the critical section of any other thread
-known to Guile.
+not expect.  In a Guile built without threading support, finalizers are
+invoked via ``asyncs'', which interleaves them with running Scheme code;
+@pxref{Asyncs}.  If the user's Guile is built with support for threads,
+the finalizer will probably be called by a dedicated finalization
+thread, unless the user invokes @code{scm_run_finalizers ()} explicitly.
 
 In either case, finalizers run concurrently with the main program, and
 so they need to be async-safe and thread-safe.  If for some reason this
diff --git a/doc/ref/libguile-parallel.texi b/doc/ref/libguile-parallel.texi
index 166766edf..75fcd88ba 100644
--- a/doc/ref/libguile-parallel.texi
+++ b/doc/ref/libguile-parallel.texi
@@ -27,7 +27,7 @@ need to know which version of Guile to ask for, when they build against
 Guile.  Guile solves this problem by installing a file to be read by the
 @code{pkg-config} utility, a tool to query installed packages by name.
 Guile encodes the version into its pkg-config name, so that users can
-ask for @code{guile-2.0} or @code{guile-2.2}, as appropriate.
+ask for @code{guile-2.2} or @code{guile-3.0}, as appropriate.
 
 For effective version @value{EFFECTIVE-VERSION}, for example, you would
 invoke @code{pkg-config --cflags --libs guile-@value{EFFECTIVE-VERSION}}
diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi
index 3545836c3..87f481015 100644
--- a/doc/ref/preface.texi
+++ b/doc/ref/preface.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2010, 2011
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2010, 2011, 2018
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -25,10 +25,9 @@ identify individuals of whom to say ``yes, this person, she wrote the
 manual.''
 
 Still, among the many contributions, some caretakers stand out.  First
-among them is Neil Jerram, who has been working on this document for ten
-years now.  Neil's attention both to detail and to the big picture have
-made a real difference in the understanding of a generation of Guile
-hackers.
+among them is Neil Jerram, who has worked on this document for over ten
+years.  Neil's attention both to detail and to the big picture have made
+a real difference in the understanding of a generation of Guile hackers.
 
 Next we should note Marius Vollmer's effect on this document.  Marius
 maintained Guile during a period in which Guile's API was
@@ -41,12 +40,12 @@ the documentation of Scheme data types, control mechanisms and
 procedures.  In addition, he wrote the documentation for Guile's SRFI
 modules and modules associated with the Guile REPL.
 
-Ludovic Court@`es and Andy Wingo, the Guile maintainers at the time of
-this writing (late 2010), have also made their dent in the manual,
-writing documentation for new modules and subsystems in Guile 2.0.  They
-are also responsible for ensuring that the existing text retains its
-relevance as Guile evolves.  @xref{Reporting Bugs}, for more information
-on reporting problems in this manual.
+Ludovic Court@`es and Andy Wingo, who co-maintain Guile since 2010,
+along with Mark Weaver, have also made their dent in the manual, writing
+documentation for new modules and subsystems that arrived with Guile
+2.0.  Ludovic, Andy, and Mark are also responsible for ensuring that the
+existing text retains its relevance as Guile evolves.  @xref{Reporting
+Bugs}, for more information on reporting problems in this manual.
 
 The content for the first versions of this manual incorporated and was
 inspired by documents from Aubrey Jaffer, author of the SCM system on
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 11fa24d68..58548a387 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -152,6 +152,7 @@ The Guile core has the following features,
 guile
 guile-2  ;; starting from Guile 2.x
 guile-2.2  ;; starting from Guile 2.2
+guile-3.0  ;; starting from Guile 3.0
 r5rs
 srfi-0
 srfi-4
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 35de1da90..e603204ca 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -1,24 +1,38 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008-2011, 2013, 2015, 2018
+@c Copyright (C)  2008-2011, 2013, 2015, 2018, 2019
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node A Virtual Machine for Guile
 @section A Virtual Machine for Guile
 
-Guile has both an interpreter and a compiler. To a user, the difference
-is transparent---interpreted and compiled procedures can call each other
-as they please.
-
-The difference is that the compiler creates and interprets bytecode
-for a custom virtual machine, instead of interpreting the
-S-expressions directly. Loading and running compiled code is faster
-than loading and running source code.
-
-The virtual machine that does the bytecode interpretation is a part of
-Guile itself. This section describes the nature of Guile's virtual
-machine.
+Enough about data---how does Guile run code?
+
+Code is a grammatical production of a language.  Sometimes these
+languages are implemented using interpreters: programs that run
+along-side the program being interpreted, dynamically translating the
+high-level code to low-level code.  Sometimes these languages are
+implemented using compilers:  programs that translate high-level
+programs to equivalent low-level code, and pass on that low-level code
+to some other language implementation.  Each of these languages can be
+thought to be virtual machines: they offer programs an abstract machine
+on which to run.
+
+Guile implements a number of interpreters and compilers on different
+language levels.  For example, there is an interpreter for the Scheme
+language that is itself implemented as a Scheme program compiled to a
+bytecode for a low-level virtual machine shipped with Guile.  That
+virtual machine is implemented by both an interpreter---a C program that
+interprets the bytecodes---and a compiler---a C program that dynamically
+translates bytecode programs to native machine code@footnote{Even the
+lowest-level machine code can be thought to be interpreted by the CPU,
+and indeed is often implemented by compiling machine instructions to
+``micro-operations''.}.
+
+This section describes the language implemented by Guile's bytecode
+virtual machine, as well as some examples of translations of Scheme
+programs to Guile's VM.
 
 @menu
 * Why a VM?::                   
@@ -28,32 +42,35 @@ machine.
 * VM Programs::         
 * Object File Format::
 * Instruction Set::
+* Just-In-Time Native Code::
 @end menu
 
 @node Why a VM?
 @subsection Why a VM?
 
 @cindex interpreter
-For a long time, Guile only had an interpreter. Guile's interpreter
-operated directly on the S-expression representation of Scheme source
-code.
+For a long time, Guile only had a Scheme interpreter, implemented in C.
+Guile's interpreter operated directly on the S-expression representation
+of Scheme source code.
 
 But while the interpreter was highly optimized and hand-tuned, it still
-performed many needless computations during the course of evaluating an
-expression. For example, application of a function to arguments
+performed many needless computations during the course of evaluating a
+Scheme expression.  For example, application of a function to arguments
 needlessly consed up the arguments in a list. Evaluation of an
-expression always had to figure out what the car of the expression is --
-a procedure, a memoized form, or something else. All values have to be
-allocated on the heap. Et cetera.
-
-The solution to this problem was to compile the higher-level language,
-Scheme, into a lower-level language for which all of the checks and
-dispatching have already been done---the code is instead stripped to
-the bare minimum needed to ``do the job''.
-
-The question becomes then, what low-level language to choose? There
-are many options. We could compile to native code directly, but that
-poses portability problems for Guile, as it is a highly cross-platform
+expression like @code{(f x y)} always had to figure out whether @var{f}
+was a procedure, or a special form like @code{if}, or something else.
+The interpreter represented the lexical environment as a heap data
+structure, so every evaluation caused allocation, which was of course
+slow.  Et cetera.
+
+The solution to the slow-interpreter problem was to compile the
+higher-level language, Scheme, into a lower-level language for which all
+of the checks and dispatching have already been done---the code is
+instead stripped to the bare minimum needed to ``do the job''.
+
+The question becomes then, what low-level language to choose? There are
+many options.  We could compile to native code directly, but that poses
+portability problems for Guile, as it is a highly cross-platform
 project.
 
 So we want the performance gains that compilation provides, but we
@@ -62,44 +79,47 @@ The obvious solution is to compile to a virtual machine that is
 present on all Guile installations.
 
 The easiest (and most fun) way to depend on a virtual machine is to
-implement the virtual machine within Guile itself. Guile contains a
+implement the virtual machine within Guile itself.  Guile contains a
 bytecode interpreter (written in C) and a Scheme to bytecode compiler
-(written in Scheme). This way the virtual machine provides what Scheme
+(written in Scheme).  This way the virtual machine provides what Scheme
 needs (tail calls, multiple values, @code{call/cc}) and can provide
-optimized inline instructions for Guile (@code{cons}, @code{struct-ref},
-etc.).
+optimized inline instructions for Guile as well (GC-managed allocations,
+type checks, etc.).
 
-So this is what Guile does. The rest of this section describes that VM
-that Guile implements, and the compiled procedures that run on it.
+Guile also includes a just-in-time (JIT) compiler to translate bytecode
+to native code.  Because Guile uses the portable GNU Lightning library
+to emit that code, we keep the benefits of portability while also
+benefitting from fast native code.  To avoid too much time spent in the
+JIT compiler itself, Guile is tuned to only emit machine code for
+bytecode that is called often.
+
+The rest of this section describes that VM that Guile implements, and
+the compiled procedures that run on it.
 
 Before moving on, though, we should note that though we spoke of the
 interpreter in the past tense, Guile still has an interpreter. The
-difference is that before, it was Guile's main evaluator, and so was
-implemented in highly optimized C; now, it is actually implemented in
-Scheme, and compiled down to VM bytecode, just like any other program.
-(There is still a C interpreter around, used to bootstrap the compiler,
-but it is not normally used at runtime.)
+difference is that before, it was Guile's main Scheme implementation,
+and so was implemented in highly optimized C; now, it is actually
+implemented in Scheme, and compiled down to VM bytecode, just like any
+other program.  (There is still a C interpreter around, used to
+bootstrap the compiler, but it is not normally used at runtime.)
 
 The upside of implementing the interpreter in Scheme is that we preserve
 tail calls and multiple-value handling between interpreted and compiled
-code. The downside is that the interpreter in Guile 2.2 is still about
-twice as slow as the interpreter in 1.8.  Since Scheme users are mostly
-running compiled code, the compiler's speed more than makes up for the
-loss.  In any case, once we have native compilation for Scheme code, we
-expect the self-hosted interpreter to handily beat the old hand-tuned C
-implementation.
+code, and with advent of the JIT compiler in Guile 3.0 we reach the
+speed of the old hand-tuned C implementation; it's the best of both
+worlds.
 
 Also note that this decision to implement a bytecode compiler does not
-preclude native compilation. We can compile from bytecode to native
-code at runtime, or even do ahead of time compilation. More
-possibilities are discussed in @ref{Extending the Compiler}.
+preclude ahead-of-time native compilation.  More possibilities are
+discussed in @ref{Extending the Compiler}.
 
 @node VM Concepts
 @subsection VM Concepts
 
-Compiled code is run by a virtual machine (VM).  Each thread has its own
-VM.  The virtual machine executes the sequence of instructions in a
-procedure.
+The bytecode in a Scheme procedure is interpreted by a virtual machine
+(VM).  Each thread has its own instantiation of the VM.  The virtual
+machine executes the sequence of instructions in a procedure.
 
 Each VM instruction starts by indicating which operation it is, and then
 follows by encoding its source and destination operands.  Each procedure
@@ -146,20 +166,22 @@ course is the tail call case, @pxref{Tail Calls}.)
 The structure of the top stack frame is as follows:
 
 @example
-   | ...              |
-   +==================+ <- fp + 2 = SCM_FRAME_PREVIOUS_SP (fp)
-   | Dynamic link     |
-   +------------------+
-   | Return address   |
-   +==================+ <- fp
-   | Local 0          |
-   +------------------+
-   | Local 1          |
-   +------------------+
-   | ...              |
-   +------------------+
-   | Local N-1        |
-   \------------------/ <- sp
+   | ...previous frame locals...  |
+   +==============================+ <- fp + 3
+   | Dynamic link                 |
+   +------------------------------+
+   | Virtual return address (vRA) |
+   +------------------------------+
+   | Machine return address (mRA) |
+   +==============================+ <- fp
+   | Local 0                      |
+   +------------------------------+
+   | Local 1                      |
+   +------------------------------+
+   | ...                          |
+   +------------------------------+
+   | Local N-1                    |
+   \------------------------------/ <- sp
 @end example
 
 In the above drawing, the stack grows downward.  At the beginning of a
@@ -175,18 +197,25 @@ backtraces in Guile aren't always able to show all of the arguments: it
 could be that the slot corresponding to that argument was re-used by
 some other variable.
 
-The @dfn{return address} is the @code{ip} that was in effect before this
-program was applied.  When we return from this activation frame, we will
-jump back to this @code{ip}.  Likewise, the @dfn{dynamic link} is the
-offset of the @code{fp} that was in effect before this program was
-applied, relative to the current @code{fp}.
+The @dfn{virtual return address} is the @code{ip} that was in effect
+before this program was applied.  When we return from this activation
+frame, we will jump back to this @code{ip}.  Likewise, the @dfn{dynamic
+link} is the offset of the @code{fp} that was in effect before this
+program was applied, relative to the current @code{fp}.
+
+There are two return addresses: the virtual return address (vRA), and
+the machine return address (mRA).  The vRA is always present and
+indicates a bytecode address.  The mRA is only present when a call is
+made from a function with machine code (e.g. a function that has been
+JIT-compiled).
 
 To prepare for a non-tail application, Guile's VM will emit code that
 shuffles the function to apply and its arguments into appropriate stack
-slots, with two free slots below them.  The call then initializes those
-free slots with the current @code{ip} and @code{fp}, and updates
-@code{ip} to point to the function entry, and @code{fp} to point to the
-new call frame.
+slots, with three free slots below them.  The call then initializes
+those free slots to hold the machine return address (or NULL), the
+virtual return address, and the offset to the previous frame pointer
+(@code{fp}).  It then gets the @code{ip} for the function being called
+and adjusts @code{fp} to point to the new call frame.
 
 In this way, the dynamic link links the current frame to the previous
 frame.  Computing a stack trace involves traversing these frames.
@@ -210,7 +239,7 @@ Consider the following Scheme code as an example:
 
 @example
   (define (foo a)
-    (lambda (b) (list foo a b)))
+    (lambda (b) (vector foo a b)))
 @end example
 
 Within the lambda expression, @code{foo} is a top-level variable,
@@ -272,90 +301,147 @@ program)}.  @xref{Compiled Procedures}, for a full API reference.
 
 A procedure may reference data that was statically allocated when the
 procedure was compiled.  For example, a pair of immediate objects
-(@pxref{Immediate objects}) can be allocated directly in the memory
+(@pxref{Immediate Objects}) can be allocated directly in the memory
 segment that contains the compiled bytecode, and accessed directly by
 the bytecode.
 
 Another use for statically allocated data is to serve as a cache for a
-bytecode.  Top-level variable lookups are handled in this way.  If the
-@code{toplevel-box} instruction finds that it does not have a cached
-variable for a top-level reference, it accesses other static data to
-resolve the reference, and fills in the cache slot.  Thereafter all
-access to the variable goes through the cache cell.  The variable's
-value may change in the future, but the variable itself will not.
+bytecode.  Top-level variable lookups are handled in this way; the first
+time a top-level binding is referenced, the resolved variable will be
+stored in a cache.  Thereafter all access to the variable goes through
+the cache cell.  The variable's value may change in the future, but the
+variable itself will not.
 
 We can see how these concepts tie together by disassembling the
 @code{foo} function we defined earlier to see what is going on:
 
 @smallexample
-scheme@@(guile-user)> (define (foo a) (lambda (b) (list foo a b)))
+scheme@@(guile-user)> (define (foo a) (lambda (b) (vector foo a b)))
 scheme@@(guile-user)> ,x foo
-Disassembly of #<procedure foo (a)> at #xea4ce4:
-
-   0    (assert-nargs-ee/locals 2 0)    ;; 2 slots (1 arg)    at (unknown file):1:0
-   1    (make-closure 1 7 1)            ;; anonymous procedure at #xea4d04 (1 free var)
-   4    (free-set! 1 0 0)               ;; free var 0
-   6    (mov 0 1)
-   7    (return-values 2)               ;; 1 value
+Disassembly of #<procedure foo (a)> at #xf1da30:
+
+   0    (instrument-entry 164)                                at (unknown file):5:0
+   2    (assert-nargs-ee/locals 2 1)    ;; 3 slots (1 arg)
+   3    (allocate-words/immediate 2 3)                        at (unknown file):5:16
+   4    (load-u64 0 0 65605)
+   7    (word-set!/immediate 2 0 0)
+   8    (load-label 0 7)                ;; anonymous procedure at #xf1da6c
+  10    (word-set!/immediate 2 1 0)
+  11    (scm-set!/immediate 2 2 1)
+  12    (reset-frame 1)                 ;; 1 slot
+  13    (handle-interrupts)
+  14    (return-values)
 
 ----------------------------------------
-Disassembly of anonymous procedure at #xea4d04:
-
-   0    (assert-nargs-ee/locals 2 2)    ;; 4 slots (1 arg)    at (unknown file):1:16
-   1    (toplevel-box 1 74 58 68 #t)    ;; `foo'
-   6    (box-ref 1 1)                   
-   7    (make-short-immediate 0 772)    ;; ()                 at (unknown file):1:28
-   8    (cons 2 2 0)                    
-   9    (free-ref 3 3 0)                ;; free var 0
-  11    (cons 3 3 2)
-  12    (cons 2 1 3)
-  13    (return-values 2)               ;; 1 value
+Disassembly of anonymous procedure at #xf1da6c:
+
+   0    (instrument-entry 183)                                at (unknown file):5:16
+   2    (assert-nargs-ee/locals 2 3)    ;; 5 slots (1 arg)
+   3    (static-ref 2 152)              ;; #<variable 112e530 value: #<procedure foo (a)>>
+   5    (immediate-tag=? 2 7 0)         ;; heap-object?
+   7    (je 19)                         ;; -> L2
+   8    (static-ref 2 119)              ;; #<directory (guile-user) ca9750>
+  10    (static-ref 1 127)              ;; foo
+  12    (call-scm<-scm-scm 2 2 1 40)
+  14    (immediate-tag=? 2 7 0)         ;; heap-object?
+  16    (jne 8)                         ;; -> L1
+  17    (scm-ref/immediate 0 2 1)
+  18    (immediate-tag=? 0 4095 2308)   ;; undefined?
+  20    (je 4)                          ;; -> L1
+  21    (static-set! 2 134)             ;; #<variable 112e530 value: #<procedure foo (a)>>
+  23    (j 3)                           ;; -> L2
+L1:
+  24    (throw/value 1 151)             ;; #(unbound-variable #f "Unbound variable: ~S")
+L2:
+  26    (scm-ref/immediate 2 2 1)
+  27    (allocate-words/immediate 1 4)                        at (unknown file):5:28
+  28    (load-u64 0 0 781)
+  31    (word-set!/immediate 1 0 0)
+  32    (scm-set!/immediate 1 1 2)
+  33    (scm-ref/immediate 4 4 2)
+  34    (scm-set!/immediate 1 2 4)
+  35    (scm-set!/immediate 1 3 3)
+  36    (mov 4 1)
+  37    (reset-frame 1)                 ;; 1 slot
+  38    (handle-interrupts)
+  39    (return-values)
 @end smallexample
 
-First there's some prelude, where @code{foo} checks that it was called
-with only 1 argument.  Then at @code{ip} 1, we allocate a new closure
-and store it in slot 1, relative to the @code{sp}.
-
-At run-time, local variables in Guile are usually addressed relative to
-the stack pointer, which leads to a pleasantly efficient
-@code{sp[@var{n}]} access.  However it can make the disassembly hard to
-read, because the @code{sp} can change during the function, and because
-incoming arguments are relative to the @code{fp}, not the @code{sp}.
+The first thing to notice is that the bytecode is at a fairly low level.
+When a program is compiled from Scheme to bytecode, it is expressed in
+terms of more primitive operations.  As such, there can be more
+instructions than you might expect.
+
+The first chunk of instructions is the outer @code{foo} procedure.  It
+is followed by the code for the contained closure.  The code can look
+daunting at first glance, but with practice it quickly becomes
+comprehensible, and indeed being able to read bytecode is an important
+step to understanding the low-level performance of Guile programs.
+
+The @code{foo} function begins with a prelude.  The
+@code{instrument-entry} bytecode increments a counter associated with
+the function.  If the counter reaches a certain threshold, Guile will
+emit machine code (``JIT-compile'') for @code{foo}.  Emitting machine
+code is fairly cheap but it does take time, so it's not something you
+want to do for every function.  Using a per-function counter and a
+global threshold allows Guile to spend time JIT-compiling only the
+``hot'' functions.
+
+Next in the prelude is an argument-checking instruction, which checks
+that it was called with only 1 argument (plus the callee function itself
+makes 2) and then reserves stack space for an additional 1 local.
+
+Then from @code{ip} 3 to 11, we allocate a new closure by allocating a
+three-word object, initializing its first word to store a type tag,
+setting its second word to its code pointer, and finally at @code{ip}
+11, storing local value 1 (the @code{a} argument) into the third word
+(the first free variable).
+
+Before returning, @code{foo} ``resets the frame'' to hold only one local
+(the return value), runs any pending interrupts (@pxref{Asyncs}) and
+then returns.
+
+Note that local variables in Guile's virtual machine are usually
+addressed relative to the stack pointer, which leads to a pleasantly
+efficient @code{sp[@var{n}]} access.  However it can make the
+disassembly hard to read, because the @code{sp} can change during the
+function, and because incoming arguments are relative to the @code{fp},
+not the @code{sp}.
 
 To know what @code{fp}-relative slot corresponds to an
 @code{sp}-relative reference, scan up in the disassembly until you get
-to a ``@var{n} slots'' annotation; in our case, 2, indicating that the
-frame has space for 2 slots.  Thus a zero-indexed @code{sp}-relative
-slot of 1 corresponds to the @code{fp}-relative slot of 0, which
+to a ``@var{n} slots'' annotation; in our case, 3, indicating that the
+frame has space for 3 slots.  Thus a zero-indexed @code{sp}-relative
+slot of 2 corresponds to the @code{fp}-relative slot of 0, which
 initially held the value of the closure being called.  This means that
 Guile doesn't need the value of the closure to compute its result, and
 so slot 0 was free for re-use, in this case for the result of making a
 new closure.
 
-A closure is code with data.  The @code{6} in the @code{(make-closure 1
-6 1)} is a relative offset from the instruction pointer of the code for
-the closure, and the final @code{1} indicates that the closure has space
-for 1 free variable.  @code{Ip} 4 initializes free variable 0 in the new
-closure with the value from @code{sp}-relative slot 0, which corresponds
-to @code{fp}-relative slot 1, the first argument of @code{foo}:
-@code{a}.  Finally we return the closure.
+A closure is code with data.  As you can see, making the closure
+involved making an object (@code{ip} 3), putting a code pointer in it
+(@code{ip} 8 and 10), and putting in the closure's free variable
+(@code{ip} 11).
 
 The second stanza disassembles the code for the closure.  After the
-prelude, we load the variable for the toplevel variable @code{foo} into
-slot 1.  This lookup occurs lazily, the first time the variable is
-actually referenced, and the location of the lookup is cached so that
-future references are very cheap.  @xref{Top-Level Environment
-Instructions}, for more details.  The @code{box-ref} dereferences the
-variable cell, replacing the contents of slot 1.
-
-What follows is a sequence of conses to build up the result list.
-@code{Ip} 7 makes the tail of the list.  @code{Ip} 8 conses on the value
-in slot 2, corresponding to the first argument to the closure: @code{b}.
-@code{Ip} 9 loads free variable 0 of slot 3 -- the procedure being
-called, in @code{fp}-relative slot 0 -- into slot 3, then @code{ip} 11
-conses it onto the list.  Finally we cons the value in slot 1,
-containing the @code{foo} toplevel, onto the front of the list, and we
-return it.
+prelude, all of the code between @code{ip} 5 and 24 is related to
+loading the toplevel variable @code{foo} into slot 1.  This lookup
+happens only once, and is associated with a cache; after the first run,
+the value in the cache will be a bound variable, and the code will jump
+from @code{ip} 7 to 26.  On the first run, Guile gets the module
+associated with the function, calls out to a run-time routine to look up
+the variable, and checks that the variable is bound before initializing
+the cache.  Either way, @code{ip} 26 dereferences the variable into
+local 2.
+
+What follows is the allocation and initialization of the vector return
+value.  @code{Ip} 27 does the allocation, and the following two
+instructions initialize the type-and-length tag for the object's first
+word.  @code{Ip} 32 sets word 1 of the object (the first vector slot) to
+the value of @code{foo}; @code{ip} 33 fetches the closure variable for
+@code{a}, then in @code{ip} 34 stores it in the second vector slot; and
+finally, in @code{ip} 35, local @code{b} is stored to the third vector
+slot.  This is followed by the return sequence.
 
 
 @node Object File Format
@@ -469,7 +555,7 @@ compiled @code{.go} files.  It's good times!
 @node Instruction Set
 @subsection Instruction Set
 
-There are currently about 175 instructions in Guile's virtual machine.
+There are currently about 150 instructions in Guile's virtual machine.
 These instructions represent atomic units of a program's execution.
 Ideally, they perform one task without conditional branches, then
 dispatch to the next instruction in the stream.
@@ -495,7 +581,7 @@ An offset from the current @code{ip}, in 32-bit units, as a signed
 24-bit value.  Indicates a bytecode address, for a relative jump.
 @item i16
 @itemx i32
-An immediate Scheme value (@pxref{Immediate objects}), encoded directly
+An immediate Scheme value (@pxref{Immediate Objects}), encoded directly
 in 16 or 32 bits.
 @item a32
 @itemx b32
@@ -533,186 +619,51 @@ operands occupying the lower bits.
 
 For example, consider the following instruction specification:
 
-@deftypefn Instruction {} free-set! s12:@var{dst} s12:@var{src} x8:@var{_} c24:@var{idx}
-Set free variable @var{idx} from the closure @var{dst} to @var{src}.
+@deftypefn Instruction {} call f24:@var{proc} x8:@var{_} c24:@var{nlocals}
 @end deftypefn
 
 The first word in the instruction will start with the 8-bit value
-corresponding to the @var{free-set!} opcode in the low bits, followed by
-@var{dst} and @var{src} as 12-bit values.  The second word starts with 8
-dead bits, followed by the index as a 24-bit immediate value.
-
-Sometimes the compiler can figure out that it is compiling a special
-case that can be run more efficiently. So, for example, while Guile
-offers a generic test-and-branch instruction, it also offers specific
-instructions for special cases, so that the following cases all have
-their own test-and-branch instructions:
+corresponding to the @var{call} opcode in the low bits, followed by
+@var{proc} as a 24-bit value.  The second word starts with 8 dead bits,
+followed by the index as a 24-bit immediate value.
 
-@example
-(if pred then else)
-(if (not pred) then else)
-(if (null? l) then else)
-(if (not (null? l)) then else)
-@end example
-
-In addition, some Scheme primitives have their own inline
-implementations.  For example, in the previous section we saw
-@code{cons}.
-
-Finally, for instructions with operands that encode references to the
-stack, the interpretation of those stack values is up to the instruction
-itself.  Most instructions expect their operands to be tagged SCM values
+For instructions with operands that encode references to the stack, the
+interpretation of those stack values is up to the instruction itself.
+Most instructions expect their operands to be tagged SCM values
 (@code{scm} representation), but some instructions expect unboxed
 integers (@code{u64} and @code{s64} representations) or floating-point
-numbers (@var{f64} representation).  Instructions have static types:
-they must receive their operands in the format they expect.  It's up to
-the compiler to ensure this is the case.  Unless otherwise mentioned,
-all operands and results are boxed as SCM values.
+numbers (@code{f64} representation).  It is assumed that the bits for a
+@code{u64} value are the same as those for an @code{s64} value, and that
+@code{s64} values are stored in two's complement.
+
+Instructions have static types:  they must receive their operands in the
+format they expect.  It's up to the compiler to ensure this is the case.
+
+Unless otherwise mentioned, all operands and results are in the
+@code{scm} representation.
 
 @menu
-* Lexical Environment Instructions::
-* Top-Level Environment Instructions::
-* Procedure Call and Return Instructions::
+* Call and Return Instructions::
 * Function Prologue Instructions::
+* Shuffling Instructions::
 * Trampoline Instructions::
-* Branch Instructions::
+* Non-Local Control Flow Instructions::
+* Instrumentation Instructions::
+* Intrinsic Call Instructions::
 * Constant Instructions::
-* Dynamic Environment Instructions::
-* Miscellaneous Instructions::
-* Inlined Scheme Instructions::
-* Inlined Atomic Instructions::
-* Inlined Mathematical Instructions::
-* Inlined Bytevector Instructions::
-* Unboxed Integer Arithmetic::
-* Unboxed Floating-Point Arithmetic::
+* Memory Access Instructions::
+* Atomic Memory Access Instructions::
+* Tagging and Untagging Instructions::
+* Integer Arithmetic Instructions::
+* Floating-Point Arithmetic Instructions::
+* Comparison Instructions::
+* Branch Instructions::
+* Raw Memory Access Instructions::
 @end menu
 
 
-@node Lexical Environment Instructions
-@subsubsection Lexical Environment Instructions
-
-These instructions access and mutate the lexical environment of a
-compiled procedure---its free and bound variables.  @xref{Stack Layout},
-for more information on the format of stack frames.
-
-@deftypefn Instruction {} mov s12:@var{dst} s12:@var{src}
-@deftypefnx Instruction {} long-mov s24:@var{dst} x8:@var{_} s24:@var{src}
-Copy a value from one local slot to another.
-
-As discussed previously, procedure arguments and local variables are
-allocated to local slots.  Guile's compiler tries to avoid shuffling
-variables around to different slots, which often makes @code{mov}
-instructions redundant.  However there are some cases in which shuffling
-is necessary, and in those cases, @code{mov} is the thing to use.
-@end deftypefn
-
-@deftypefn Instruction {} long-fmov f24:@var{dst} x8:@var{_} f24:@var{src}
-Copy a value from one local slot to another, but addressing slots
-relative to the @code{fp} instead of the @code{sp}.  This is used when
-shuffling values into place after multiple-value returns.
-@end deftypefn
-
-@deftypefn Instruction {} make-closure s24:@var{dst} l32:@var{offset} x8:@var{_} c24:@var{nfree}
-Make a new closure, and write it to @var{dst}.  The code for the closure
-will be found at @var{offset} words from the current @code{ip}.
-@var{offset} is a signed 32-bit integer.  Space for @var{nfree} free
-variables will be allocated.
-
-The size of a closure is currently two words, plus one word per free
-variable.
-@end deftypefn
-
-@deftypefn Instruction {} free-ref s12:@var{dst} s12:@var{src} x8:@var{_} c24:@var{idx}
-Load free variable @var{idx} from the closure @var{src} into local slot
-@var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} free-set! s12:@var{dst} s12:@var{src} x8:@var{_} c24:@var{idx}
-Set free variable @var{idx} from the closure @var{dst} to @var{src}.
-
-This instruction is usually used when initializing a closure's free
-variables, but not to mutate free variables, as variables that are
-assigned are boxed.
-@end deftypefn
-
-Recall that variables that are assigned are usually allocated in boxes,
-so that continuations and closures can capture their identity and not
-their value at one point in time.  Variables are also used in the
-implementation of top-level bindings; see the next section for more
-information.
-
-@deftypefn Instruction {} box s12:@var{dst} s12:@var{src}
-Create a new variable holding @var{src}, and place it in @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} box-ref s12:@var{dst} s12:@var{src}
-Unpack the variable at @var{src} into @var{dst}, asserting that the
-variable is actually bound.
-@end deftypefn
-
-@deftypefn Instruction {} box-set! s12:@var{dst} s12:@var{src}
-Set the contents of the variable at @var{dst} to @var{set}.
-@end deftypefn
-
-
-@node Top-Level Environment Instructions
-@subsubsection Top-Level Environment Instructions
-
-These instructions access values in the top-level environment: bindings
-that were not lexically apparent at the time that the code in question
-was compiled.
-
-The location in which a toplevel binding is stored can be looked up once
-and cached for later. The binding itself may change over time, but its
-location will stay constant.
-
-@deftypefn Instruction {} current-module s24:@var{dst}
-Store the current module in @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} resolve s24:@var{dst} b1:@var{bound?} x7:@var{_} s24:@var{sym}
-Resolve @var{sym} in the current module, and place the resulting
-variable in @var{dst}.  An error will be signalled if no variable is
-found.  If @var{bound?} is true, an error will be signalled if the
-variable is unbound.
-@end deftypefn
-
-@deftypefn Instruction {} define! s12:@var{dst} s12:@var{sym}
-Look up a binding for @var{sym} in the current module, creating it if
-necessary.  Store that variable to @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} toplevel-box s24:@var{dst} r32:@var{var-offset} r32:@var{mod-offset} n32:@var{sym-offset} b1:@var{bound?} x31:@var{_}
-Load a value.  The value will be fetched from memory, @var{var-offset}
-32-bit words away from the current instruction pointer.
-@var{var-offset} is a signed value.  Up to here, @code{toplevel-box} is
-like @code{static-ref}.
-
-Then, if the loaded value is a variable, it is placed in @var{dst}, and
-control flow continues.
-
-Otherwise, we have to resolve the variable.  In that case we load the
-module from @var{mod-offset}, just as we loaded the variable.  Usually
-the module gets set when the closure is created.  @var{sym-offset}
-specifies the name, as an offset to a symbol.
-
-We use the module and the symbol to resolve the variable, placing it in
-@var{dst}, and caching the resolved variable so that we will hit the
-cache next time.  If @var{bound?} is true, an error will be signalled if
-the variable is unbound.
-@end deftypefn
-
-@deftypefn Instruction {} module-box s24:@var{dst} r32:@var{var-offset} n32:@var{mod-offset} n32:@var{sym-offset} b1:@var{bound?} x31:@var{_}
-Like @code{toplevel-box}, except @var{mod-offset} points at a module
-identifier instead of the module itself.  A module identifier is a
-module name, as a list, prefixed by a boolean.  If the prefix is true,
-then the variable is resolved relative to the module's public interface
-instead of its private interface.
-@end deftypefn
-
-
-@node Procedure Call and Return Instructions
-@subsubsection Procedure Call and Return Instructions
+@node Call and Return Instructions
+@subsubsection Call and Return Instructions
 
 As described earlier (@pxref{Stack Layout}), Guile's calling convention
 is that arguments are passed and values returned on the stack.
@@ -723,13 +674,12 @@ before the call instruction.  ``Into place'' for a tail call means that
 the procedure should be in slot 0, relative to the @code{fp}, and the
 arguments should follow.  For a non-tail call, if the procedure is in
 @code{fp}-relative slot @var{n}, the arguments should follow from slot
-@var{n}+1, and there should be two free slots at @var{n}-1 and @var{n}-2
-in which to save the @code{ip} and @code{fp}.
+@var{n}+1, and there should be three free slots between @var{n}-1 and
+@var{n}-3 in which to save the mRA, vRA, and @code{fp}.
 
 Returning values is similar.  Multiple-value returns should have values
-already shuffled down to start from @code{fp}-relative slot 1 before
-emitting @code{return-values}.  We start from slot 1 instead of slot 0
-to make tail calls to @code{values} trivial.
+already shuffled down to start from @code{fp}-relative slot 0 before
+emitting @code{return-values}.
 
 In both calls and returns, the @code{sp} is used to indicate to the
 callee or caller the number of arguments or return values, respectively.
@@ -738,14 +688,14 @@ After receiving return values, it is the caller's responsibility to
 
 @deftypefn Instruction {} call f24:@var{proc} x8:@var{_} c24:@var{nlocals}
 Call a procedure.  @var{proc} is the local corresponding to a procedure.
-The two values below @var{proc} will be overwritten by the saved call
+The three values below @var{proc} will be overwritten by the saved call
 frame data.  The new frame will have space for @var{nlocals} locals: one
 for the procedure, and the rest for the arguments which should already
 have been pushed on.
 
 When the call returns, execution proceeds with the next instruction.
 There may be any number of values on the return stack; the precise
-number can be had by subtracting the address of @var{proc} from the
+number can be had by subtracting the address of @var{proc}-1 from the
 post-call @code{sp}.
 @end deftypefn
 
@@ -759,22 +709,21 @@ the current @code{ip}.  Since @var{proc} is not dereferenced, it may be
 some other representation of the closure.
 @end deftypefn
 
-@deftypefn Instruction {} tail-call c24:@var{nlocals}
+@deftypefn Instruction {} tail-call x24:@var{_}
 Tail-call a procedure.  Requires that the procedure and all of the
-arguments have already been shuffled into position.  Will reset the
-frame to @var{nlocals}.
+arguments have already been shuffled into position, and that the frame
+has already been reset to the number of arguments to the call.
 @end deftypefn
 
-@deftypefn Instruction {} tail-call-label c24:@var{nlocals} l32:@var{label}
+@deftypefn Instruction {} tail-call-label x24:@var{_} l32:@var{label}
 Tail-call a known procedure.  As @code{call} is to @code{call-label},
 @code{tail-call} is to @code{tail-call-label}.
 @end deftypefn
 
-@deftypefn Instruction {} tail-call/shuffle f24:@var{from}
-Tail-call a procedure.  The procedure should already be set to slot 0.
-The rest of the args are taken from the frame, starting at @var{from},
-shuffled down to start at slot 0.  This is part of the implementation of
-the @code{call-with-values} builtin.
+@deftypefn Instruction {} return-values x24:@var{_}
+Return a number of values from a call frame.  The return values should
+have already been shuffled down to a contiguous array starting at slot
+0, and the frame already reset.
 @end deftypefn
 
 @deftypefn Instruction {} receive f12:@var{dst} f12:@var{proc} x8:@var{_} c24:@var{nlocals}
@@ -791,21 +740,6 @@ return values equals @var{nvalues} exactly.  After @code{receive-values}
 has run, the values can be copied down via @code{mov}, or used in place.
 @end deftypefn
 
-@deftypefn Instruction {} return-values c24:@var{nlocals}
-Return a number of values from a call frame.  This opcode corresponds to
-an application of @code{values} in tail position.  As with tail calls,
-we expect that the values have already been shuffled down to a
-contiguous array starting at slot 1.  If @var{nlocals} is nonzero, reset
-the frame to hold that number of locals.  Note that a frame reset to 1
-local returns 0 values.
-@end deftypefn
-
-@deftypefn Instruction {} call/cc x24:@var{_}
-Capture the current continuation, and tail-apply the procedure in local
-slot 1 to it.  This instruction is part of the implementation of
-@code{call/cc}, and is not generated by the compiler.
-@end deftypefn
-
 
 @node Function Prologue Instructions
 @subsubsection Function Prologue Instructions
@@ -833,46 +767,24 @@ details on stack frames.  Note that @var{expected} includes the
 procedure itself.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-nargs-ne c24:@var{expected} x8:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-nargs-lt c24:@var{expected} x8:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-nargs-gt c24:@var{expected} x8:@var{_} l24:@var{offset}
-If the number of actual arguments is not equal, less than, or greater
-than @var{expected}, respectively, add @var{offset}, a signed 24-bit
-number, to the current instruction pointer.  Note that @var{expected}
-includes the procedure itself.
-
-These instructions are used to implement multiple arities, as in
-@code{case-lambda}. @xref{Case-lambda}, for more information.
+@deftypefn Instruction {} arguments<=? c24:@var{expected}
+Set the @code{LESS_THAN}, @code{EQUAL}, or @code{NONE} comparison result
+values if the number of arguments is respectively less than, equal to,
+or greater than @var{expected}.
 @end deftypefn
 
-@deftypefn Instruction {} alloc-frame c24:@var{nlocals}
-Ensure that there is space on the stack for @var{nlocals} local
-variables, setting them all to @code{SCM_UNDEFINED}, except those values
-that are already on the stack.
+@deftypefn Instruction {} positional-arguments<=? c24:@var{nreq} x8:@var{_} c24:@var{expected}
+Set the @code{LESS_THAN}, @code{EQUAL}, or @code{NONE} comparison result
+values if the number of positional arguments is respectively less than,
+equal to, or greater than @var{expected}.  The first @var{nreq}
+arguments are positional arguments, as are the subsequent arguments that
+are not keywords.
 @end deftypefn
 
-@deftypefn Instruction {} reset-frame c24:@var{nlocals}
-Like @code{alloc-frame}, but doesn't check that the stack is big enough,
-and doesn't initialize values to @code{SCM_UNDEFINED}.  Used to reset
-the frame size to something less than the size that was previously set
-via alloc-frame.
-@end deftypefn
-
-@deftypefn Instruction {} assert-nargs-ee/locals c12:@var{expected} c12:@var{nlocals}
-Equivalent to a sequence of @code{assert-nargs-ee} and
-@code{reserve-locals}.  The number of locals reserved is @var{expected}
-+ @var{nlocals}.
-@end deftypefn
-
-@deftypefn Instruction {} br-if-npos-gt c24:@var{nreq} x8:@var{_} c24:@var{npos} x8:@var{_} l24:@var{offset}
-Find the first positional argument after @var{nreq}.  If it is greater
-than @var{npos}, jump to @var{offset}.
-
-This instruction is only emitted for functions with multiple clauses,
-and an earlier clause has keywords and no rest arguments.
-@xref{Case-lambda}, for more on how @code{case-lambda} chooses the
-clause to apply.
-@end deftypefn
+The @code{arguments<=?} and @code{positional-arguments<=?} instructions
+are used to implement multiple arities, as in @code{case-lambda}.
+@xref{Case-lambda}, for more information.  @xref{Branch Instructions},
+for more on comparison results.
 
 @deftypefn Instruction {} bind-kwargs c24:@var{nreq} c8:@var{flags} c24:@var{nreq-and-opt} x8:@var{_} c24:@var{ntotal} n32:@var{kw-offset}
 @var{flags} is a bitfield, whose lowest bit is @var{allow-other-keys},
@@ -895,11 +807,93 @@ will signal an error if an unknown key is found.
 A macro-mega-instruction.
 @end deftypefn
 
+@deftypefn Instruction {} bind-optionals f24:@var{nlocals}
+Expand the current frame to have at least @var{nlocals} locals, filling
+in any fresh values with @code{SCM_UNDEFINED}.  If the frame has more
+than @var{nlocals} locals, it is left as it is.
+@end deftypefn
+
 @deftypefn Instruction {} bind-rest f24:@var{dst}
 Collect any arguments at or above @var{dst} into a list, and store that
 list at @var{dst}.
 @end deftypefn
 
+@deftypefn Instruction {} alloc-frame c24:@var{nlocals}
+Ensure that there is space on the stack for @var{nlocals} local
+variables.  The value of any new local is undefined.
+@end deftypefn
+
+@deftypefn Instruction {} reset-frame c24:@var{nlocals}
+Like @code{alloc-frame}, but doesn't check that the stack is big enough,
+and doesn't initialize values to @code{SCM_UNDEFINED}.  Used to reset
+the frame size to something less than the size that was previously set
+via alloc-frame.
+@end deftypefn
+
+@deftypefn Instruction {} assert-nargs-ee/locals c12:@var{expected} c12:@var{nlocals}
+Equivalent to a sequence of @code{assert-nargs-ee} and
+@code{allocate-frame}.  The number of locals reserved is @var{expected}
++ @var{nlocals}.
+@end deftypefn
+
+
+@node Shuffling Instructions
+@subsubsection Shuffling Instructions
+
+These instructions are used to move around values on the stack.
+
+@deftypefn Instruction {} mov s12:@var{dst} s12:@var{src}
+@deftypefnx Instruction {} long-mov s24:@var{dst} x8:@var{_} s24:@var{src}
+Copy a value from one local slot to another.
+
+As discussed previously, procedure arguments and local variables are
+allocated to local slots.  Guile's compiler tries to avoid shuffling
+variables around to different slots, which often makes @code{mov}
+instructions redundant.  However there are some cases in which shuffling
+is necessary, and in those cases, @code{mov} is the thing to use.
+@end deftypefn
+
+@deftypefn Instruction {} long-fmov f24:@var{dst} x8:@var{_} f24:@var{src}
+Copy a value from one local slot to another, but addressing slots
+relative to the @code{fp} instead of the @code{sp}.  This is used when
+shuffling values into place after multiple-value returns.
+@end deftypefn
+
+@deftypefn Instruction {} push s24:@var{src}
+Bump the stack pointer by one word, and fill it with the value from slot
+@var{src}.  The offset to @var{src} is calculated before the stack
+pointer is adjusted.
+@end deftypefn
+
+The @code{push} instruction is used when another instruction is unable
+to address an operand because the operand is encoded with fewer than 24
+bits.  In that case, Guile's assembler will transparently emit code that
+temporarily pushes any needed operands onto the stack, emits the
+original instruction to address those now-near variables, then shuffles
+the result (if any) back into place.
+
+@deftypefn Instruction {} pop s24:@var{dst}
+Pop the stack pointer, storing the value that was there in slot
+@var{dst}.  The offset to @var{dst} is calculated after the stack
+pointer is adjusted.
+@end deftypefn
+
+@deftypefn Instruction {} drop c24:@var{count}
+Pop the stack pointer by @var{count} words, discarding any values that
+were stored there.
+@end deftypefn
+
+@deftypefn Instruction {} shuffle-down f12:@var{from} f12:@var{to}
+Shuffle down values from @var{from} to @var{to}, reducing the frame size
+by @var{FROM}-@var{TO} slots.  Part of the internal implementation of
+@code{call-with-values}, @code{values}, and @code{apply}.
+@end deftypefn
+
+@deftypefn Instruction {} expand-apply-argument x24:@var{_}
+Take the last local in a frame and expand it out onto the stack, as for
+the last argument to @code{apply}.
+@end deftypefn
+
 
 @node Trampoline Instructions
 @subsubsection Trampoline Instructions
@@ -917,15 +911,29 @@ compiler probably shouldn't emit code with these instructions.  However,
 it's still interesting to know how these things work, so we document
 these trampoline instructions here.
 
-@deftypefn Instruction {} subr-call x24:@var{_}
-Call a subr, passing all locals in this frame as arguments.  Return from
-the calling frame.
+@deftypefn Instruction {} subr-call c24:@var{idx}
+Call a subr, passing all locals in this frame as arguments, and storing
+the results on the stack, ready to be returned.
 @end deftypefn
 
 @deftypefn Instruction {} foreign-call c12:@var{cif-idx} c12:@var{ptr-idx}
 Call a foreign function.  Fetch the @var{cif} and foreign pointer from
-@var{cif-idx} and @var{ptr-idx}, both free variables.  Return from the calling
-frame.  Arguments are taken from the stack.
+@var{cif-idx} and @var{ptr-idx} closure slots of the callee.  Arguments
+are taken from the stack, and results placed on the stack, ready to be
+returned.
+@end deftypefn
+
+@deftypefn Instruction {} builtin-ref s12:@var{dst} c12:@var{idx}
+Load a builtin stub by index into @var{dst}.
+@end deftypefn
+
+
+@node Non-Local Control Flow Instructions
+@subsubsection Non-Local Control Flow Instructions
+
+@deftypefn Instruction {} capture-continuation s24:@var{dst}
+Capture the current continuation, and write it to @var{dst}.  Part of
+the implementation of @code{call/cc}.
 @end deftypefn
 
 @deftypefn Instruction {} continuation-call c24:@var{contregs}
@@ -934,102 +942,367 @@ are taken from the stack.  @var{contregs} is a free variable containing
 the reified continuation.
 @end deftypefn
 
+@deftypefn Instruction {} abort x24:@var{_}
+Abort to a prompt handler.  The tag is expected in slot 1, and the rest
+of the values in the frame are returned to the prompt handler.  This
+corresponds to a tail application of @code{abort-to-prompt}.
+
+If no prompt can be found in the dynamic environment with the given tag,
+an error is signalled.  Otherwise all arguments are passed to the
+prompt's handler, along with the captured continuation, if necessary.
+
+If the prompt's handler can be proven to not reference the captured
+continuation, no continuation is allocated.  This decision happens
+dynamically, at run-time; the general case is that the continuation may
+be captured, and thus resumed.  A reinstated continuation will have its
+arguments pushed on the stack from slot 0, as if from a multiple-value
+return, and control resumes in the caller.  Thus to the calling
+function, a call to @code{abort-to-prompt} looks like any other function
+call.
+@end deftypefn
+
 @deftypefn Instruction {} compose-continuation c24:@var{cont}
-Compose a partial continution with the current continuation.  The
+Compose a partial continuation with the current continuation.  The
 arguments to the continuation are taken from the stack.  @var{cont} is a
 free variable containing the reified continuation.
 @end deftypefn
 
-@deftypefn Instruction {} tail-apply x24:@var{_}
-Tail-apply the procedure in local slot 0 to the rest of the arguments.
-This instruction is part of the implementation of @code{apply}, and is
-not generated by the compiler.
+@deftypefn Instruction {} prompt s24:@var{tag} b1:@var{escape-only?} x7:@var{_} f24:@var{proc-slot} x8:@var{_} l24:@var{handler-offset}
+Push a new prompt on the dynamic stack, with a tag from @var{tag} and a
+handler at @var{handler-offset} words from the current @var{ip}.
+
+If an abort is made to this prompt, control will jump to the handler.
+The handler will expect a multiple-value return as if from a call with
+the procedure at @var{proc-slot}, with the reified partial continuation
+as the first argument, followed by the values returned to the handler.
+If control returns to the handler, the prompt is already popped off by
+the abort mechanism.  (Guile's @code{prompt} implements Felleisen's
+@dfn{--F--} operator.)
+
+If @var{escape-only?} is nonzero, the prompt will be marked as
+escape-only, which allows an abort to this prompt to avoid reifying the
+continuation.
+
+@xref{Prompts}, for more information on prompts.
+@end deftypefn
+
+@deftypefn Instruction {} throw s12:@var{key} s12:@var{args}
+Raise an error by throwing to @var{key} and @var{args}.  @var{args}
+should be a list.
 @end deftypefn
 
-@deftypefn Instruction {} builtin-ref s12:@var{dst} c12:@var{idx}
-Load a builtin stub by index into @var{dst}.
+@deftypefn Instruction {} throw/value s24:@var{value} n32:@var{key-subr-and-message}
+@deftypefnx Instruction {} throw/value+data s24:@var{value} n32:@var{key-subr-and-message}
+Raise an error, indicating @var{val} as the bad value.
+@var{key-subr-and-message} should be a vector, where the first element
+is the symbol to which to throw, the second is the procedure in which to
+signal the error (a string) or @code{#f}, and the third is a format
+string for the message, with one template.  These instructions do not
+fall through.
+
+Both of these instructions throw to a key with four arguments: the
+procedure that indicates the error (or @code{#f}, the format string, a
+list with @var{value}, and either @code{#f} or the list with @var{value}
+as the last argument respectively.
 @end deftypefn
 
-@deftypefn Instruction {} apply-non-program x24:@var{_}
-An instruction used only by a special trampoline that the VM uses to
-apply non-programs.  Using that trampoline allows profilers and
-backtrace utilities to avoid seeing the instruction pointer from the
-calling frame.
+
+@node Instrumentation Instructions
+@subsubsection Instrumentation Instructions
+
+@deftypefn Instruction {} instrument-entry x24_@var{_} n32:@var{data}
+@deftypefnx Instruction {} instrument-loop x24_@var{_} n32:@var{data}
+Increase execution counter for this function and potentially tier up to
+the next JIT level.  @var{data} is an offset to a structure recording
+execution counts and the next-level JIT code corresponding to this
+function.  The increment values are currently 30 for
+@code{instrument-entry} and 2 for @code{instrument-loop}.
+
+@code{instrument-entry} will also run the apply hook, if VM hooks are
+enabled.
 @end deftypefn
 
+@deftypefn Instruction {} handle-interrupts x24:@var{_}
+Handle pending asynchronous interrupts (asyncs).  @xref{Asyncs}.  The
+compiler inserts @code{handle-interrupts} instructions before any call,
+return, or loop back-edge.
+@end deftypefn
 
-@node Branch Instructions
-@subsubsection Branch Instructions
+@deftypefn Instruction {} return-from-interrupt x24:@var{_}
+A special instruction to return from a call and also pop off the stack
+frame from the call.  Used when returning from asynchronous interrupts.
+@end deftypefn
 
-All offsets to branch instructions are 24-bit signed numbers, which
-count 32-bit units.  This gives Guile effectively a 26-bit address range
-for relative jumps.
 
-@deftypefn Instruction {} br l24:@var{offset}
-Add @var{offset} to the current instruction pointer.
+@node Intrinsic Call Instructions
+@subsubsection Intrinsic Call Instructions
+
+Guile's instruction set is low-level.  This is good because the separate
+components of, say, a @code{vector-ref} operation might be able to be
+optimized out, leaving only the operations that need to be performed at
+run-time.
+
+However some macro-operations may need to perform large amounts of
+computation at run-time to handle all the edge cases, and whose
+micro-operation components aren't amenable to optimization.
+Residualizing code for the entire macro-operation would lead to code
+bloat with no benefit.
+
+In this kind of a case, Guile's VM calls out to @dfn{intrinsics}:
+run-time routines written in the host language (currently C, possibly
+more in the future if Guile gains more run-time targets like
+WebAssembly).  There is one instruction for each instrinsic prototype;
+the intrinsic is specified by index in the instruction.
+
+@deftypefn Instruction {} call-thread x24:@var{_} c32:@var{idx}
+Call the @code{void}-returning instrinsic with index @var{idx}, passing
+the current @code{scm_thread*} as the argument.
+@end deftypefn
+
+@deftypefn Instruction {} call-thread-scm s24:@var{a} c32:@var{idx}
+Call the @code{void}-returning instrinsic with index @var{idx}, passing
+the current @code{scm_thread*} and the @code{scm} local @var{a} as
+arguments.
 @end deftypefn
 
-All the conditional branch instructions described below have an
-@var{invert} parameter, which if true reverses the test:
-@code{br-if-true} becomes @code{br-if-false}, and so on.
+@deftypefn Instruction {} call-thread-scm-scm s12:@var{a} s12:@var{b} c32:@var{idx}
+Call the @code{void}-returning instrinsic with index @var{idx}, passing
+the current @code{scm_thread*} and the @code{scm} locals @var{a} and
+@var{b} as arguments.
+@end deftypefn
 
-@deftypefn Instruction {} br-if-true s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is true for the purposes of Scheme, add
-@var{offset} to the current instruction pointer.
+@deftypefn Instruction {} call-scm-sz-u32 s12:@var{a} s12:@var{b} c32:@var{idx}
+Call the @code{void}-returning instrinsic with index @var{idx}, passing
+the locals @var{a}, @var{b}, and @var{c} as arguments.  @var{a} is a
+@code{scm} value, while @var{b} and @var{c} are raw @code{u64} values
+which fit into @code{size_t} and @code{uint32_t} types, respectively.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-null s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is the end-of-list or Lisp nil, add
-@var{offset} to the current instruction pointer.
+@deftypefn Instruction {} call-scm<-u64 s24:@var{dst} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+the current @code{scm_thread*} as the argument.  Place the result in
+@var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-nil s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is false to Lisp, add @var{offset} to the
-current instruction pointer.
+@deftypefn Instruction {} call-scm<-u64 s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{u64} local @var{a} as the argument.  Place the result in
+@var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-pair s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is a pair, add @var{offset} to the current
-instruction pointer.
+@deftypefn Instruction {} call-scm<-s64 s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{s64} local @var{a} as the argument.  Place the result in
+@var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-struct s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is a struct, add @var{offset} number to the
-current instruction pointer.
+@deftypefn Instruction {} call-scm<-scm s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{scm} local @var{a} as the argument.  Place the result in
+@var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-char s24:@var{test} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{test} is a char, add @var{offset} to the current
-instruction pointer.
+@deftypefn Instruction {} call-u64<-scm s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{uint64_t}-returning instrinsic with index @var{idx},
+passing @code{scm} local @var{a} as the argument.  Place the @code{u64}
+result in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-tc7 s24:@var{test} b1:@var{invert} u7:@var{tc7} l24:@var{offset}
-If the value in @var{test} has the TC7 given in the second word, add
-@var{offset} to the current instruction pointer.  TC7 codes are part of
-the way Guile represents non-immediate objects, and are deep wizardry.
-See @code{libguile/tags.h} for all the details.
+@deftypefn Instruction {} call-s64<-scm s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{int64_t}-returning instrinsic with index @var{idx},
+passing @code{scm} local @var{a} as the argument.  Place the @code{s64}
+result in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-eq s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-eqv s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{a} is @code{eq?} or @code{eqv?} to the value in
-@var{b}, respectively, add @var{offset} to the current instruction
-pointer.
+@deftypefn Instruction {} call-f64<-scm s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{double}-returning instrinsic with index @var{idx},
+passing @code{scm} local @var{a} as the argument.  Place the @code{f64}
+result in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-< s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-<= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the value in @var{a} is @code{=}, @code{<}, or @code{<=} to the value
-in @var{b}, respectively, add @var{offset} to the current instruction
-pointer.
+@deftypefn Instruction {} call-scm<-scm-scm s8:@var{dst} s8:@var{a} s8:@var{b} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{scm} locals @var{a} and @var{b} as arguments.  Place the
+@code{scm} result in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} br-if-logtest s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the bitwise intersection of the integers in @var{a} and @var{b} is
-nonzero, add @var{offset} to the current instruction pointer.
+@deftypefn Instruction {} call-scm<-scm-uimm s8:@var{dst} s8:@var{a} c8:@var{b} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{scm} local @var{a} and @code{uint8_t} immediate @var{b} as
+arguments.  Place the @code{scm} result in @var{dst}.
 @end deftypefn
 
+@deftypefn Instruction {} call-scm<-thread-scm s12:@var{dst} s12:@var{a} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+the current @code{scm_thread*} and @code{scm} local @var{a} as
+arguments.  Place the @code{scm} result in @var{dst}.
+@end deftypefn
+
+@deftypefn Instruction {} call-scm<-scm-u64 s8:@var{dst} s8:@var{a} s8:@var{b} c32:@var{idx}
+Call the @code{SCM}-returning instrinsic with index @var{idx}, passing
+@code{scm} local @var{a} and @code{u64} local @var{b} as arguments.
+Place the @code{scm} result in @var{dst}.
+@end deftypefn
+
+There are corresponding macro-instructions for specific intrinsics.
+These are equivalent to @code{call-@var{instrinsic-kind}} instructions
+with the appropriate intrinsic @var{idx} arguments.
+
+@deffn {Macro Instruction} add dst a b
+@deffnx {Macro Instruction} add/immediate dst a b/imm
+Add @code{SCM} values @var{a} and @var{b} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} sub dst a b
+@deffnx {Macro Instruction} sub/immediate dst a b/imm
+Subtract @code{SCM} value @var{b} from @var{a} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} mul dst a b
+Multiply @code{SCM} values @var{a} and @var{b} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} div dst a b
+Divide @code{SCM} value @var{a} by @var{b} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} quo dst a b
+Compute the quotient of @code{SCM} values @var{a} and @var{b} and place
+the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} rem dst a b
+Compute the remainder of @code{SCM} values @var{a} and @var{b} and place
+the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} mod dst a b
+Compute the modulo of @code{SCM} value @var{a} by @var{b} and place the
+result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} logand dst a b
+Compute the bitwise @code{and} of @code{SCM} values @var{a} and @var{b}
+and place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} logior dst a b
+Compute the bitwise inclusive @code{or} of @code{SCM} values @var{a} and
+@var{b} and place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} logxor dst a b
+Compute the bitwise exclusive @code{or} of @code{SCM} values @var{a} and
+@var{b} and place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} logsub dst a b
+Compute the bitwise @code{and} of @code{SCM} value @var{a} and the
+bitwise @code{not} of @var{b} and place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} lsh dst a b
+@deffnx {Macro Instruction} lsh/immediate a b/imm
+Shift @code{SCM} value @var{a} left by @code{u64} value @var{b} bits and
+place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} rsh dst a b
+@deffnx {Macro Instruction} rsh/immediate dst a b/imm
+Shifts @code{SCM} value @var{a} right by @code{u64} value @var{b} bits
+and place the result in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} scm->f64 dst src
+Convert @var{src} to an unboxed @code{f64} and place the result in
+@var{dst}, or raises an error if @var{src} is not a real number.
+@end deffn
+@deffn {Macro Instruction} scm->u64 dst src
+Convert @var{src} to an unboxed @code{u64} and place the result in
+@var{dst}, or raises an error if @var{src} is not an integer within
+range.
+@end deffn
+@deffn {Macro Instruction} scm->u64/truncate dst src
+Convert @var{src} to an unboxed @code{u64} and place the result in
+@var{dst}, truncating to the low 64 bits, or raises an error if
+@var{src} is not an integer.
+@end deffn
+@deffn {Macro Instruction} scm->s64 dst src
+Convert @var{src} to an unboxed @code{s64} and place the result in
+@var{dst}, or raises an error if @var{src} is not an integer within
+range.
+@end deffn
+@deffn {Macro Instruction} u64->scm dst src
+Convert @var{u64} value @var{src} to a Scheme integer in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} s64->scm scm<-s64
+Convert @var{s64} value @var{src} to a Scheme integer in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} string-set! str idx ch
+Sets the character @var{idx} (a @code{u64}) of string @var{str} to
+@var{ch} (a @code{u64} that is a valid character value).
+@end deffn
+@deffn {Macro Instruction} string->number dst src
+Call @code{string->number} on @var{src} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} string->symbol dst src
+Call @code{string->symbol} on @var{src} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} symbol->keyword dst src
+Call @code{symbol->keyword} on @var{src} and place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} class-of dst src
+Set @var{dst} to the GOOPS class of @code{src}.
+@end deffn
+@deffn {Macro Instruction} wind winder unwinder
+Push wind and unwind procedures onto the dynamic stack.  Note that
+neither are actually called; the compiler should emit calls to
+@var{winder} and @var{unwinder} for the normal dynamic-wind control
+flow.  Also note that the compiler should have inserted checks that
+@var{winder} and @var{unwinder} are thunks, if it could not prove that
+to be the case.  @xref{Dynamic Wind}.
+@end deffn
+@deffn {Macro Instruction} unwind
+Exit from the dynamic extent of an expression, popping the top entry off
+of the dynamic stack.
+@end deffn
+@deffn {Macro Instruction} push-fluid fluid value
+Dynamically bind @var{value} to @var{fluid} by creating a with-fluids
+object, pushing that object on the dynamic stack.  @xref{Fluids and
+Dynamic States}.
+@end deffn
+@deffn {Macro Instruction} pop-fluid
+Leave the dynamic extent of a @code{with-fluid*} expression, restoring
+the fluid to its previous value.  @code{push-fluid} should always be
+balanced with @code{pop-fluid}.
+@end deffn
+@deffn {Macro Instruction} fluid-ref dst fluid
+Place the value associated with the fluid @var{fluid} in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} fluid-set! fluid value
+Set the value of the fluid @var{fluid} to @var{value}.
+@end deffn
+@deffn {Macro Instruction} push-dynamic-state state
+Save the current set of fluid bindings on the dynamic stack and instate
+the bindings from @var{state} instead.  @xref{Fluids and Dynamic
+States}.
+@end deffn
+@deffn {Macro Instruction} pop-dynamic-state
+Restore a saved set of fluid bindings from the dynamic stack.
+@code{push-dynamic-state} should always be balanced with
+@code{pop-dynamic-state}.
+@end deffn
+@deffn {Macro Instruction} resolve-module dst name public?
+Look up the module named @var{name}, resolve its public interface if the
+immediate operand @var{public?} is true, then place the result in
+@var{dst}.
+@end deffn
+@deffn {Macro Instruction} lookup dst mod sym
+Look up @var{sym} in module @var{mod}, placing the resulting variable
+(or @code{#f} if not found) in @var{dst}.
+@end deffn
+@deffn {Macro Instruction} define! dst mod sym
+Look up @var{sym} in module @var{mod}, placing the resulting variable in
+@var{dst}, creating the variable if needed.
+@end deffn
+@deffn {Macro Instruction} current-module dst
+Set @var{dst} to the current module.
+@end deffn
+
 
 @node Constant Instructions
 @subsubsection Constant Instructions
@@ -1059,7 +1332,7 @@ indirectly.  For example, Guile knows at compile-time what the layout of
 a string will be like, and arranges to embed that object directly in the
 compiled image.  A reference to a string will use
 @code{make-non-immediate} to treat a pointer into the compilation unit
-as a @code{SCM} value directly.
+as a @code{scm} value directly.
 
 @deftypefn Instruction {} make-non-immediate s24:@var{dst} n32:@var{offset}
 Load a pointer to statically allocated memory into @var{dst}.  The
@@ -1069,6 +1342,32 @@ depends on where it was allocated by the compiler, and loaded by the
 loader.
 @end deftypefn
 
+Sometimes you need to load up a code pointer into a register; for this,
+use @code{load-label}.
+
+@deftypefn Instruction {} make-non-immediate s24:@var{dst} l32:@var{offset}
+Load a label @var{offset} words away from the current @code{ip} and
+write it to @var{dst}.  @var{offset} is a signed 32-bit integer.
+@end deftypefn
+
+Finally, Guile supports a number of unboxed data types, with their
+associate constant loaders.
+
+@deftypefn Instruction {} load-f64 s24:@var{dst} au32:@var{high-bits} au32:@var{low-bits}
+Load a double-precision floating-point value formed by joining
+@var{high-bits} and @var{low-bits}, and write it to @var{dst}.
+@end deftypefn
+
+@deftypefn Instruction {} load-u64 s24:@var{dst} au32:@var{high-bits} au32:@var{low-bits}
+Load an unsigned 64-bit integer formed by joining @var{high-bits} and
+@var{low-bits}, and write it to @var{dst}.
+@end deftypefn
+
+@deftypefn Instruction {} load-s64 s24:@var{dst} au32:@var{high-bits} au32:@var{low-bits}
+Load a signed 64-bit integer formed by joining @var{high-bits} and
+@var{low-bits}, and write it to @var{dst}.
+@end deftypefn
+
 Some objects must be unique across the whole system.  This is the case
 for symbols and keywords.  For these objects, Guile arranges to
 initialize them when the compilation unit is loaded, storing them into a
@@ -1098,406 +1397,428 @@ are signed 32-bit values, indicating a memory address as a number
 of 32-bit words away from the current instruction pointer.
 @end deftypefn
 
-Many kinds of literals can be loaded with the above instructions, once
-the compiler has prepared the statically allocated data.  This is the
-case for vectors, strings, uniform vectors, pairs, and procedures with
-no free variables.  Other kinds of data might need special initializers;
-those instructions follow.
 
-@deftypefn Instruction {} string->number s12:@var{dst} s12:@var{src}
-Parse a string in @var{src} to a number, and store in @var{dst}.
-@end deftypefn
+@node Memory Access Instructions
+@subsubsection Memory Access Instructions
 
-@deftypefn Instruction {} string->symbol s12:@var{dst} s12:@var{src}
-Parse a string in @var{src} to a symbol, and store in @var{dst}.
-@end deftypefn
+In these instructions, the @code{/immediate} variants represent their
+indexes or counts as immediates; otherwise these values are unboxed u64
+locals.
 
-@deftypefn Instruction {} symbol->keyword s12:@var{dst} s12:@var{src}
-Make a keyword from the symbol in @var{src}, and store it in @var{dst}.
+@deftypefn Instruction {} allocate-words s12:@var{dst} s12:@var{count}
+@deftypefnx Instruction {} allocate-words/immediate s12:@var{dst} c12:@var{count}
+Allocate a fresh GC-traced object consisting of @var{count} words and
+store it into @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} load-typed-array s24:@var{dst} x8:@var{_} s24:@var{type} x8:@var{_} s24:@var{shape} n32:@var{offset} u32:@var{len}
-Load the contiguous typed array located at @var{offset} 32-bit words away
-from the instruction pointer, and store into @var{dst}.  @var{len} is a byte
-length.  @var{offset} is signed.
+@deftypefn Instruction {} scm-ref s8:@var{dst} s8:@var{obj} s8:@var{idx}
+@deftypefnx Instruction {} scm-ref/immediate s8:@var{dst} s8:@var{obj} c8:@var{idx}
+Load the @code{SCM} object at word offset @var{idx} from local
+@var{obj}, and store it to @var{dst}.
 @end deftypefn
 
-
-@node Dynamic Environment Instructions
-@subsubsection Dynamic Environment Instructions
-
-Guile's virtual machine has low-level support for @code{dynamic-wind},
-dynamic binding, and composable prompts and aborts.
-
-@deftypefn Instruction {} abort x24:@var{_}
-Abort to a prompt handler.  The tag is expected in slot 1, and the rest
-of the values in the frame are returned to the prompt handler.  This
-corresponds to a tail application of abort-to-prompt.
-
-If no prompt can be found in the dynamic environment with the given tag,
-an error is signalled.  Otherwise all arguments are passed to the
-prompt's handler, along with the captured continuation, if necessary.
-
-If the prompt's handler can be proven to not reference the captured
-continuation, no continuation is allocated.  This decision happens
-dynamically, at run-time; the general case is that the continuation may
-be captured, and thus resumed.  A reinstated continuation will have its
-arguments pushed on the stack from slot 1, as if from a multiple-value
-return, and control resumes in the caller.  Thus to the calling
-function, a call to @code{abort-to-prompt} looks like any other function
-call.
+@deftypefn Instruction {} scm-set! s8:@var{dst} s8:@var{idx} s8:@var{obj}
+@deftypefnx Instruction {} scm-set!/immediate s8:@var{dst} c8:@var{idx} s8:@var{obj}
+Store the @code{scm} local @var{val} into object @var{obj} at word
+offset @var{idx}.
 @end deftypefn
 
-@deftypefn Instruction {} prompt s24:@var{tag} b1:@var{escape-only?} x7:@var{_} f24:@var{proc-slot} x8:@var{_} l24:@var{handler-offset}
-Push a new prompt on the dynamic stack, with a tag from @var{tag} and a
-handler at @var{handler-offset} words from the current @var{ip}.
-
-If an abort is made to this prompt, control will jump to the handler.
-The handler will expect a multiple-value return as if from a call with
-the procedure at @var{proc-slot}, with the reified partial continuation
-as the first argument, followed by the values returned to the handler.
-If control returns to the handler, the prompt is already popped off by
-the abort mechanism.  (Guile's @code{prompt} implements Felleisen's
-@dfn{--F--} operator.)
-
-If @var{escape-only?} is nonzero, the prompt will be marked as
-escape-only, which allows an abort to this prompt to avoid reifying the
-continuation.
-
-@xref{Prompts}, for more information on prompts.
+@deftypefn Instruction {} scm-ref/tag s8:@var{dst} s8:@var{obj} c8:@var{tag}
+Load the first word of @var{obj}, subtract the immediate @var{tag}, and store the
+resulting @code{SCM} to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} wind s12:@var{winder} s12:@var{unwinder}
-Push wind and unwind procedures onto the dynamic stack. Note that
-neither are actually called; the compiler should emit calls to wind and
-unwind for the normal dynamic-wind control flow.  Also note that the
-compiler should have inserted checks that they wind and unwind procs are
-thunks, if it could not prove that to be the case.  @xref{Dynamic Wind}.
+@deftypefn Instruction {} scm-set!/tag s8:@var{obj} c8:@var{tag} s8:@var{val}
+Set the first word of @var{obj} to the unpacked bits of the @code{scm}
+value @var{val} plus the immediate value @var{tag}.
 @end deftypefn
 
-@deftypefn Instruction {} unwind x24:@var{_}
-@var{a} normal exit from the dynamic extent of an expression. Pop the top
-entry off of the dynamic stack.
+@deftypefn Instruction {} word-ref s8:@var{dst} s8:@var{obj} s8:@var{idx}
+@deftypefnx Instruction {} word-ref/immediate s8:@var{dst} s8:@var{obj} c8:@var{idx}
+Load the word at offset @var{idx} from local @var{obj}, and store it to
+the @code{u64} local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} push-fluid s12:@var{fluid} s12:@var{value}
-Dynamically bind @var{value} to @var{fluid} by creating a with-fluids
-object and pushing that object on the dynamic stack.  @xref{Fluids and
-Dynamic States}.
+@deftypefn Instruction {} word-set! s8:@var{dst} s8:@var{idx} s8:@var{obj}
+@deftypefnx Instruction {} word-set!/immediate s8:@var{dst} c8:@var{idx} s8:@var{obj}
+Store the @code{u64} local @var{val} into object @var{obj} at word
+offset @var{idx}.
 @end deftypefn
 
-@deftypefn Instruction {} pop-fluid x24:@var{_}
-Leave the dynamic extent of a @code{with-fluid*} expression, restoring
-the fluid to its previous value.  @code{push-fluid} should always be
-balanced with @code{pop-fluid}.
+@deftypefn Instruction {} pointer-ref/immediate s8:@var{dst} s8:@var{obj} c8:@var{idx}
+Load the pointer at offset @var{idx} from local @var{obj}, and store it
+to the unboxed pointer local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} fluid-ref s12:@var{dst} s12:@var{src}
-Reference the fluid in @var{src}, and place the value in @var{dst}.
+@deftypefn Instruction {} pointer-set!/immediate s8:@var{dst} c8:@var{idx} s8:@var{obj}
+Store the unboxed pointer local @var{val} into object @var{obj} at word
+offset @var{idx}.
 @end deftypefn
 
-@deftypefn Instruction {} fluid-set! s12:@var{fluid} s12:@var{val}
-Set the value of the fluid in @var{dst} to the value in @var{src}.
+@deftypefn Instruction {} tail-pointer-ref/immediate s8:@var{dst} s8:@var{obj} c8:@var{idx}
+Compute the address of word offset @var{idx} from local @var{obj}, and store it
+to @var{dst}.
 @end deftypefn
 
+
+@node Atomic Memory Access Instructions
+@subsubsection Atomic Memory Access Instructions
+
 @deftypefn Instruction {} current-thread s24:@var{dst}
-Write the value of the current thread to @var{dst}.
+Write the current thread into @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} push-dynamic-state s24:@var{state}
-Save the current set of fluid bindings on the dynamic stack and instate
-the bindings from @var{state} instead.  @xref{Fluids and Dynamic
-States}.
+@deftypefn Instruction {} atomic-scm-ref/immediate s8:@var{dst} s8:@var{obj} c8:@var{idx}
+Atomically load the @code{SCM} object at word offset @var{idx} from
+local @var{obj}, using the sequential consistency memory model.  Store
+the result to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} pop-dynamic-state x24:@var{_}
-Restore a saved set of fluid bindings from the dynamic stack.
-@code{push-dynamic-state} should always be balanced with
-@code{pop-dynamic-state}.
+@deftypefn Instruction {} atomic-scm-set!/immediate s8:@var{obj} c8:@var{idx} s8:@var{val}
+Atomically set the @code{SCM} object at word offset @var{idx} from local
+@var{obj} to @var{val}, using the sequential consistency memory model.
 @end deftypefn
 
-
-@node Miscellaneous Instructions
-@subsubsection Miscellaneous Instructions
-
-@deftypefn Instruction {} halt x24:@var{_}
-Bring the VM to a halt, returning all the values from the stack.  Used
-in the ``boot continuation'', which is used when entering the VM from C.
+@deftypefn Instruction {} atomic-scm-swap!/immediate s24:@var{dst} x8:@var{_} s24:@var{obj} c8:@var{idx} s24:@var{val}
+Atomically swap the @code{SCM} value stored in object @var{obj} at word
+offset @var{idx} with @var{val}, using the sequentially consistent
+memory model.  Store the previous value to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} push s24:@var{src}
-Bump the stack pointer by one word, and fill it with the value from slot
-@var{src}.  The offset to @var{src} is calculated before the stack
-pointer is adjusted.
+@deftypefn Instruction {} atomic-scm-compare-and-swap!/immediate s24:@var{dst} x8:@var{_} s24:@var{obj} c8:@var{idx} s24:@var{expected} x8:@var{_} s24:@var{desired}
+Atomically swap the @code{SCM} value stored in object @var{obj} at word
+offset @var{idx} with @var{desired}, if and only if the value that was
+there was @var{expected}, using the sequentially consistent memory
+model.  Store the value that was previously at @var{idx} from @var{obj}
+in @var{dst}.
 @end deftypefn
 
-The @code{push} instruction is used when another instruction is unable
-to address an operand because the operand is encoded with fewer than 24
-bits.  In that case, Guile's assembler will transparently emit code that
-temporarily pushes any needed operands onto the stack, emits the
-original instruction to address those now-near variables, then shuffles
-the result (if any) back into place.
 
-@deftypefn Instruction {} pop s24:@var{dst}
-Pop the stack pointer, storing the value that was there in slot
-@var{dst}.  The offset to @var{dst} is calculated after the stack
-pointer is adjusted.
-@end deftypefn
+@node Tagging and Untagging Instructions
+@subsubsection Tagging and Untagging Instructions
 
-@deftypefn Instruction {} drop c24:@var{count}
-Pop the stack pointer by @var{count} words, discarding any values that
-were stored there.
+@deftypefn Instruction {} tag-char s12:@var{dst} s12:@var{src}
+Make a @code{SCM} character whose integer value is the @code{u64} in
+@var{src}, and store it in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} handle-interrupts x24:@var{_}
-Handle pending asynchronous interrupts (asyncs).  @xref{Asyncs}.  The
-compiler inserts @code{handle-interrupts} instructions before any call,
-return, or loop back-edge.
+@deftypefn Instruction {} untag-char s12:@var{dst} s12:@var{src}
+Extract the integer value from the @code{SCM} character @var{src}, and
+store the resulting @code{u64} in @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} return-from-interrupt x24:@var{_}
-A special instruction to return from a call and also pop off the stack
-frame from the call.  Used when returning from asynchronous interrupts.
+@deftypefn Instruction {} tag-fixnum s12:@var{dst} s12:@var{src}
+Make a @code{SCM} integer whose value is the @code{s64} in @var{src},
+and store it in @var{dst}.
 @end deftypefn
 
+@deftypefn Instruction {} untag-fixnum s12:@var{dst} s12:@var{src}
+Extract the integer value from the @code{SCM} integer @var{src}, and
+store the resulting @code{s64} in @var{dst}.
+@end deftypefn
 
-@node Inlined Scheme Instructions
-@subsubsection Inlined Scheme Instructions
 
-The Scheme compiler can recognize the application of standard Scheme
-procedures.  It tries to inline these small operations to avoid the
-overhead of creating new stack frames.  This allows the compiler to
-optimize better.
+@node Integer Arithmetic Instructions
+@subsubsection Integer Arithmetic Instructions
 
-@deftypefn Instruction {} make-vector s8:@var{dst} s8:@var{length} s8:@var{init}
-Make a vector and write it to @var{dst}.  The vector will have space for
-@var{length} slots.  They will be filled with the value in slot
-@var{init}.
+@deftypefn Instruction {} uadd s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} uadd/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Add the @code{u64} values @var{a} and @var{b}, and store the @code{u64}
+result to @var{dst}.  Overflow will wrap.
 @end deftypefn
 
-@deftypefn Instruction {} make-vector/immediate s8:@var{dst} s8:@var{length} c8:@var{init}
-Make a short vector of known size and write it to @var{dst}.  The vector
-will have space for @var{length} slots, an immediate value.  They will
-be filled with the value in slot @var{init}.
+@deftypefn Instruction {} usub s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} usub/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Subtract the @code{u64} value @var{b} from @var{a}, and store the
+@code{u64} result to @var{dst}.  Underflow will wrap.
 @end deftypefn
 
-@deftypefn Instruction {} vector-length s12:@var{dst} s12:@var{src}
-Store the length of the vector in @var{src} in @var{dst}, as an unboxed
-unsigned 64-bit integer.
+@deftypefn Instruction {} umul s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} umul/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Multiply the @code{u64} values @var{a} and @var{b}, and store the
+@code{u64} result to @var{dst}.  Overflow will wrap.
 @end deftypefn
 
-@deftypefn Instruction {} vector-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-Fetch the item at position @var{idx} in the vector in @var{src}, and
-store it in @var{dst}.  The @var{idx} value should be an unboxed
-unsigned 64-bit integer.
+@deftypefn Instruction {} ulogand s8:@var{dst} s8:@var{a} s8:@var{b}
+Place the bitwise @code{and} of the @code{u64} values @var{a} and
+@var{b} into the @code{u64} local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} vector-ref/immediate s8:@var{dst} s8:@var{src} c8:@var{idx}
-Fill @var{dst} with the item @var{idx} elements into the vector at
-@var{src}.  Useful for building data types using vectors.
+@deftypefn Instruction {} ulogior s8:@var{dst} s8:@var{a} s8:@var{b}
+Place the bitwise inclusive @code{or} of the @code{u64} values @var{a}
+and @var{b} into the @code{u64} local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} vector-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-Store @var{src} into the vector @var{dst} at index @var{idx}.  The
-@var{idx} value should be an unboxed unsigned 64-bit integer.
+@deftypefn Instruction {} ulogxor s8:@var{dst} s8:@var{a} s8:@var{b}
+Place the bitwise exclusive @code{or} of the @code{u64} values @var{a}
+and @var{b} into the @code{u64} local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} vector-set!/immediate s8:@var{dst} c8:@var{idx} s8:@var{src}
-Store @var{src} into the vector @var{dst} at index @var{idx}.  Here
-@var{idx} is an immediate value.
+@deftypefn Instruction {} ulogsub s8:@var{dst} s8:@var{a} s8:@var{b}
+Place the bitwise @code{and} of the @code{u64} values @var{a} and the
+bitwise @code{not} of @var{b} into the @code{u64} local @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} struct-vtable s12:@var{dst} s12:@var{src}
-Store the vtable of @var{src} into @var{dst}.
+@deftypefn Instruction {} ulsh s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} ulsh/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Shift the unboxed unsigned 64-bit integer in @var{a} left by @var{b}
+bits, also an unboxed unsigned 64-bit integer.  Truncate to 64 bits and
+write to @var{dst} as an unboxed value.  Only the lower 6 bits of
+@var{b} are used.
 @end deftypefn
 
-@deftypefn Instruction {} allocate-struct s8:@var{dst} s8:@var{vtable} s8:@var{nfields}
-Allocate a new struct with @var{vtable}, and place it in @var{dst}.  The
-struct will be constructed with space for @var{nfields} fields, which
-should correspond to the field count of the @var{vtable}.  The @var{idx}
-value should be an unboxed unsigned 64-bit integer.
+@deftypefn Instruction {} ursh s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} ursh/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Shift the unboxed unsigned 64-bit integer in @var{a} right by @var{b}
+bits, also an unboxed unsigned 64-bit integer.  Truncate to 64 bits and
+write to @var{dst} as an unboxed value.  Only the lower 6 bits of
+@var{b} are used.
 @end deftypefn
 
-@deftypefn Instruction {} struct-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-Fetch the item at slot @var{idx} in the struct in @var{src}, and store
-it in @var{dst}.  The @var{idx} value should be an unboxed unsigned
-64-bit integer.
+@deftypefn Instruction {} srsh s8:@var{dst} s8:@var{a} s8:@var{b}
+@deftypefnx Instruction {} srsh/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
+Shift the unboxed signed 64-bit integer in @var{a} right by @var{b}
+bits, also an unboxed signed 64-bit integer.  Truncate to 64 bits and
+write to @var{dst} as an unboxed value.  Only the lower 6 bits of
+@var{b} are used.
 @end deftypefn
 
-@deftypefn Instruction {} struct-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-Store @var{src} into the struct @var{dst} at slot @var{idx}.  The
-@var{idx} value should be an unboxed unsigned 64-bit integer.
-@end deftypefn
 
-@deftypefn Instruction {} allocate-struct/immediate s8:@var{dst} s8:@var{vtable} c8:@var{nfields}
-@deftypefnx Instruction {} struct-ref/immediate s8:@var{dst} s8:@var{src} c8:@var{idx}
-@deftypefnx Instruction {} struct-set!/immediate s8:@var{dst} c8:@var{idx} s8:@var{src}
-Variants of the struct instructions, but in which the @var{nfields} or
-@var{idx} fields are immediate values.
-@end deftypefn
+@node Floating-Point Arithmetic Instructions
+@subsubsection Floating-Point Arithmetic Instructions
 
-@deftypefn Instruction {} class-of s12:@var{dst} s12:@var{type}
-Store the vtable of @var{src} into @var{dst}.
+@deftypefn Instruction {} fadd s8:@var{dst} s8:@var{a} s8:@var{b}
+Add the @code{f64} values @var{a} and @var{b}, and store the @code{f64}
+result to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} make-array s24:@var{dst} x8:@var{_} s24:@var{type} x8:@var{_} s24:@var{fill} x8:@var{_} s24:@var{bounds}
-Make a new array with @var{type}, @var{fill}, and @var{bounds}, storing it in @var{dst}.
+@deftypefn Instruction {} fsub s8:@var{dst} s8:@var{a} s8:@var{b}
+Subtract the @code{f64} value @var{b} from @var{a}, and store the
+@code{f64} result to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} string-length s12:@var{dst} s12:@var{src}
-Store the length of the string in @var{src} in @var{dst}, as an unboxed
-unsigned 64-bit integer.
+@deftypefn Instruction {} fmul s8:@var{dst} s8:@var{a} s8:@var{b}
+Multiply the @code{f64} values @var{a} and @var{b}, and store the
+@code{f64} result to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} string-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-Fetch the character at position @var{idx} in the string in @var{src},
-and store it in @var{dst}.  The @var{idx} value should be an unboxed
-unsigned 64-bit integer.
+@deftypefn Instruction {} fdiv s8:@var{dst} s8:@var{a} s8:@var{b}
+Divide the @code{f64} values @var{a} by @var{b}, and store the
+@code{f64} result to @var{dst}.
 @end deftypefn
 
-@deftypefn Instruction {} string-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-Store the character @var{src} into the string @var{dst} at index
-@var{idx}.  The @var{idx} value should be an unboxed unsigned 64-bit
-integer.
-@end deftypefn
 
-@deftypefn Instruction {} cons s8:@var{dst} s8:@var{car} s8:@var{cdr}
-Cons @var{car} and @var{cdr}, and store the result in @var{dst}.
-@end deftypefn
+@node Comparison Instructions
+@subsubsection Comparison Instructions
 
-@deftypefn Instruction {} car s12:@var{dst} s12:@var{src}
-Place the car of @var{src} in @var{dst}.
+@deftypefn Instruction {} u64=? s12:@var{a} s12:@var{b}
+Set the comparison result to @var{EQUAL} if the @code{u64} values
+@var{a} and @var{b} are the same, or @code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} cdr s12:@var{dst} s12:@var{src}
-Place the cdr of @var{src} in @var{dst}.
+@deftypefn Instruction {} u64<? s12:@var{a} s12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{u64} value
+@var{a} is less than the @code{u64} value @var{b} are the same, or
+@code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} set-car! s12:@var{pair} s12:@var{car}
-Set the car of @var{dst} to @var{src}.
+@deftypefn Instruction {} s64<? s12:@var{a} s12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{s64} value
+@var{a} is less than the @code{s64} value @var{b} are the same, or
+@code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} set-cdr! s12:@var{pair} s12:@var{cdr}
-Set the cdr of @var{dst} to @var{src}.
+@deftypefn Instruction {} s64-imm=? s12:@var{a} z12:@var{b}
+Set the comparison result to @var{EQUAL} if the @code{s64} value @var{a}
+is equal to the immediate @code{s64} value @var{b}, or @code{NONE}
+otherwise.
 @end deftypefn
 
-Note that @code{caddr} and friends compile to a series of @code{car}
-and @code{cdr} instructions.
-
-@deftypefn Instruction {} integer->char s12:@var{dst} s12:@var{src}
-Convert the @code{u64} value in @var{src} to a Scheme character, and
-place it in @var{dst}.
+@deftypefn Instruction {} u64-imm<? s12:@var{a} c12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{u64} value
+@var{a} is less than the immediate @code{u64} value @var{b}, or
+@code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} char->integer s12:@var{dst} s12:@var{src}
-Convert the Scheme character in @var{src} to an integer, and place it in
-@var{dst} as an unboxed @code{u64} value.
+@deftypefn Instruction {} imm-u64<? s12:@var{a} s12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{u64}
+immediate @var{b} is less than the @code{u64} value @var{a}, or
+@code{NONE} otherwise.
 @end deftypefn
 
-
-@node Inlined Atomic Instructions
-@subsubsection Inlined Atomic Instructions
-
-@xref{Atomics}, for more on atomic operations in Guile.
-
-@deftypefn Instruction {} make-atomic-box s12:@var{dst} s12:@var{src}
-Create a new atomic box initialized to @var{src}, and place it in
-@var{dst}.
+@deftypefn Instruction {} s64-imm<? s12:@var{a} z12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{s64} value
+@var{a} is less than the immediate @code{s64} value @var{b}, or
+@code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} atomic-box-ref s12:@var{dst} s12:@var{box}
-Fetch the value of the atomic box at @var{box} into @var{dst}.
+@deftypefn Instruction {} imm-s64<? s12:@var{a} z12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the @code{s64}
+immediate @var{b} is less than the @code{s64} value @var{a}, or
+@code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} atomic-box-set! s12:@var{box} s12:@var{val}
-Set the contents of the atomic box at @var{box} to @var{val}.
+@deftypefn Instruction {} f64=? s12:@var{a} s12:@var{b}
+Set the comparison result to @var{EQUAL} if the f64 value @var{a} is
+equal to the f64 value @var{b}, or @code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} atomic-box-swap! s12:@var{dst} s12:@var{box} x8:@var{_} s24:@var{val}
-Replace the contents of the atomic box at @var{box} to @var{val} and
-store the previous value at @var{dst}.
+@deftypefn Instruction {} f64<? s12:@var{a} s12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the f64 value @var{a}
+is less than the f64 value @var{b}, @code{NONE} if @var{a} is greater
+than or equal to @var{b}, or @code{INVALID} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} atomic-box-compare-and-swap! s12:@var{dst} s12:@var{box} x8:@var{_} s24:@var{expected} x8:@var{_} s24:@var{desired}
-If the value of the atomic box at @var{box} is the same as the SCM value
-at @var{expected} (in the sense of @code{eq?}), replace the contents of
-the box with the SCM value at @var{desired}.  Otherwise does not update
-the box.  Set @var{dst} to the previous value of the box in either case.
+@deftypefn Instruction {} =? s12:@var{a} s12:@var{b}
+Set the comparison result to @var{EQUAL} if the SCM values @var{a} and
+@var{b} are numerically equal, in the sense of the Scheme @code{=}
+operator.  Set to @code{NONE} otherwise.
 @end deftypefn
 
-
-@node Inlined Mathematical Instructions
-@subsubsection Inlined Mathematical Instructions
-
-Inlining mathematical operations has the obvious advantage of handling
-fixnums without function calls or allocations. The trick, of course,
-is knowing when the result of an operation will be a fixnum, and there
-might be a couple bugs here.
-
-More instructions could be added here over time.
-
-All of these operations place their result in their first operand,
-@var{dst}.
-
-@deftypefn Instruction {} add s8:@var{dst} s8:@var{a} s8:@var{b}
-Add @var{a} to @var{b}.
+@deftypefn Instruction {} heap-numbers-equal? s12:@var{a} s12:@var{b}
+Set the comparison result to @var{EQUAL} if the SCM values @var{a} and
+@var{b} are numerically equal, in the sense of Scheme @code{=}.  Set to
+@code{NONE} otherwise.  It is known that both @var{a} and @var{b} are
+heap numbers.
 @end deftypefn
 
-@deftypefn Instruction {} add/immediate s8:@var{dst} s8:@var{src} c8:@var{imm}
-Add the unsigned integer @var{imm} to the value in @var{src}.
+@deftypefn Instruction {} <? s12:@var{a} s12:@var{b}
+Set the comparison result to @code{LESS_THAN} if the SCM value @var{a}
+is less than the SCM value @var{b}, @code{NONE} if @var{a} is greater
+than or equal to @var{b}, or @code{INVALID} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} sub s8:@var{dst} s8:@var{a} s8:@var{b}
-Subtract @var{b} from @var{a}.
+@deftypefn Instruction {} immediate-tag=? s24:@var{obj} c16:@var{mask} c16:@var{tag}
+Set the comparison result to @var{EQUAL} if the result of a bitwise
+@code{and} between the bits of @code{scm} value @var{a} and the
+immediate @var{mask} is @var{tag}, or @code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} sub/immediate s8:@var{dst} s8:@var{src} s8:@var{imm}
-Subtract the unsigned integer @var{imm} from the value in @var{src}.
+@deftypefn Instruction {} heap-tag=? s24:@var{obj} c16:@var{mask} c16:@var{tag}
+Set the comparison result to @var{EQUAL} if the result of a bitwise
+@code{and} between the first word of @code{scm} value @var{a} and the
+immediate @var{mask} is @var{tag}, or @code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} mul s8:@var{dst} s8:@var{a} s8:@var{b}
-Multiply @var{a} and @var{b}.
+@deftypefn Instruction {} eq? s12:@var{a} s12:@var{b}
+Set the comparison result to @var{EQUAL} if the SCM values @var{a} and
+@var{b} are @code{eq?}, or @code{NONE} otherwise.
 @end deftypefn
 
-@deftypefn Instruction {} div s8:@var{dst} s8:@var{a} s8:@var{b}
-Divide @var{a} by @var{b}.
-@end deftypefn
+There are a set of macro-instructions for @code{immediate-tag=?} and
+@code{heap-tag=?} as well that abstract away the precise type tag
+values.  @xref{The SCM Type in Guile}.
+
+@deffn {Macro Instruction} fixnum? x
+@deffnx {Macro Instruction} heap-object? x
+@deffnx {Macro Instruction} char? x
+@deffnx {Macro Instruction} eq-false? x
+@deffnx {Macro Instruction} eq-nil? x
+@deffnx {Macro Instruction} eq-null? x
+@deffnx {Macro Instruction} eq-true? x
+@deffnx {Macro Instruction} unspecified? x
+@deffnx {Macro Instruction} undefined? x
+@deffnx {Macro Instruction} eof-object? x
+@deffnx {Macro Instruction} null? x
+@deffnx {Macro Instruction} false? x
+@deffnx {Macro Instruction} nil? x
+Emit a @code{immediate-tag=?} instruction that will set the comparison
+result to @code{EQUAL} if @var{x} would pass the corresponding predicate
+(e.g. @code{null?}), or @code{NONE} otherwise.
+@end deffn
+
+@deffn {Macro Instruction} pair? x
+@deffnx {Macro Instruction} struct? x
+@deffnx {Macro Instruction} symbol? x
+@deffnx {Macro Instruction} variable? x
+@deffnx {Macro Instruction} vector? x
+@deffnx {Macro Instruction} immutable-vector? x
+@deffnx {Macro Instruction} mutable-vector? x
+@deffnx {Macro Instruction} weak-vector? x
+@deffnx {Macro Instruction} string? x
+@deffnx {Macro Instruction} heap-number? x
+@deffnx {Macro Instruction} hash-table? x
+@deffnx {Macro Instruction} pointer? x
+@deffnx {Macro Instruction} fluid? x
+@deffnx {Macro Instruction} stringbuf? x
+@deffnx {Macro Instruction} dynamic-state? x
+@deffnx {Macro Instruction} frame? x
+@deffnx {Macro Instruction} keyword? x
+@deffnx {Macro Instruction} atomic-box? x
+@deffnx {Macro Instruction} syntax? x
+@deffnx {Macro Instruction} program? x
+@deffnx {Macro Instruction} vm-continuation? x
+@deffnx {Macro Instruction} bytevector? x
+@deffnx {Macro Instruction} weak-set? x
+@deffnx {Macro Instruction} weak-table? x
+@deffnx {Macro Instruction} array? x
+@deffnx {Macro Instruction} bitvector? x
+@deffnx {Macro Instruction} smob? x
+@deffnx {Macro Instruction} port? x
+@deffnx {Macro Instruction} bignum? x
+@deffnx {Macro Instruction} flonum? x
+@deffnx {Macro Instruction} compnum? x
+@deffnx {Macro Instruction} fracnum? x
+Emit a @code{heap-tag=?} instruction that will set the comparison result
+to @code{EQUAL} if @var{x} would pass the corresponding predicate
+(e.g. @code{null?}), or @code{NONE} otherwise.
+@end deffn
 
-@deftypefn Instruction {} quo s8:@var{dst} s8:@var{a} s8:@var{b}
-Divide @var{a} by @var{b}.
-@end deftypefn
 
-@deftypefn Instruction {} rem s8:@var{dst} s8:@var{a} s8:@var{b}
-Divide @var{a} by @var{b}.
+@node Branch Instructions
+@subsubsection Branch Instructions
+
+All offsets to branch instructions are 24-bit signed numbers, which
+count 32-bit units.  This gives Guile effectively a 26-bit address range
+for relative jumps.
+
+@deftypefn Instruction {} j l24:@var{offset}
+Add @var{offset} to the current instruction pointer.
 @end deftypefn
 
-@deftypefn Instruction {} mod s8:@var{dst} s8:@var{a} s8:@var{b}
-Compute the modulo of @var{a} by @var{b}.
+@deftypefn Instruction {} jl l24:@var{offset}
+If the last comparison result is @code{LESS_THAN}, add @var{offset}, a
+signed 24-bit number, to the current instruction pointer.
 @end deftypefn
 
-@deftypefn Instruction {} ash s8:@var{dst} s8:@var{a} s8:@var{b}
-Shift @var{a} arithmetically by @var{b} bits.
+@deftypefn Instruction {} je l24:@var{offset}
+If the last comparison result is @code{EQUAL}, add @var{offset}, a
+signed 24-bit number, to the current instruction pointer.
 @end deftypefn
 
-@deftypefn Instruction {} logand s8:@var{dst} s8:@var{a} s8:@var{b}
-Compute the bitwise @code{and} of @var{a} and @var{b}.
+@deftypefn Instruction {} jnl l24:@var{offset}
+If the last comparison result is not @code{LESS_THAN}, add @var{offset},
+a signed 24-bit number, to the current instruction pointer.
 @end deftypefn
 
-@deftypefn Instruction {} logior s8:@var{dst} s8:@var{a} s8:@var{b}
-Compute the bitwise inclusive @code{or} of @var{a} with @var{b}.
+@deftypefn Instruction {} jne l24:@var{offset}
+If the last comparison result is not @code{EQUAL}, add @var{offset}, a
+signed 24-bit number, to the current instruction pointer.
 @end deftypefn
 
-@deftypefn Instruction {} logxor s8:@var{dst} s8:@var{a} s8:@var{b}
-Compute the bitwise exclusive @code{or} of @var{a} with @var{b}.
+@deftypefn Instruction {} jge l24:@var{offset}
+If the last comparison result is @code{NONE}, add @var{offset}, a
+signed 24-bit number, to the current instruction pointer.
+
+This is intended for use after a @code{<?} comparison, and is different
+from @code{jnl} in the way it handles not-a-number (NaN) values:
+@code{<?} sets @code{INVALID} instead of @code{NONE} if either value is
+a NaN.  For exact numbers, @code{jge} is the same as @code{jnl}.
 @end deftypefn
 
-@deftypefn Instruction {} logsub s8:@var{dst} s8:@var{a} s8:@var{b}
-Place the bitwise @code{and} of @var{a} and the bitwise @code{not} of
-@var{b} into @var{dst}.
+@deftypefn Instruction {} jnge l24:@var{offset}
+If the last comparison result is not @code{NONE}, add @var{offset}, a
+signed 24-bit number, to the current instruction pointer.
+
+This is intended for use after a @code{<?} comparison, and is different
+from @code{jl} in the way it handles not-a-number (NaN) values:
+@code{<?} sets @code{INVALID} instead of @code{NONE} if either value is
+a NaN.  For exact numbers, @code{jnge} is the same as @code{jl}.
 @end deftypefn
 
-@node Inlined Bytevector Instructions
-@subsubsection Inlined Bytevector Instructions
+
+@node Raw Memory Access Instructions
+@subsubsection Raw Memory Access Instructions
 
 Bytevector operations correspond closely to what the current hardware
 can do, so it makes sense to inline them to VM instructions, providing
@@ -1505,24 +1826,20 @@ a clear path for eventual native compilation. Without this, Scheme
 programs would need other primitives for accessing raw bytes -- but
 these primitives are as good as any.
 
-@deftypefn Instruction {} bv-length s12:@var{dst} s12:@var{src}
-Store the length of the bytevector in @var{src} in @var{dst}, as an
-unboxed unsigned 64-bit integer.
-@end deftypefn
-
-@deftypefn Instruction {} bv-u8-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-s8-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-u16-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-s16-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-u32-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-s32-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-u64-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-s64-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-f32-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-@deftypefnx Instruction {} bv-f64-ref s8:@var{dst} s8:@var{src} s8:@var{idx}
-
-Fetch the item at byte offset @var{idx} in the bytevector @var{src}, and
-store it in @var{dst}.  All accesses use native endianness.
+@deftypefn Instruction {} u8-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} s8-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} u16-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} s16-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} u32-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} s32-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} u64-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} s64-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} f32-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+@deftypefnx Instruction {} f64-ref s8:@var{dst} s8:@var{ptr} s8:@var{idx}
+
+Fetch the item at byte offset @var{idx} from the raw pointer local
+@var{ptr}, and store it in @var{dst}.  All accesses use native
+endianness.
 
 The @var{idx} value should be an unboxed unsigned 64-bit integer.
 
@@ -1531,162 +1848,122 @@ signed 64-bit integers, unsigned 64-bit integers, or IEEE double
 floating point numbers.
 @end deftypefn
 
-@deftypefn Instruction {} bv-u8-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-s8-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-u16-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-s16-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-u32-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-s32-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-u64-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-s64-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-f32-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
-@deftypefnx Instruction {} bv-f64-set! s8:@var{dst} s8:@var{idx} s8:@var{src}
+@deftypefn Instruction {} u8-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} s8-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} u16-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} s16-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} u32-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} s32-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} u64-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} s64-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} f32-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} f64-set! s8:@var{ptr} s8:@var{idx} s8:@var{val}
 
-Store @var{src} into the bytevector @var{dst} at byte offset @var{idx}.
-Multibyte values are written using native endianness.
+Store @var{val} into memory pointed to by raw pointer local @var{ptr},
+at byte offset @var{idx}.  Multibyte values are written using native
+endianness.
 
 The @var{idx} value should be an unboxed unsigned 64-bit integer.
 
-The @var{src} values are all unboxed, either as signed 64-bit integers,
+The @var{val} values are all unboxed, either as signed 64-bit integers,
 unsigned 64-bit integers, or IEEE double floating point numbers.
 @end deftypefn
 
-
-@node Unboxed Integer Arithmetic
-@subsubsection Unboxed Integer Arithmetic
-
-Guile supports two kinds of unboxed integers: unsigned 64-bit integers,
-and signed 64-bit integers.  Guile prefers unsigned integers, in the
-sense that Guile's compiler supports them better and the virtual machine
-has more operations that work on them.  Still, signed integers are
-supported at least to allow @code{bv-s64-ref} and related instructions
-to avoid boxing their values.
-
-@deftypefn Instruction {} scm->u64 s12:@var{dst} s12:@var{src}
-Unbox the SCM value at @var{src} to a unsigned 64-bit integer, placing
-the result in @var{dst}.  If the @var{src} value is not an exact integer
-in the unsigned 64-bit range, signal an error.
-@end deftypefn
-
-@deftypefn Instruction {} u64->scm s12:@var{dst} s12:@var{src}
-Box the unsigned 64-bit integer at @var{src} to a SCM value and place
-the result in @var{dst}.  The result will be a fixnum or a bignum.
-@end deftypefn
-
-@deftypefn Instruction {} load-u64 s24:@var{dst} au32:@var{high-bits} au32:@var{low-bits}
-Load a 64-bit value formed by joining @var{high-bits} and
-@var{low-bits}, and write it to @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} scm->s64 s12:@var{dst} s12:@var{src}
-@deftypefnx Instruction {} s64->scm s12:@var{dst} s12:@var{src}
-@deftypefnx Instruction {} load-s64 s24:@var{dst} as32:@var{high-bits} as32:@var{low-bits}
-Like @code{scm->u64}, @code{u64->scm}, and @code{load-u64}, but for
-signed 64-bit integers.
-@end deftypefn
-
-Sometimes the compiler can know that we will only need a subset of the
-bits in an integer.  In that case we can sometimes unbox an integer even
-if it might be out of range.
-
-@deftypefn Instruction {} scm->u64/truncate s12:@var{dst} s12:@var{src}
-Take the SCM value in @var{dst} and @code{logand} it with @code{(1- (ash
-1 64))}.  Place the unboxed result in @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} br-if-u64-= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-u64-< s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-u64-<= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the unboxed unsigned 64-bit integer value in @var{a} is @code{=},
-@code{<}, or @code{<=} to the unboxed unsigned 64-bit integer value in
-@var{b}, respectively, add @var{offset} to the current instruction
-pointer.
-@end deftypefn
-
-@deftypefn Instruction {} br-if-u64-=-scm s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-u64-<-scm s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-u64-<=-scm s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the unboxed unsigned 64-bit integer value in @var{a} is @code{=},
-@code{<}, or @code{<=} to the SCM value in @var{b}, respectively, add
-@var{offset} to the current instruction pointer.
-@end deftypefn
-
-@deftypefn Instruction {} uadd s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} usub s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} umul s8:@var{dst} s8:@var{a} s8:@var{b}
-Like @code{add}, @code{sub}, and @code{mul}, except taking
-the operands as unboxed unsigned 64-bit integers, and producing the
-same.  The result will be silently truncated to 64 bits.
-@end deftypefn
-
-@deftypefn Instruction {} uadd/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
-@deftypefnx Instruction {} usub/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
-@deftypefnx Instruction {} umul/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
-Like @code{uadd}, @code{usub}, and @code{umul}, except the second
-operand is an immediate unsigned 8-bit integer.
-@end deftypefn
-
-@deftypefn Instruction {} ulogand s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} ulogior s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} ulogxor s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} ulogsub s8:@var{dst} s8:@var{a} s8:@var{b}
-Like @code{logand}, @code{logior}, @code{logxor}, and @code{logsub}, but
-operating on unboxed unsigned 64-bit integers.
-@end deftypefn
-
-@deftypefn Instruction {} ulsh s8:@var{dst} s8:@var{a} s8:@var{b}
-Shift the unboxed unsigned 64-bit integer in @var{a} left by @var{b}
-bits, also an unboxed unsigned 64-bit integer.  Truncate to 64 bits and
-write to @var{dst} as an unboxed value.  Only the lower 6 bits of
-@var{b} are used.
-@end deftypefn
-
-@deftypefn Instruction {} ursh s8:@var{dst} s8:@var{a} s8:@var{b}
-Like @code{ulsh}, but shifting right.
-@end deftypefn
-
-@deftypefn Instruction {} ulsh/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
-@deftypefnx Instruction {} ursh/immediate s8:@var{dst} s8:@var{a} c8:@var{b}
-Like @code{ulsh} and @code{ursh}, but encoding @code{b} as an immediate
-8-bit unsigned integer.
-@end deftypefn
-
-
-@node Unboxed Floating-Point Arithmetic
-@subsubsection Unboxed Floating-Point Arithmetic
-
-@deftypefn Instruction {} scm->f64 s12:@var{dst} s12:@var{src}
-Unbox the SCM value at @var{src} to an IEEE double, placing the result
-in @var{dst}.  If the @var{src} value is not a real number, signal an
-error.
-@end deftypefn
-
-@deftypefn Instruction {} f64->scm s12:@var{dst} s12:@var{src}
-Box the IEEE double at @var{src} to a SCM value and place the result in
-@var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} load-f64 s24:@var{dst} au32:@var{high-bits} au32:@var{low-bits}
-Load a 64-bit value formed by joining @var{high-bits} and
-@var{low-bits}, and write it to @var{dst}.
-@end deftypefn
-
-@deftypefn Instruction {} fadd s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} fsub s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} fmul s8:@var{dst} s8:@var{a} s8:@var{b}
-@deftypefnx Instruction {} fdiv s8:@var{dst} s8:@var{a} s8:@var{b}
-Like @code{add}, @code{sub}, @code{div}, and @code{mul}, except taking
-the operands as unboxed IEEE double floating-point numbers, and producing
-the same.
-@end deftypefn
-
-@deftypefn Instruction {} br-if-f64-= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-f64-< s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-f64-<= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-f64-> s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-@deftypefnx Instruction {} br-if-f64->= s24:@var{a} x8:@var{_} s24:@var{b} b1:@var{invert} x7:@var{_} l24:@var{offset}
-If the unboxed IEEE double value in @var{a} is @code{=}, @code{<},
-@code{<=}, @code{>}, or @code{>=} to the unboxed IEEE double value in
-@var{b}, respectively, add @var{offset} to the current instruction
-pointer.
-@end deftypefn
+@node Just-In-Time Native Code
+@subsection Just-In-Time Native Code
+
+@cindex just-in-time compiler
+@cindex jit compiler
+@cindex template jit
+@cindex compiler, just-in-time
+The final piece of Guile's virtual machine is a just-in-time (JIT)
+compiler from bytecode instructions to native code.  It is faster to run
+a function when its bytecode instructions are compiled to native code,
+compared to having the VM interpret the instructions.
+
+The JIT compiler runs automatically, triggered by counters associated
+with each function.  The counter increments when functions are called
+and during each loop iteration.  Once a function's counter passes a
+certain value, the function gets JIT-compiled.  @xref{Instrumentation
+Instructions}, for full details.
+
+Guile's JIT compiler is what is known as a @dfn{template JIT}.  This
+kind of JIT is very simple: for each instruction in a function, the JIT
+compiler will emit a generic sequence of machine code corresponding to
+the instruction kind, specializing that generic template to reference
+the specific operands of the instruction being compiled.
+
+The strength of a template JIT is principally that it is very fast at
+emitting code.  It doesn't need to do any time-consuming analysis on the
+bytecode that it is compiling to do its job.
+
+A template JIT is also very predictable: the native code emitted by a
+template JIT has the same performance characteristics of the
+corresponding bytecode, only that it runs faster.  In theory you could
+even generate the template-JIT machine code ahead of time, as it doesn't
+depend on any value seen at run-time.
+
+This predictability makes it possible to reason about the performance of
+a system in terms of bytecode, knowing that the conclusions apply to
+native code emitted by a template JIT.
+
+Because the machine code corresponding to an instruction always performs
+the same tasks that the interpreter would do for that instruction,
+bytecode and a template JIT also allows Guile programmers to debug their
+programs in terms of the bytecode model.  When a Guile programmer sets a
+breakpoint, Guile will disable the JIT for the thread being debugged,
+falling back to the interpreter (which has the corresponding code to run
+the hooks).  @xref{VM Hooks}.
+
+To emit native code, Guile uses a forked version of GNU Lightning.This
+"Lightening" effort, spun out as a separate project, aims to build on
+the back-end support from GNU Lightning, but adapting the API and
+behavior of the library to match Guile's needs.  This code is included
+in the Guile source distribution.  For more information, see
+@url{https://gitlab.com/wingo/lightening}.  As of mid-2019, Lightening
+supports code generation for the x86-64, ia32, ARMv7, and AArch64
+architectures.
+
+The weaknesses of a template JIT are two-fold.  Firstly, as a simple
+back-end that has to run fast, a template JIT doesn't have time to do
+analysis that could help it generate better code, notably global
+register allocation and instruction selection.
+
+However this is a minor weakness compared to the inability to perform
+significant, speculative program transformations.  For example, Guile
+could see that in an expression @code{(f x)}, that in practice @var{f}
+always refers to the same function.  An advanced JIT compiler would
+speculatively inline @var{f} into the call-site, along with a dynamic
+check to make sure that the assertion still held.  But as a template JIT
+doesn't pay attention to values only known at run-time, it can't make
+this transformation.
+
+This limitation is mitigated in part by Guile's robust ahead-of-time
+compiler which can already perform significant optimizations when it can
+prove they will always be valid, and its low-level bytecode which is
+able to represent the effect of those optimizations (e.g. elided
+type-checks).  @xref{Compiling to the Virtual Machine}, for more on
+Guile's compiler.
+
+An ahead-of-time Scheme-to-bytecode strategy, complemented by a template
+JIT, also particularly suits the somewhat static nature of Scheme.
+Scheme programmers often write code in a way that makes the identity of
+free variable references lexically apparent.  For example, the @code{(f
+x)} expression could appear within a @code{(let ((f (lambda (x) (1+
+x)))) ...)} expression, or we could see that @code{f} was imported from
+a particular module where we know its binding.  Ahead-of-time
+compilation techniques can work well for a language like Scheme where
+there is little polymorphism and much first-order programming.  They do
+not work so well for a language like JavaScript, which is highly mutable
+at run-time and difficult to analyze due to method calls (which are
+effectively higher-order calls).
+
+All that said, a template JIT works well for Guile at this point.  It's
+only a few thousand lines of maintainable code, it speeds up Scheme
+programs, and it keeps the bulk of the Guile Scheme implementation
+written in Scheme itself.  The next step is probably to add
+ahead-of-time native code emission to the back-end of the compiler
+written in Scheme, to take advantage of the opportunity to do global
+register allocation and instruction selection.  Once this is working, it
+can allow Guile to experiment with speculative optimizations in Scheme
+as well.  @xref{Extending the Compiler}, for more on future directions.
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 62b25d889..c8fc488b7 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -343,6 +343,9 @@ enforce enforce specific restrictions on the URI-reference.  The most
 generic URI parser is then @code{string->uri-reference}, and there is
 also a parser for when you know that you want a relative-ref.
 
+Note that @code{uri?} will only return @code{#t} for URI objects that
+have schemes; that is, it rejects relative-refs.
+
 @deffn {Scheme Procedure} string->uri-reference string
 Parse @var{string} into a URI object, while not requiring a scheme.
 Return @code{#f} if the string could not be parsed.
@@ -353,13 +356,6 @@ Parse @var{string} into a URI object, while asserting that no scheme is
 present.  Return @code{#f} if the string could not be parsed.
 @end deffn
 
-For compatibility reasons, note that @code{uri?} will return @code{#t}
-for all URI objects, even relative-refs.  In contrast, @code{build-uri}
-and @code{string->uri} require that the resulting URI not be a
-relative-ref.  As a predicate to distinguish relative-refs from proper
-URIs (in the language of RFC 3986), use something like @code{(and
-(uri-reference? @var{x}) (not (relative-ref?  @var{x})))}.
-
 
 @node HTTP
 @subsection The Hyper-Text Transfer Protocol
diff --git a/examples/box-dynamic-module/box.c b/examples/box-dynamic-module/box.c
index e180565eb..8cf940909 100644
--- a/examples/box-dynamic-module/box.c
+++ b/examples/box-dynamic-module/box.c
@@ -1,22 +1,23 @@
 /* examples/box-dynamic-module/box.c
- * 
- *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3, or
- * (at your option) any later version.
- * 
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public
- * License along with this software; see the file COPYING.LESSER.  If
- * not, write to the Free Software Foundation, Inc., 51 Franklin
- * Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
+
+   Copyright 1998,2001,2006
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Include all needed declarations.  */
 #include <libguile.h>
diff --git a/examples/box-dynamic/box.c b/examples/box-dynamic/box.c
index e96c011ab..7bc791613 100644
--- a/examples/box-dynamic/box.c
+++ b/examples/box-dynamic/box.c
@@ -1,22 +1,23 @@
 /* examples/box-dynamic/box.c
- * 
- *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3, or
- * (at your option) any later version.
- * 
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public
- * License along with this software; see the file COPYING.LESSER.  If
- * not, write to the Free Software Foundation, Inc., 51 Franklin
- * Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
+
+   Copyright 1998,2001,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Include all needed declarations.  */
 #include <libguile.h>
diff --git a/examples/box-module/box.c b/examples/box-module/box.c
index b69377e38..a98565b7b 100644
--- a/examples/box-module/box.c
+++ b/examples/box-module/box.c
@@ -1,22 +1,23 @@
 /* examples/box-module/box.c
- * 
- *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3, or
- * (at your option) any later version.
- * 
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public
- * License along with this software; see the file COPYING.LESSER.  If
- * not, write to the Free Software Foundation, Inc., 51 Franklin
- * Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
+
+   Copyright 1998,2001,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Include all needed declarations.  */
 #include <libguile.h>
diff --git a/examples/box/box.c b/examples/box/box.c
index 0662c3d12..53c022ab1 100644
--- a/examples/box/box.c
+++ b/examples/box/box.c
@@ -1,22 +1,23 @@
 /* examples/box/box.c
- * 
- *	Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3, or
- * (at your option) any later version.
- * 
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public
- * License along with this software; see the file COPYING.LESSER.  If
- * not, write to the Free Software Foundation, Inc., 51 Franklin
- * Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
+
+   Copyright 1998,2001,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Include all needed declarations.  */
 #include <libguile.h>
diff --git a/examples/compat/compat.h b/examples/compat/compat.h
index 67f1b9bd0..44b636854 100644
--- a/examples/compat/compat.h
+++ b/examples/compat/compat.h
@@ -1,24 +1,23 @@
-/* classes: h_files */
-
 #ifndef COMPATH
 #define COMPATH
-/*	Copyright (C) 2001, 2002, 2006, 2008 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001-2002,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifndef SCM_GC8MARKP
diff --git a/guile-readline/readline.c b/guile-readline/readline.c
index c15275dd3..9ee640363 100644
--- a/guile-readline/readline.c
+++ b/guile-readline/readline.c
@@ -1,24 +1,23 @@
 /* readline.c --- line editing support for Guile */
 
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008,
- *   2009, 2010, 2013 Free Software Foundation, Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 3, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
- *
- */
+/* Copyright 1997,1999,2000-2003,2006-2010,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile-Readline.
+
+   Guile-Readline is free software: you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation, either version 3 of the
+   License, or (at your option) any later version.
+
+   Guile-Readline is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with Guile-Readline.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -27,18 +26,18 @@
 #endif
 
 #ifdef HAVE_RL_GETC_FUNCTION
-#include "libguile.h"
-
 #include <stdio.h>
 #include <unistd.h>
-#include <readline/readline.h>
-#include <readline/history.h>
 #include <sys/time.h>
 #include <sys/select.h>
 #include <signal.h>
 
-#include "libguile/validate.h"
-#include "guile-readline/readline.h"
+#include <readline/readline.h>
+#include <readline/history.h>
+
+#include <libguile.h>
+
+#include "readline.h"
 
 scm_t_option scm_readline_opts[] = {
   { SCM_OPTION_BOOLEAN, "history-file", 1,
diff --git a/guile-readline/readline.h b/guile-readline/readline.h
index 3c935e2aa..482c7e10f 100644
--- a/guile-readline/readline.h
+++ b/guile-readline/readline.h
@@ -1,24 +1,26 @@
 #ifndef READLINEH
 #define READLINEH
 
-/*	Copyright (C) 1997, 1999, 2000, 2006 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 3, or (at your option)
- * any later version.
- * 
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
- *
- */
+/* Copyright 1997,1999,2000,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile-Readline.
+
+   Guile-Readline is free software: you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation, either version 3 of the
+   License, or (at your option) any later version.
+
+   Guile-Readline is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with Guile-Readline.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#include <libguile.h>
 
 /* SCM_RL_API is a macro prepended to all function and data definitions
    which should be exported or imported in the resulting dynamic link
@@ -32,8 +34,6 @@
 # define SCM_RL_API extern
 #endif
 
-#include "libguile/__scm.h"
-
 SCM_RL_API scm_t_option scm_readline_opts[];
 
 #define SCM_HISTORY_FILE_P     scm_readline_opts[0].val
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 6336db4cf..f1b83a13b 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -21,7 +21,7 @@
 # the same distribution terms as the rest of that program.
 #
 # Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=lock --avoid=unistr/base --avoid=unistr/u8-mbtouc --avoid=unistr/u8-mbtouc-unsafe --avoid=unistr/u8-mbtoucr --avoid=unistr/u8-prev --avoid=unistr/u8-uctomb --avoid=unitypes --lgpl=3 --conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept4 alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd dirname-lgpl duplocale environ extensions flock floor fpieee frexp fstat fsync full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring link listen localcharset locale log1p lstat maintainer-makefile malloc-gnu malloca mkdir mkostemp nl_langinfo nproc open pipe-posix pipe2 poll putenv readlink recv recvfrom regex rename rmdir select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc unistd verify vsnprintf warnings wchar
+# Reproduce by: gnulib-tool --import --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=lock --avoid=unistr/base --avoid=unistr/u8-mbtouc --avoid=unistr/u8-mbtouc-unsafe --avoid=unistr/u8-mbtoucr --avoid=unistr/u8-prev --avoid=unistr/u8-uctomb --avoid=unitypes --lgpl=3 --conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept4 alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd dirname-lgpl duplocale environ extensions flexmember flock floor fpieee frexp fstat fsync full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring link listen localcharset locale log1p lstat maintainer-makefile malloc-gnu malloca mkdir mkostemp nl_langinfo nproc open pipe-posix pipe2 poll putenv readlink recv recvfrom regex rename rmdir select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc unistd verify vsnprintf warnings wchar
 
 AUTOMAKE_OPTIONS = 1.9.6 gnits
 
diff --git a/libguile.h b/libguile.h
index 3f7f0b791..53479d858 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,23 +1,25 @@
 #ifndef SCM_LIBGUILE_H
 #define SCM_LIBGUILE_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2004,2006,2008-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
 
 
 /* This needs to be included outside of the extern "C" block.
@@ -28,7 +30,7 @@
 extern "C" {
 #endif
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 #include "libguile/alist.h"
 #include "libguile/array-handle.h"
 #include "libguile/array-map.h"
@@ -39,6 +41,7 @@ extern "C" {
 #include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
+#include "libguile/chooks.h"
 #include "libguile/continuations.h"
 #include "libguile/dynl.h"
 #include "libguile/dynwind.h"
@@ -55,6 +58,7 @@ extern "C" {
 #include "libguile/foreign.h"
 #include "libguile/foreign-object.h"
 #include "libguile/fports.h"
+#include "libguile/frames.h"
 #include "libguile/gc.h"
 #include "libguile/generalized-arrays.h"
 #include "libguile/generalized-vectors.h"
@@ -105,16 +109,15 @@ extern "C" {
 #include "libguile/strports.h"
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
-#include "libguile/tags.h"
 #include "libguile/throw.h"
 #include "libguile/trees.h"
 #include "libguile/uniform.h"
-#include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
 #include "libguile/vectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/version.h"
+#include "libguile/vm.h"
 #include "libguile/vports.h"
 #include "libguile/weak-set.h"
 #include "libguile/weak-table.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 0fceee0e6..2050a482b 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##   Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-##     2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016, 2017, 2018 Free Software Foundation, Inc.
+##   Copyright (C) 1998-2004, 2006-2014, 2016-2019
+##     Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -21,6 +21,7 @@
 ##   Fifth Floor, Boston, MA 02110-1301 USA
 
 include $(top_srcdir)/am/snarf
+include $(srcdir)/lightening/lightening.am
 
 AUTOMAKE_OPTIONS = gnu
 
@@ -36,7 +37,12 @@ DEFAULT_INCLUDES =
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
 AM_CPPFLAGS = -DBUILDING_LIBGUILE=1 -I$(top_srcdir) -I$(top_builddir) \
-	      -I$(top_srcdir)/lib -I$(top_builddir)/lib $(LIBFFI_CFLAGS)
+	      -I$(top_srcdir)/lib -I$(top_builddir)/lib -iquote$(builddir) \
+	      $(LIBFFI_CFLAGS)
+
+if ENABLE_JIT
+AM_CPPFLAGS += -I$(top_srcdir)/libguile/lightening
+endif
 
 AM_CFLAGS = $(GCC_CFLAGS) $(CFLAG_VISIBILITY)
 
@@ -130,6 +136,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	bitvectors.c				\
 	bytevectors.c				\
 	chars.c					\
+	chooks.c				\
 	control.c				\
 	continuations.c				\
 	debug.c					\
@@ -167,7 +174,9 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	init.c					\
 	inline.c				\
 	instructions.c				\
+	intrinsics.c				\
 	ioext.c					\
+	jit.c					\
 	keywords.c				\
 	list.c					\
 	load.c					\
@@ -228,6 +237,10 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	weak-table.c				\
 	weak-vector.c
 
+if ENABLE_JIT
+libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES += $(lightening_c_files)
+endif
+
 DOT_X_FILES =					\
 	alist.x					\
 	array-handle.x				\
@@ -274,6 +287,7 @@ DOT_X_FILES =					\
 	i18n.x					\
 	init.x					\
 	instructions.x				\
+	intrinsics.x				\
 	ioext.x					\
 	keywords.x				\
 	list.x					\
@@ -446,16 +460,16 @@ vm-operations.h: vm-engine.c
 	| sed -e 's,VM_DEFINE_OP (\(.*\)).*,  M (\1) \\,' >> $@
 	@echo '' >> $@
 
-BUILT_INCLUDES = vm-operations.h scmconfig.h
-BUILT_SOURCES = cpp-E.c cpp-SIG.c libpath.h $(BUILT_INCLUDES) \
+BUILT_INCLUDES = vm-operations.h scmconfig.h libpath.h
+BUILT_SOURCES = cpp-E.c cpp-SIG.c $(BUILT_INCLUDES) \
     $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
 
 # Force the generation of `guile-procedures.texi' because the top-level
 # Makefile expects it to be built.
 all-local: guile-procedures.texi
 
-EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h		\
-    memmove.c strerror.c			\
+EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
+    syscalls.h					\
     dynl.c regex-posix.c			\
     posix.c net_db.c socket.c			\
     debug-malloc.c				\
@@ -512,6 +526,7 @@ uninstall-hook:
 ## working.
 noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c		\
                  elf.h						\
+                 intrinsics.h					\
                  srfi-14.i.c					\
                  quicksort.i.c                                  \
                  atomics-internal.h				\
@@ -573,6 +588,7 @@ pkginclude_HEADERS =
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(pkgincludedir)/$(GUILE_EFFECTIVE_VERSION)/libguile
 modinclude_HEADERS =				\
+	scm.h					\
 	__scm.h					\
 	alist.h					\
 	array-handle.h				\
@@ -586,6 +602,7 @@ modinclude_HEADERS =				\
 	bitvectors.h				\
 	bytevectors.h				\
 	chars.h					\
+	chooks.h				\
 	control.h				\
 	continuations.h				\
 	debug-malloc.h				\
@@ -627,6 +644,7 @@ modinclude_HEADERS =				\
 	instructions.h				\
 	ioext.h					\
 	iselect.h				\
+	jit.h					\
 	keywords.h				\
 	list.h					\
 	load.h					\
@@ -709,7 +727,8 @@ EXTRA_DIST = ChangeLog-scm ChangeLog-threads				\
     cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c				\
     c-tokenize.lex							\
     scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map	\
-    vm-operations.h libguile-2.2-gdb.scm
+    vm-operations.h libguile-2.2-gdb.scm				\
+    $(lightening_c_files) $(lightening_extra_files)
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 
@@ -725,7 +744,6 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@echo '#define SCM_EXTENSIONS_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/extensions"' >> libpath.tmp
 	@echo '#define SCM_CCACHE_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache"' >> libpath.tmp
 	@echo '#define SCM_SITE_CCACHE_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/site-ccache"' >> libpath.tmp
-	@echo '#define SCM_EFFECTIVE_VERSION "$(GUILE_EFFECTIVE_VERSION)"' >> libpath.tmp
 	@echo '#define SCM_BUILD_INFO { \' >> libpath.tmp
 	@echo '	{ "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp
 	@echo ' { "top_srcdir",    "@top_srcdir_absolute@" }, \' >> libpath.tmp
@@ -774,8 +792,6 @@ $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): $(BUILT_INCLUDES) snarf.h guile-snarf-d
 
 error.x: cpp-E.c
 posix.x: cpp-SIG.c
-load.x: libpath.h
-dynl.x: libpath.h
 
 alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
 snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/build-env guild snarf-check-and-output-texi
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 62ceeeb9c..0cc0be541 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -1,523 +1 @@
-/* classes: h_files */
-
-#ifndef SCM___SCM_H
-#define SCM___SCM_H
-
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-/**********************************************************************
- This file is Guile's central public header.
-
- When included by other files, this file should preceed any include
- other than __scm.h.
-
- Under *NO* circumstances should new items be added to the global
- namespace (via adding #define, typedef, or similar to this file) with
- generic names.  This usually means that any new names should be
- prefixed by either SCM_ or GUILE_.  i.e. do *not* #define HAVE_FOO or
- SIZEOF_BAR.  See configure.in, gen-scmconfig.h.in, and
- gen-scmconfig.c for examples of how to properly handle this issue.
- The main documentation is in gen-scmconfig.c.
-
- "What's the difference between _scm.h and __scm.h?"
-
-   _scm.h is not installed; it's only visible to the libguile sources
-   themselves, and it includes config.h, the private config header.
-
-   __scm.h is installed, and is #included by <libguile.h>.  If both
-   the client and libguile need some piece of information, and it
-   doesn't fit well into the header file for any particular module, it
-   should go in __scm.h.  __scm.h includes scmconfig.h, the public
-   config header.
- **********************************************************************/
-
-/* What did the configure script discover about the outside world?  */
-#include "libguile/scmconfig.h"
-
-
-
-/* {Compiler hints}
- *
- * The following macros are used to provide additional information for the
- * compiler, which may help to do better error checking and code
- * optimization.  A second benefit of these macros is, that they also provide
- * additional information to the developers.
- */
-
-/* Return true (non-zero) if GCC version MAJ.MIN or later is being used
- * (macro taken from glibc.)  */
-#if defined __GNUC__ && defined __GNUC_MINOR__
-# define SCM_GNUC_PREREQ(maj, min) \
-	((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min))
-#else
-# define SCM_GNUC_PREREQ(maj, min) 0
-#endif
-
-/* The macro SCM_NORETURN indicates that a function will never return.
- * Examples:
- *   1) int foo (char arg) SCM_NORETURN;
- */
-#ifdef __GNUC__
-#define SCM_NORETURN __attribute__ ((__noreturn__))
-#else
-#define SCM_NORETURN
-#endif
-
-/* The macro SCM_UNUSED indicates that a function, function argument or
- * variable may potentially be unused.
- * Examples:
- *   1) static int unused_function (char arg) SCM_UNUSED;
- *   2) int foo (char unused_argument SCM_UNUSED);
- *   3) int unused_variable SCM_UNUSED;
- */
-#ifdef __GNUC__
-#define SCM_UNUSED __attribute__ ((unused))
-#else
-#define SCM_UNUSED
-#endif
-
-
-/* The SCM_EXPECT macros provide branch prediction hints to the compiler.  To
- * use only in places where the result of the expression under "normal"
- * circumstances is known.  */
-#if SCM_GNUC_PREREQ (3, 0)
-# define SCM_EXPECT    __builtin_expect
-#else
-# define SCM_EXPECT(_expr, _value) (_expr)
-#endif
-
-#define SCM_LIKELY(_expr)    SCM_EXPECT ((_expr), 1)
-#define SCM_UNLIKELY(_expr)  SCM_EXPECT ((_expr), 0)
-
-/* The SCM_INTERNAL macro makes it possible to explicitly declare a function
- * as having "internal" linkage.  However our current tack on this problem is
- * to use GCC 4's -fvisibility=hidden, making functions internal by default,
- * and then SCM_API marks them for export. */
-#define SCM_INTERNAL  extern
-
-/* The SCM_DEPRECATED macro is used in declarations of deprecated functions
- * or variables.  Defining `SCM_BUILDING_DEPRECATED_CODE' allows deprecated
- * functions to be implemented in terms of deprecated functions, and allows
- * deprecated functions to be referred to by `scm_c_define_gsubr ()'.  */
-#if !defined (SCM_BUILDING_DEPRECATED_CODE) && SCM_GNUC_PREREQ (3, 0)
-# define SCM_DEPRECATED  SCM_API __attribute__ ((__deprecated__))
-#else
-# define SCM_DEPRECATED  SCM_API
-#endif
-
-/* The SCM_ALIGNED macro, when defined, can be used to instruct the compiler
- * to honor the given alignment constraint.  */
-/* Sun Studio supports alignment since Sun Studio 12 */
-#if defined __GNUC__ || (defined( __SUNPRO_C ) && (__SUNPRO_C - 0 >= 0x590))
-# define SCM_ALIGNED(x)  __attribute__ ((aligned (x)))
-#elif defined __INTEL_COMPILER
-# define SCM_ALIGNED(x)  __declspec (align (x))
-#else
-/* Don't know how to align things.  */
-# undef SCM_ALIGNED
-#endif
-
-/* The SCM_MALLOC macro can be used in function declarations to tell the
- * compiler that a function may be treated as if any non-NULL pointer it returns
- * cannot alias any other pointer valid when the function returns.  */
-#if SCM_GNUC_PREREQ (3, 0)
-# define SCM_MALLOC  __attribute__ ((__malloc__))
-#else
-# define SCM_MALLOC
-#endif
-
-
-
-/* SCM_API is a macro prepended to all function and data definitions
-   which should be exported from libguile. */
-
-#if defined BUILDING_LIBGUILE && defined HAVE_VISIBILITY
-# define SCM_API extern __attribute__((__visibility__("default")))
-#elif defined BUILDING_LIBGUILE && defined _MSC_VER
-# define SCM_API __declspec(dllexport) extern
-#elif defined _MSC_VER
-# define SCM_API __declspec(dllimport) extern
-#else
-# define SCM_API extern
-#endif
-
-
-
-/* We would like gnu89 extern inline semantics, not C99 extern inline
-   semantics, so that we can be sure to avoid reifying definitions of
-   inline functions in all compilation units, which is a possibility at
-   low optimization levels, or if a user takes the address of an inline
-   function.
-
-   Hence the `__gnu_inline__' attribute, in accordance with:
-   http://gcc.gnu.org/gcc-4.3/porting_to.html .
-
-   With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline
-   semantics are not supported), but a warning is issued in C99 mode if
-   `__gnu_inline__' is not used.
-
-   Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in
-   C99 mode and doesn't define `__GNUC_STDC_INLINE__'.  Fall back to "static
-   inline" in that case.  */
-
-# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L))
-#  if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2)
-#   define SCM_C_EXTERN_INLINE					\
-           extern __inline__ __attribute__ ((__gnu_inline__))
-#  else
-#   define SCM_C_EXTERN_INLINE extern __inline__
-#  endif
-# endif
-
-/* SCM_INLINE is a macro prepended to all public inline function
-   declarations.  Implementations of those functions should also be in
-   the header file, prefixed by SCM_INLINE_IMPLEMENTATION, and protected
-   by SCM_CAN_INLINE and a CPP define for the C file in question, like
-   SCM_INLINE_C_INCLUDING_INLINE_H.  See inline.h for an example
-   usage.  */
-
-#if defined SCM_IMPLEMENT_INLINES
-/* Reifying functions to a file, whether or not inlining is available.  */
-# define SCM_CAN_INLINE 0
-# define SCM_INLINE SCM_API
-# define SCM_INLINE_IMPLEMENTATION
-#elif defined SCM_C_INLINE
-/* Declarations when inlining is available.  */
-# define SCM_CAN_INLINE 1
-# ifdef SCM_C_EXTERN_INLINE
-#  define SCM_INLINE SCM_C_EXTERN_INLINE
-# else
-/* Fall back to static inline if GNU "extern inline" is unavailable.  */
-#  define SCM_INLINE static SCM_C_INLINE
-# endif
-# define SCM_INLINE_IMPLEMENTATION SCM_INLINE
-#else
-/* Declarations when inlining is not available.  */
-# define SCM_CAN_INLINE 0
-# define SCM_INLINE SCM_API
-/* Don't define SCM_INLINE_IMPLEMENTATION; it should never be seen in
-   this case.  */
-#endif
-
-
-
-/* {Debugging Options}
- *
- * These compile time options determine whether to include code that is only
- * useful for debugging guile itself or C level extensions to guile.  The
- * common prefix for all option macros of this kind is "SCM_DEBUG_".  It is
- * guaranteed that a macro named SCM_DEBUG_XXX is always defined (typically to
- * either 0 or 1), i. e. there is no need to test for the undefined case.
- * This allows to use these definitions comfortably within code, as in the
- * following example:
- *   #define FOO do { if (SCM_DEBUG_XXX) bar(); else baz(); } while (0)
- * Any sane compiler will remove the unused branch without any performance
- * penalty for the resulting code.
- *
- * Note:  Some SCM_DEBUG_XXX options are not settable at configure time.
- * To change the value of such options you will have to edit this header
- * file or give suitable options to make, like:
- *   make all CFLAGS="-DSCM_DEBUG_XXX=1 ..."
- */
-
-
-/* The value of SCM_DEBUG determines the default for most of the not yet
- * defined debugging options.  This allows, for example, to enable most of the
- * debugging options by simply defining SCM_DEBUG as 1.
- */
-#ifndef SCM_DEBUG
-#define SCM_DEBUG 0
-#endif
-
-/* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will be
- * exhaustively checked.  Note:  If this option is enabled, guile will run
- * slower than normally.
- */
-#ifndef SCM_DEBUG_PAIR_ACCESSES
-#define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG
-#endif
-
-/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments
- * will check whether the rest arguments are actually passed as a proper list.
- * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest
- * arguments will take it for granted that these are passed as a proper list.
- */
-#ifndef SCM_DEBUG_REST_ARGUMENT
-#define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
-#endif
-
-/* The macro SCM_DEBUG_TYPING_STRICTNESS indicates what level of type checking
- * shall be performed with respect to the use of the SCM datatype.  The macro
- * may be defined to one of the values 0, 1 and 2.
- *
- * A value of 0 means that there will be no compile time type checking, since
- * the SCM datatype will be declared as an integral type.  This setting should
- * only be used on systems, where casting from integral types to pointers may
- * lead to loss of bit information.
- *
- * A value of 1 means that there will an intermediate level of compile time
- * type checking, since the SCM datatype will be declared as a pointer to an
- * undefined struct.  This setting is the default, since it does not cost
- * anything in terms of performance or code size.
- *
- * A value of 2 provides a maximum level of compile time type checking since
- * the SCM datatype will be declared as a struct.  This setting should be used
- * for _compile time_ type checking only, since the compiled result is likely
- * to be quite inefficient.  The right way to make use of this option is to do
- * a 'make clean; make CFLAGS=-DSCM_DEBUG_TYPING_STRICTNESS=2', fix your
- * errors, and then do 'make clean; make'.
- */
-#ifndef SCM_DEBUG_TYPING_STRICTNESS
-#define SCM_DEBUG_TYPING_STRICTNESS 1
-#endif
-
-
-
-/* {Feature Options}
- *
- * These compile time options determine whether code for certain features
- * should be compiled into guile.  The common prefix for all option macros
- * of this kind is "SCM_ENABLE_".  It is guaranteed that a macro named
- * SCM_ENABLE_XXX is defined to be either 0 or 1, i. e. there is no need to
- * test for the undefined case.  This allows to use these definitions
- * comfortably within code, as in the following example:
- *   #define FOO do { if (SCM_ENABLE_XXX) bar(); else baz(); } while (0)
- * Any sane compiler will remove the unused branch without any performance
- * penalty for the resulting code.
- *
- * Note:  Some SCM_ENABLE_XXX options are not settable at configure time.
- * To change the value of such options you will have to edit this header
- * file or give suitable options to make, like:
- *   make all CFLAGS="-DSCM_ENABLE_XXX=1 ..."
- */
-
-/* If SCM_ENABLE_DEPRECATED is set to 1, deprecated code will be included in
- * guile, as well as some functions to issue run-time warnings about uses of
- * deprecated functions.
- */
-#ifndef SCM_ENABLE_DEPRECATED
-#define SCM_ENABLE_DEPRECATED 0
-#endif
-
-
-
-/* {Architecture and compiler properties}
- *
- * Guile as of today can only work on systems which fulfill at least the
- * following requirements:
- *
- * - scm_t_bits and SCM variables have at least 32 bits.
- *   Guile's type system is based on this assumption.
- *
- * - sizeof (scm_t_bits) >= sizeof (void*) and sizeof (SCM) >= sizeof (void*)
- *   Guile's type system is based on this assumption, since it must be
- *   possible to store pointers to cells on the heap in scm_t_bits and SCM
- *   variables.
- *
- * - sizeof (scm_t_bits) >= 4 and sizeof (scm_t_bits) is a power of 2.
- *   Guile's type system is based on this assumption.  In particular, it is
- *   assumed that cells, i. e. pairs of scm_t_bits variables, are eight
- *   character aligned.  This is because three bits of a scm_t_bits variable
- *   that is holding a pointer to a cell on the heap must be available for
- *   storing type data.
- *
- * - sizeof (scm_t_bits) <= sizeof (void*) and sizeof (SCM) <= sizeof (void*)
- *   In some parts of guile, scm_t_bits and SCM variables are passed to
- *   functions as void* arguments.  Together with the requirement above, this
- *   requires a one-to-one correspondence between the size of a void* and the
- *   sizes of scm_t_bits and SCM variables.
- *
- * - numbers are encoded using two's complement.
- *   The implementation of the bitwise scheme level operations is based on
- *   this assumption.
- *
- * - ... add more
- */
-
-#ifdef CHAR_BIT
-# define SCM_CHAR_BIT CHAR_BIT
-#else
-# define SCM_CHAR_BIT 8
-#endif
-
-#ifdef LONG_BIT
-# define SCM_LONG_BIT LONG_BIT
-#else
-# define SCM_LONG_BIT (SCM_SIZEOF_LONG * 8)
-#endif
-
-#define SCM_I_UTYPE_MAX(type)      ((type)-1)
-#define SCM_I_TYPE_MAX(type,umax)  ((type)((umax)/2))
-#define SCM_I_TYPE_MIN(type,umax)  (-((type)((umax)/2))-1)
-
-#define SCM_T_UINT8_MAX   SCM_I_UTYPE_MAX(scm_t_uint8)
-#define SCM_T_INT8_MIN    SCM_I_TYPE_MIN(scm_t_int8,SCM_T_UINT8_MAX)
-#define SCM_T_INT8_MAX    SCM_I_TYPE_MAX(scm_t_int8,SCM_T_UINT8_MAX)
-
-#define SCM_T_UINT16_MAX  SCM_I_UTYPE_MAX(scm_t_uint16)
-#define SCM_T_INT16_MIN   SCM_I_TYPE_MIN(scm_t_int16,SCM_T_UINT16_MAX)
-#define SCM_T_INT16_MAX   SCM_I_TYPE_MAX(scm_t_int16,SCM_T_UINT16_MAX)
-
-#define SCM_T_UINT32_MAX  SCM_I_UTYPE_MAX(scm_t_uint32)
-#define SCM_T_INT32_MIN   SCM_I_TYPE_MIN(scm_t_int32,SCM_T_UINT32_MAX)
-#define SCM_T_INT32_MAX   SCM_I_TYPE_MAX(scm_t_int32,SCM_T_UINT32_MAX)
-
-#define SCM_T_UINT64_MAX  SCM_I_UTYPE_MAX(scm_t_uint64)
-#define SCM_T_INT64_MIN   SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX)
-#define SCM_T_INT64_MAX   SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX)
-
-#define SCM_T_UINTMAX_MAX SCM_I_UTYPE_MAX(scm_t_uintmax)
-#define SCM_T_INTMAX_MIN  SCM_I_TYPE_MIN(scm_t_intmax,SCM_T_UINTMAX_MAX)
-#define SCM_T_INTMAX_MAX  SCM_I_TYPE_MAX(scm_t_intmax,SCM_T_UINTMAX_MAX)
-
-#define SCM_T_UINTPTR_MAX SCM_I_UTYPE_MAX(scm_t_uintptr)
-#define SCM_T_INTPTR_MIN  SCM_I_TYPE_MIN(scm_t_intptr,SCM_T_UINTPTR_MAX)
-#define SCM_T_INTPTR_MAX  SCM_I_TYPE_MAX(scm_t_intptr,SCM_T_UINTPTR_MAX)
-
-
-
-#include "libguile/tags.h"
-
-
-/* The type of subrs, i.e., Scheme procedures implemented in C.  Empty
-   function declarators are used internally for pointers to functions of
-   any arity.  However, these are equivalent to `(void)' in C++, are
-   obsolescent as of C99, and trigger `strict-prototypes' GCC warnings
-   (bug #23681).  */
-
-#ifdef BUILDING_LIBGUILE
-typedef SCM (* scm_t_subr) ();
-#else
-typedef void *scm_t_subr;
-#endif
-
-
-
-typedef struct scm_dynamic_state scm_t_dynamic_state;
-
-
-
-/* scm_i_jmp_buf
- *
- * The corresponding SCM_I_SETJMP and SCM_I_LONGJMP are defined in the
- * _scm.h private header.
- */
-
-#if defined (vms)
-typedef int scm_i_jmp_buf[17];
-
-#elif defined (_CRAY1)
-typedef int scm_i_jmp_buf[112];
-
-#elif defined (__ia64__)
-# include <signal.h>
-# include <ucontext.h>
-typedef struct {
-  ucontext_t ctx;
-  int fresh;
-} scm_i_jmp_buf;
-
-#else
-# include <setjmp.h>
-typedef jmp_buf scm_i_jmp_buf;
-#endif
-
-
-
-
-/* If stack is not longword aligned then
- */
-
-/* #define SHORT_ALIGN */
-#ifdef THINK_C
-# define SHORT_ALIGN
-#endif
-#ifdef MSDOS
-# define SHORT_ALIGN
-#endif
-#ifdef atarist
-# define SHORT_ALIGN
-#endif
-
-#ifdef SHORT_ALIGN
-typedef short SCM_STACKITEM;
-#else
-typedef long SCM_STACKITEM;
-#endif
-
-/* Cast pointer through (void *) in order to avoid compiler warnings
-   when strict aliasing is enabled */
-#define SCM_STACK_PTR(ptr) ((SCM_STACKITEM *) (void *) (ptr))
-
-
-#define SCM_TICK scm_async_tick ()
-
-
-
-#ifndef SCM_MAGIC_SNARFER
-/* Let these macros pass through if
-   we are snarfing;  thus we can tell the
-   difference between the use of an actual
-   number vs. the use of one of these macros --
-   actual numbers in SCM_VALIDATE_* and SCM_ASSERT
-   constructs must match the formal argument name,
-   but using SCM_ARG* avoids the test */
-
-#define SCM_ARGn 		0
-#define SCM_ARG1 		1
-#define SCM_ARG2 		2
-#define SCM_ARG3 		3
-#define SCM_ARG4 		4
-#define SCM_ARG5 		5
-#define SCM_ARG6 		6
-#define SCM_ARG7 		7
-
-#endif /* SCM_MAGIC_SNARFER */
-
-
-
-/* Define SCM_C_INLINE_KEYWORD so that it can be used as a replacement
-   for the "inline" keyword, expanding to nothing when "inline" is not
-   available.
-*/
-
-#ifdef SCM_C_INLINE
-#define SCM_C_INLINE_KEYWORD SCM_C_INLINE
-#else
-#define SCM_C_INLINE_KEYWORD
-#endif
-
-/* Handling thread-local storage (TLS).  */
-
-#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
-# define SCM_THREAD_LOCAL __thread
-#else
-# define SCM_THREAD_LOCAL
-#endif
-
-#endif  /* SCM___SCM_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#warning __scm.h is gone, instead include <libguile.h>
diff --git a/libguile/_scm.h b/libguile/_scm.h
deleted file mode 100644
index 093815d98..000000000
--- a/libguile/_scm.h
+++ /dev/null
@@ -1,268 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM__SCM_H
-#define SCM__SCM_H
-
-/* Copyright (C) 1995, 1996, 2000, 2001, 2002, 2006, 2008, 2009, 2010,
- *   2011, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-/**********************************************************************
- This file is Guile's central private header.
-
- When included by other files, this file should preceed any include
- other than __scm.h.  See __scm.h for details regarding the purpose of
- and differences between _scm.h and __scm.h.
- **********************************************************************/
-
-#if defined(__ia64) && !defined(__ia64__)
-# define __ia64__
-#endif
-
-#if HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-/* The size of `scm_t_bits'.  */
-#define SIZEOF_SCM_T_BITS SIZEOF_VOID_P
-
-/* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't
-   need it anymore, and because on MinGW:
-
-   - the definition of struct timespec is provided (if at all) by
-     pthread.h
-
-   - pthread.h will _not_ define struct timespec if
-     HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't
-     need to.
-
-   The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore,
-   because the value of HAVE_STRUCT_TIMESPEC has already been
-   incorporated in how scm_t_timespec is defined (in scmconfig.h), and
-   the rest of the libguile C code now just uses scm_t_timespec.
- */
-#ifdef HAVE_STRUCT_TIMESPEC
-#undef HAVE_STRUCT_TIMESPEC
-#endif
-
-#include <errno.h>
-#include <verify.h>
-#include <alignof.h>
-#include "libguile/__scm.h"
-
-/* Include headers for those files central to the implementation.  The
-   rest should be explicitly #included in the C files themselves.  */
-#include "libguile/error.h"	/* Everyone signals errors.  */
-#include "libguile/print.h"	/* Everyone needs to print.  */
-#include "libguile/pairs.h"	/* Everyone conses.  */
-#include "libguile/list.h"	/* Everyone makes lists.  */
-#include "libguile/gc.h"	/* Everyone allocates.  */
-#include "libguile/gsubr.h"	/* Everyone defines global functions.  */
-#include "libguile/procs.h"	/* Same.  */
-#include "libguile/numbers.h"	/* Everyone deals with fixnums.  */
-#include "libguile/symbols.h"	/* For length, chars, values, miscellany.  */
-#include "libguile/boolean.h"	/* Everyone wonders about the truth.  */
-#include "libguile/threads.h"	/* You are not alone. */
-#include "libguile/snarf.h"	/* Everyone snarfs. */
-#include "libguile/foreign.h"	/* Snarfing needs the foreign data structures. */
-#include "libguile/programs.h"	/* ... and program.h. */
-#include "libguile/variable.h"
-#include "libguile/modules.h"
-#include "libguile/inline.h"
-#include "libguile/strings.h"
-
-/* ASYNC_TICK after finding EINTR in order to handle pending signals, if
-   any. See comment in scm_syserror. */
-#ifndef SCM_SYSCALL
-#ifdef vms
-# ifndef __GNUC__
-#  include <ssdef.h>
-#   define SCM_SYSCALL(line)						\
-  do									\
-    {									\
-      errno = 0;							\
-      line;								\
-      if (EVMSERR == errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))	\
-        scm_async_tick ();                                              \
-      else								\
-	break;								\
-    }									\
-  while (1)
-# endif /* ndef __GNUC__ */
-#endif /* def vms */
-#endif /* ndef SCM_SYSCALL  */
-
-#ifndef SCM_SYSCALL
-# ifdef EINTR
-#  if (EINTR > 0)
-#   define SCM_SYSCALL(line)			\
-  do						\
-    {						\
-      errno = 0;				\
-      line;					\
-      if (errno == EINTR)			\
-	{					\
-          scm_async_tick ();                    \
-	  errno = EINTR;			\
-	}					\
-    }						\
-  while (errno == EINTR)
-#  endif /*  (EINTR > 0) */
-# endif /* def EINTR */
-#endif /* ndef SCM_SYSCALL */
-
-#ifndef SCM_SYSCALL
-# define SCM_SYSCALL(line) line;
-#endif /* ndef SCM_SYSCALL */
-
-
-
-#ifndef min
-#define min(A, B) ((A) <= (B) ? (A) : (B))
-#endif
-#ifndef max
-#define max(A, B) ((A) >= (B) ? (A) : (B))
-#endif
-
-/* Return the first integer greater than or equal to LEN such that
-   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
-#define ROUND_UP(len, align)					\
-  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
-
-
-#if defined GUILE_USE_64_CALLS && GUILE_USE_64_CALLS && defined(HAVE_STAT64)
-#define CHOOSE_LARGEFILE(foo,foo64)     foo64
-#else
-#define CHOOSE_LARGEFILE(foo,foo64)     foo
-#endif
-
-/* These names are a bit long, but they make it clear what they represent. */
-#if SCM_HAVE_STRUCT_DIRENT64 == 1
-# define dirent_or_dirent64             CHOOSE_LARGEFILE(dirent,dirent64)
-#else
-# define dirent_or_dirent64             dirent
-#endif
-#define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
-#define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
-#define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
-#define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
-#define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
-#define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
-#define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
-#if SCM_HAVE_READDIR64_R == 1
-# define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
-#else
-# define readdir_r_or_readdir64_r       readdir_r
-#endif
-#define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
-#define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
-#define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
-#define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
-#define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
-#define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)
-
-#if SIZEOF_OFF_T == 4
-#  define scm_to_off_t    scm_to_int32
-#  define scm_from_off_t  scm_from_int32
-#elif SIZEOF_OFF_T == 8
-#  define scm_to_off_t    scm_to_int64
-#  define scm_from_off_t  scm_from_int64
-#else
-#  error sizeof(off_t) is not 4 or 8.
-#endif
-#define scm_to_off64_t    scm_to_int64
-#define scm_from_off64_t  scm_from_int64
-
-
-
-
-#if defined (vms)
-/* VMS: Implement SCM_I_SETJMP in terms of setjump.  */
-extern int setjump(scm_i_jmp_buf env);
-extern int longjump(scm_i_jmp_buf env, int ret);
-#define SCM_I_SETJMP setjump
-#define SCM_I_LONGJMP longjump
-
-#elif defined (_CRAY1)
-/* Cray: Implement SCM_I_SETJMP in terms of setjump.  */
-extern int setjump(scm_i_jmp_buf env);
-extern int longjump(scm_i_jmp_buf env, int ret);
-#define SCM_I_SETJMP setjump
-#define SCM_I_LONGJMP longjump
-
-#elif defined (__ia64__)
-/* IA64: Implement SCM_I_SETJMP in terms of getcontext. */
-# define SCM_I_SETJMP(JB)			        \
-  ( (JB).fresh = 1,				        \
-    getcontext (&((JB).ctx)),                           \
-    ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
-# define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
-void scm_ia64_longjmp (scm_i_jmp_buf *, int);
-
-#else
-/* All other systems just use setjmp and longjmp.  */
-
-#define SCM_I_SETJMP setjmp
-#define SCM_I_LONGJMP longjmp
-#endif
-
-
-
-#if (defined __GNUC__)
-# define SCM_NOINLINE __attribute__ ((__noinline__))
-#else
-# define SCM_NOINLINE /* noinline */
-#endif
-
-
-
-/* The endianness marker in objcode.  */
-#ifdef WORDS_BIGENDIAN
-# define SCM_OBJCODE_ENDIANNESS "BE"
-#else
-# define SCM_OBJCODE_ENDIANNESS "LE"
-#endif
-
-#define _SCM_CPP_STRINGIFY(x)  # x
-#define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)
-
-/* The word size marker in objcode.  */
-#define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)
-
-/* Major and minor versions must be single characters. */
-#define SCM_OBJCODE_MAJOR_VERSION 3
-#define SCM_OBJCODE_MINIMUM_MINOR_VERSION 9
-#define SCM_OBJCODE_MINOR_VERSION A
-#define SCM_OBJCODE_MAJOR_VERSION_STRING        \
-  SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
-#define SCM_OBJCODE_MINOR_VERSION_STRING        \
-  SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
-#define SCM_OBJCODE_VERSION_STRING                                      \
-  SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
-#define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
-  SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE "-" SCM_OBJCODE_VERSION_STRING
-
-#endif  /* SCM__SCM_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/alist.c b/libguile/alist.c
index b29186020..7bc86be9f 100644
--- a/libguile/alist.c
+++ b/libguile/alist.c
@@ -1,35 +1,38 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2004,2006,2008,2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
-#include "libguile/list.h"
+#include "boolean.h"
+#include "eq.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+
+#include "alist.h"
 
-#include "libguile/validate.h"
-#include "libguile/pairs.h"
-#include "libguile/numbers.h"
-#include "libguile/alist.h"
 
 
 
@@ -395,12 +398,6 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
 void
 scm_init_alist ()
 {
-#include "libguile/alist.x"
+#include "alist.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/alist.h b/libguile/alist.h
index 77c565608..d1aefbe32 100644
--- a/libguile/alist.h
+++ b/libguile/alist.h
@@ -1,29 +1,46 @@
-/* classes: h_files */
-
 #ifndef SCM_ALIST_H
 #define SCM_ALIST_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+#include <libguile/error.h>
+#include "libguile/pairs.h"
+
 
 
 
-#include "libguile/__scm.h"
+#define SCM_VALIDATE_ALISTCELL(pos, alist) \
+  do { \
+    SCM_ASSERT (scm_is_pair (alist) && scm_is_pair (SCM_CAR (alist)), \
+                alist, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_ALISTCELL_COPYSCM(pos, alist, cvar) \
+  do { \
+    SCM_ASSERT (scm_is_pair (alist), alist, pos, FUNC_NAME); \
+    cvar = SCM_CAR (alist); \
+    SCM_ASSERT (scm_is_pair (cvar), alist, pos, FUNC_NAME); \
+  } while (0)
+
 
 
 
@@ -46,9 +63,3 @@ SCM_API SCM scm_assoc_remove_x (SCM alist, SCM key);
 SCM_INTERNAL void scm_init_alist (void);
 
 #endif  /* SCM_ALIST_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 947462a59..4b69e67a1 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005,
- * 2006, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009,2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,10 +24,19 @@
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
+#include <string.h>
+
+#include "arrays.h"
+#include "bitvectors.h"
+#include "bytevectors.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "strings.h"
+#include "symbols.h"
+#include "vectors.h"
 
-#include "libguile/array-handle.h"
+#include "array-handle.h"
 
 
 SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
@@ -365,11 +374,5 @@ scm_init_array_handle (void)
   DEFINE_ARRAY_TYPE (c32, C32);
   DEFINE_ARRAY_TYPE (c64, C64);
 
-#include "libguile/array-handle.x"
+#include "array-handle.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
index a623b4e2e..137371eeb 100644
--- a/libguile/array-handle.h
+++ b/libguile/array-handle.h
@@ -1,31 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_ARRAY_HANDLE_H
 #define SCM_ARRAY_HANDLE_H
 
-/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2004, 2006,
- *   2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/error.h"
+#include "libguile/inline.h"
 #include "libguile/numbers.h"
 
 
@@ -133,9 +131,3 @@ SCM_INTERNAL void scm_init_array_handle (void);
 
 
 #endif  /* SCM_ARRAY_HANDLE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 29e4aa785..a76d8fc16 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996,1998,2000-2001,2004-2006,2008-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -26,22 +26,30 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/strings.h"
-#include "libguile/arrays.h"
-#include "libguile/smob.h"
-#include "libguile/chars.h"
-#include "libguile/eq.h"
-#include "libguile/eval.h"
-#include "libguile/feature.h"
-#include "libguile/vectors.h"
-#include "libguile/bitvectors.h"
-#include "libguile/srfi-4.h"
-#include "libguile/generalized-arrays.h"
-
-#include "libguile/validate.h"
-#include "libguile/array-map.h"
 #include <assert.h>
+#include <string.h>
+
+#include "arrays.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "chars.h"
+#include "eq.h"
+#include "eval.h"
+#include "feature.h"
+#include "generalized-arrays.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+#include "smob.h"
+#include "srfi-4.h"
+#include "strings.h"
+#include "symbols.h"
+#include "vectors.h"
+
+#include "array-map.h"
+
 
 /* The WHAT argument for `scm_gc_malloc ()' et al.  */
 static const char vi_gc_hint[] = "array-indices";
@@ -85,6 +93,7 @@ cindk (SCM ra, ssize_t *ve, int kend)
 
 #define LBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].lbnd
 #define UBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].ubnd
+#define MAX(A, B) ((A) >= (B) ? (A) : (B))
 
 
 /* scm_ramapc() always calls cproc with rank-1 arrays created by
@@ -107,7 +116,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
       va0 = make1array (SCM_I_ARRAY_V (ra0), inc);
 
       /* Find unroll depth */
-      for (kroll = max(0, kmax); kroll > 0; --kroll)
+      for (kroll = MAX (0, kmax); kroll > 0; --kroll)
         {
           inc *= (UBND (ra0, kroll) - LBND (ra0, kroll) + 1);
           if (inc != SCM_I_ARRAY_DIMS (ra0)[kroll-1].inc)
@@ -896,12 +905,6 @@ SCM_DEFINE (scm_array_slice_for_each_in_order, "array-slice-for-each-in-order",
 void
 scm_init_array_map (void)
 {
-#include "libguile/array-map.x"
+#include "array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/array-map.h b/libguile/array-map.h
index 12351d13a..3e96bec1f 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_ARRAY_MAP_H
 #define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995, 1996, 1997, 2000, 2006, 2008, 2009, 2010,
- *   2011, 2013, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000,2006,2008-2011,2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -44,9 +42,3 @@ SCM_INTERNAL SCM scm_i_array_rebase (SCM a, size_t base);
 SCM_INTERNAL void scm_init_array_map (void);
 
 #endif  /* SCM_ARRAY_MAP_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 682fbf6b2..0a919515b 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,22 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
- *   2006, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation,
- *   Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -29,31 +28,33 @@
 #include <errno.h>
 #include <string.h>
 
+#include "array-map.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "chars.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "eval.h"
+#include "feature.h"
+#include "fports.h"
+#include "generalized-arrays.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+#include "read.h"
+#include "srfi-13.h"
+#include "srfi-4.h"
+#include "strings.h"
+#include "uniform.h"
+#include "vectors.h"
 #include "verify.h"
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/eq.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-4.h"
-#include "libguile/vectors.h"
-#include "libguile/bitvectors.h"
-#include "libguile/bytevectors.h"
-#include "libguile/list.h"
-#include "libguile/dynwind.h"
-#include "libguile/read.h"
-
-#include "libguile/validate.h"
-#include "libguile/arrays.h"
-#include "libguile/array-map.h"
-#include "libguile/generalized-vectors.h"
-#include "libguile/generalized-arrays.h"
-#include "libguile/uniform.h"
+#include "arrays.h"
 
 
 size_t
@@ -958,12 +959,6 @@ scm_init_arrays ()
 {
   scm_add_feature ("array");
 
-#include "libguile/arrays.x"
+#include "arrays.x"
 
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/arrays.h b/libguile/arrays.h
index b56abef94..7221fdb63 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_ARRAY_H
 #define SCM_ARRAY_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
- *   2010, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2010,2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/gc.h"
 #include "libguile/print.h"
 
 
@@ -86,9 +84,3 @@ SCM_INTERNAL SCM scm_i_shap2ra (SCM args);
 SCM_INTERNAL void scm_init_arrays (void);
 
 #endif  /* SCM_ARRAYS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/async.c b/libguile/async.c
index fc03078e7..e10bc562b 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,47 +1,48 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2002,2004,2006,2008-2011,2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/atomics-internal.h"
-#include "libguile/eval.h"
-#include "libguile/throw.h"
-#include "libguile/smob.h"
-#include "libguile/dynwind.h"
-#include "libguile/deprecation.h"
-
-#include "libguile/validate.h"
-#include "libguile/async.h"
-
-#ifdef HAVE_STRING_H
+#include <full-write.h>
 #include <string.h>
-#endif
 #include <unistd.h>
 
-#include <full-write.h>
+#include "atomics-internal.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "smob.h"
+#include "throw.h"
+
+#include "async.h"
+
 
 
+
 /* {Asynchronous Events}
  *
  * Asyncs are used to run arbitrary code at the next safe point in a
@@ -55,7 +56,7 @@
  */
 
 void
-scm_i_async_push (scm_i_thread *t, SCM proc)
+scm_i_async_push (scm_thread *t, SCM proc)
 {
   SCM asyncs;
 
@@ -85,7 +86,7 @@ scm_i_async_push (scm_i_thread *t, SCM proc)
      disable that newly-severed tail by setting its cdr to #f.  Not so
      nice, but oh well.  */
   asyncs = scm_atomic_ref_scm (&t->pending_asyncs);
-  do
+  while (1)
     {
       /* Traverse the asyncs list atomically.  */
       SCM walk;
@@ -94,14 +95,18 @@ scm_i_async_push (scm_i_thread *t, SCM proc)
            walk = scm_atomic_ref_scm (SCM_CDRLOC (walk)))
         if (scm_is_eq (SCM_CAR (walk), proc))
           return;
+
+      SCM expected = asyncs;
+      asyncs = scm_atomic_compare_and_swap_scm
+        (&t->pending_asyncs, asyncs, scm_cons (proc, asyncs));
+      if (scm_is_eq (asyncs, expected))
+        return;
     }
-  while (!scm_atomic_compare_and_swap_scm (&t->pending_asyncs, &asyncs,
-                                           scm_cons (proc, asyncs)));
 }
 
 /* Precondition: there are pending asyncs.  */
 SCM
-scm_i_async_pop (scm_i_thread *t)
+scm_i_async_pop (scm_thread *t)
 {
   while (1)
     {
@@ -122,8 +127,9 @@ scm_i_async_pop (scm_i_thread *t)
       /* Sever the tail.  */
       if (scm_is_false (penultimate_pair))
         {
-          if (!scm_atomic_compare_and_swap_scm (&t->pending_asyncs, &asyncs,
-                                                SCM_EOL))
+          if (!scm_is_eq (asyncs,
+                          scm_atomic_compare_and_swap_scm (&t->pending_asyncs,
+                                                           asyncs, SCM_EOL)))
             continue;
         }
       else
@@ -139,7 +145,7 @@ scm_i_async_pop (scm_i_thread *t)
 void
 scm_async_tick (void)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   if (t->block_asyncs)
     return;
@@ -162,7 +168,7 @@ struct scm_thread_wake_data {
 };
 
 int
-scm_i_prepare_to_wait (scm_i_thread *t,
+scm_i_prepare_to_wait (scm_thread *t,
                        struct scm_thread_wake_data *wake)
 {
   if (t->block_asyncs)
@@ -182,13 +188,13 @@ scm_i_prepare_to_wait (scm_i_thread *t,
 }
 
 void
-scm_i_wait_finished (scm_i_thread *t)
+scm_i_wait_finished (scm_thread *t)
 {
   scm_atomic_set_pointer ((void **)&t->wake, NULL);
 }
 
 int
-scm_i_prepare_to_wait_on_fd (scm_i_thread *t, int fd)
+scm_i_prepare_to_wait_on_fd (scm_thread *t, int fd)
 {
   struct scm_thread_wake_data *wake;
   wake = scm_gc_typed_calloc (struct scm_thread_wake_data);
@@ -204,7 +210,7 @@ scm_c_prepare_to_wait_on_fd (int fd)
 }
 
 int
-scm_i_prepare_to_wait_on_cond (scm_i_thread *t,
+scm_i_prepare_to_wait_on_cond (scm_thread *t,
                                scm_i_pthread_mutex_t *m,
                                scm_i_pthread_cond_t *c)
 {
@@ -241,7 +247,7 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0,
 	    "signal handlers.")
 #define FUNC_NAME s_scm_system_async_mark_for_thread
 {
-  scm_i_thread *t;
+  scm_thread *t;
   struct scm_thread_wake_data *wake;
 
   if (SCM_UNBNDP (thread))
@@ -320,14 +326,14 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1,
 static void
 increase_block (void *data)
 {
-  scm_i_thread *t = data;
+  scm_thread *t = data;
   t->block_asyncs++;
 }
 
 static void
 decrease_block (void *data)
 {
-  scm_i_thread *t = data;
+  scm_thread *t = data;
   if (--t->block_asyncs == 0)
     scm_async_tick ();
 }
@@ -335,7 +341,7 @@ decrease_block (void *data)
 void
 scm_dynwind_block_asyncs (void)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   scm_dynwind_rewind_handler (increase_block, t, SCM_F_WIND_EXPLICITLY);
   scm_dynwind_unwind_handler (decrease_block, t, SCM_F_WIND_EXPLICITLY);
 }
@@ -343,7 +349,7 @@ scm_dynwind_block_asyncs (void)
 void
 scm_dynwind_unblock_asyncs (void)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   if (t->block_asyncs == 0)
     scm_misc_error ("scm_with_unblocked_asyncs", 
 		    "asyncs already unblocked", SCM_EOL);
@@ -426,11 +432,5 @@ scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data)
 void
 scm_init_async ()
 {
-#include "libguile/async.x"
+#include "async.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/async.h b/libguile/async.h
index 2bca16df9..412873cde 100644
--- a/libguile/async.h
+++ b/libguile/async.h
@@ -1,34 +1,35 @@
-/* classes: h_files */
-
 #ifndef SCM_ASYNC_H
 #define SCM_ASYNC_H
 
-/* Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2008, 2009, 2011
- *   2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2002,2004-2006,2008-2009,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/threads.h"
 
 
 
+#define SCM_TICK scm_async_tick ()
+
+
+
 SCM_API void scm_async_tick (void);
 SCM_API void scm_switch (void);
 SCM_API SCM scm_system_async_mark (SCM a);
@@ -47,23 +48,17 @@ SCM_API void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d);
 SCM_API void scm_dynwind_block_asyncs (void);
 SCM_API void scm_dynwind_unblock_asyncs (void);
 
-SCM_INTERNAL int scm_i_prepare_to_wait (scm_i_thread *,
+SCM_INTERNAL int scm_i_prepare_to_wait (scm_thread *,
                                         struct scm_thread_wake_data *);
-SCM_INTERNAL void scm_i_wait_finished (scm_i_thread *);
-SCM_INTERNAL int scm_i_prepare_to_wait_on_fd (scm_i_thread *, int);
-SCM_INTERNAL int scm_i_prepare_to_wait_on_cond (scm_i_thread *,
+SCM_INTERNAL void scm_i_wait_finished (scm_thread *);
+SCM_INTERNAL int scm_i_prepare_to_wait_on_fd (scm_thread *, int);
+SCM_INTERNAL int scm_i_prepare_to_wait_on_cond (scm_thread *,
                                                 scm_i_pthread_mutex_t *,
                                                 scm_i_pthread_cond_t *);
 
-SCM_INTERNAL void scm_i_async_push (scm_i_thread *t, SCM proc);
-SCM_INTERNAL SCM scm_i_async_pop (scm_i_thread *t);
+SCM_INTERNAL void scm_i_async_push (scm_thread *t, SCM proc);
+SCM_INTERNAL SCM scm_i_async_pop (scm_thread *t);
 
 SCM_INTERNAL void scm_init_async (void);
 
 #endif  /* SCM_ASYNC_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/atomic.c b/libguile/atomic.c
index 180622b47..adb2a0c4b 100644
--- a/libguile/atomic.c
+++ b/libguile/atomic.c
@@ -1,34 +1,41 @@
-/* Copyright (C) 2016, 2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/ports.h"
-#include "libguile/validate.h"
-#include "libguile/atomics-internal.h"
-#include "libguile/atomic.h"
+#include "atomics-internal.h"
+#include "boolean.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "ports.h"
+#include "version.h"
+
+#include "atomic.h"
+
 
 
+
 SCM_DEFINE (scm_make_atomic_box, "make-atomic-box", 1, 0, 0,
             (SCM init),
             "Return an atomic box initialized to value @var{init}.")
@@ -95,21 +102,9 @@ SCM_DEFINE (scm_atomic_box_compare_and_swap_x,
             "if the return value is @code{eq?} to @var{expected}.")
 #define FUNC_NAME s_scm_atomic_box_compare_and_swap_x
 {
-  SCM result = expected;
-
   SCM_VALIDATE_ATOMIC_BOX (1, box);
-  while (!scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
-                                           &result, desired)
-         && scm_is_eq (result, expected))
-    {
-      /* 'scm_atomic_compare_and_swap_scm' has spuriously failed,
-         i.e. it has returned 0 to indicate failure, although the
-         observed value is 'eq?' to EXPECTED.  In this case, we *must*
-         try again, because the API of 'atomic-box-compare-and-swap!'
-         provides no way to indicate to the caller that the exchange
-         failed when the observed value is 'eq?' to EXPECTED.  */
-    }
-  return result;
+  return scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
+                                          expected, desired);
 }
 #undef FUNC_NAME
 
@@ -126,7 +121,7 @@ scm_i_atomic_box_print (SCM exp, SCM port, scm_print_state *pstate)
 static void
 scm_init_atomic (void)
 {
-#include "libguile/atomic.x"
+#include "atomic.x"
 }
 
 void
diff --git a/libguile/atomic.h b/libguile/atomic.h
index 9a33f8d1a..7bf3cae85 100644
--- a/libguile/atomic.h
+++ b/libguile/atomic.h
@@ -1,29 +1,28 @@
 #ifndef SCM_ATOMIC_H
 #define SCM_ATOMIC_H
 
-/* Copyright (C) 2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/gc.h"
-#include "libguile/tags.h"
 
 
 
@@ -39,6 +38,12 @@ scm_atomic_box_loc (SCM obj)
   return SCM_CELL_OBJECT_LOC (obj, 1);
 }
 
+#define SCM_VALIDATE_ATOMIC_BOX(pos, var) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_atomic_box (var), var, pos, FUNC_NAME, \
+                     "atomic box");                                \
+  } while (0)
+
 
 
 #ifdef BUILDING_LIBGUILE
diff --git a/libguile/atomics-internal.h b/libguile/atomics-internal.h
index 3c4f0cbbd..e15ea3564 100644
--- a/libguile/atomics-internal.h
+++ b/libguile/atomics-internal.h
@@ -1,29 +1,29 @@
 #ifndef SCM_ATOMICS_INTERNAL_H
 #define SCM_ATOMICS_INTERNAL_H
 
-/* Copyright (C) 2016
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
 
-#include <stdint.h>
+#include "scm.h"
 
 
 
@@ -75,13 +75,14 @@ scm_atomic_swap_scm (SCM *loc, SCM val)
   atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
   return SCM_PACK (atomic_exchange (a_loc, SCM_UNPACK (val)));
 }
-static inline _Bool
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+static inline SCM
+scm_atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired)
 {
   atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
-  return atomic_compare_exchange_weak (a_loc,
-                                       (uintptr_t *) expected,
-                                       SCM_UNPACK (desired));
+  SCM result = expected;
+  atomic_compare_exchange_strong (a_loc, (uintptr_t *) &result,
+                                  SCM_UNPACK (desired));
+  return result;
 }
 #else /* HAVE_STDATOMIC_H */
 
@@ -161,20 +162,19 @@ scm_atomic_swap_scm (SCM *loc, SCM val)
   scm_i_pthread_mutex_unlock (&atomics_lock);
   return ret;
 }
-static inline int
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+static inline SCM
+scm_atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired)
 {
-  int ret;
+  SCM ret;
   scm_i_pthread_mutex_lock (&atomics_lock);
-  if (*loc == *expected)
+  if (*loc == expected)
     {
       *loc = desired;
-      ret = 1;
+      ret = expected;
     }
   else
     {
-      *expected = *loc;
-      ret = 0;
+      ret = *loc;
     }
   scm_i_pthread_mutex_unlock (&atomics_lock);
   return ret;
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 495a68bad..4a19d4b8a 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -1,22 +1,23 @@
 /* Printing of backtraces and error messages
- * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2009,
- *   2010, 2011, 2014 Free Software Foundation
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
@@ -24,30 +25,37 @@
 
 #include <stdio.h>
 #include <ctype.h>
-
-#include "libguile/_scm.h"
-
 #include <unistd.h>
+
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
 
-#include "libguile/deprecation.h"
-#include "libguile/stacks.h"
-#include "libguile/srcprop.h"
-#include "libguile/struct.h"
-#include "libguile/strports.h"
-#include "libguile/throw.h"
-#include "libguile/fluids.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/dynwind.h"
-#include "libguile/frames.h"
-
-#include "libguile/validate.h"
-#include "libguile/backtrace.h"
-#include "libguile/filesys.h"
-#include "libguile/private-options.h"
+#include "boolean.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "filesys.h"
+#include "fluids.h"
+#include "frames.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "ports.h"
+#include "posix.h"
+#include "private-options.h"
+#include "srcprop.h"
+#include "stacks.h"
+#include "strings.h"
+#include "strports.h"
+#include "struct.h"
+#include "symbols.h"
+#include "throw.h"
+#include "variable.h"
+
+#include "backtrace.h"
 
 /* {Error reporting and backtraces}
  *
@@ -170,19 +178,6 @@ SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0,
 {
   SCM_VALIDATE_OUTPUT_PORT (2, port);
 
-#if SCM_ENABLE_DEPRECATED
-  if (SCM_STACKP (frame))
-    {
-      scm_c_issue_deprecation_warning
-        ("Passing a stack as the first argument to `scm_display_error' is "
-         "deprecated.  Pass a frame instead.");
-      if (SCM_STACK_LENGTH (frame))
-        frame = scm_stack_ref (frame, SCM_INUM0);
-      else
-        frame = SCM_BOOL_F;
-    }
-#endif
-
   scm_i_display_error (frame, port, subr, message, args, rest);
 
   return SCM_UNSPECIFIED;
@@ -332,11 +327,5 @@ void
 scm_init_backtrace ()
 {
   scm_c_define_gsubr ("print-exception", 4, 0, 0, boot_print_exception);
-#include "libguile/backtrace.x"
+#include "backtrace.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/backtrace.h b/libguile/backtrace.h
index 59de89dae..2bf626502 100644
--- a/libguile/backtrace.h
+++ b/libguile/backtrace.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_BACKTRACE_H
 #define SCM_BACKTRACE_H
 
-/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996,1998-2001,2004,2006,2008,2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API SCM scm_print_exception (SCM port, SCM frame, SCM key, SCM args);
 
@@ -40,9 +39,3 @@ SCM_API SCM scm_backtrace_with_highlights (SCM highlights);
 SCM_INTERNAL void scm_init_backtrace (void);
 
 #endif  /* SCM_BACKTRACE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h
index 6e2f4561b..3107ebcef 100644
--- a/libguile/bdw-gc.h
+++ b/libguile/bdw-gc.h
@@ -1,23 +1,24 @@
 #ifndef SCM_BDW_GC_H
 #define SCM_BDW_GC_H
 
-/* Copyright (C) 2006, 2008, 2009, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2006,2008-2009,2011-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Correct header inclusion.  */
 
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index cfca4ab6c..0bb4c1f59 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,14 +26,19 @@
 
 #include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/strings.h"
-#include "libguile/array-handle.h"
-#include "libguile/bitvectors.h"
-#include "libguile/arrays.h"
-#include "libguile/generalized-vectors.h"
-#include "libguile/srfi-4.h"
+#include "array-handle.h"
+#include "arrays.h"
+#include "boolean.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "srfi-4.h"
+
+#include "bitvectors.h"
+
 
 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
  * but alack, all we have is this crufty C.
@@ -46,9 +52,9 @@
    ((SCM_CELL_TYPE (x) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE))    \
     == scm_tc7_bitvector))
 #define BITVECTOR_LENGTH(obj)   ((size_t)SCM_CELL_WORD_1(obj))
-#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_CELL_WORD_2(obj))
+#define BITVECTOR_BITS(obj)     ((uint32_t *)SCM_CELL_WORD_2(obj))
 
-scm_t_uint32 *
+uint32_t *
 scm_i_bitvector_bits (SCM vec)
 {
   if (!IS_BITVECTOR (vec))
@@ -67,13 +73,13 @@ scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
 {
   size_t bit_len = BITVECTOR_LENGTH (vec);
   size_t word_len = (bit_len+31)/32;
-  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
+  uint32_t *bits = BITVECTOR_BITS (vec);
   size_t i, j;
 
   scm_puts ("#*", port);
   for (i = 0; i < word_len; i++, bit_len -= 32)
     {
-      scm_t_uint32 mask = 1;
+      uint32_t mask = 1;
       for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
 	scm_putc ((bits[i] & mask)? '1' : '0', port);
     }
@@ -86,9 +92,9 @@ scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
 {
   size_t bit_len = BITVECTOR_LENGTH (vec1);
   size_t word_len = (bit_len + 31) / 32;
-  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
-  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
-  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
+  uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - bit_len);
+  uint32_t *bits1 = BITVECTOR_BITS (vec1);
+  uint32_t *bits2 = BITVECTOR_BITS (vec2);
 
   /* compare lengths */
   if (BITVECTOR_LENGTH (vec2) != bit_len)
@@ -97,7 +103,7 @@ scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
   if (bit_len == 0)
     return SCM_BOOL_T;
   /* compare full words */
-  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
+  if (memcmp (bits1, bits2, sizeof (uint32_t) * (word_len-1)))
     return SCM_BOOL_F;
   /* compare partial last words */
   if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
@@ -125,17 +131,17 @@ SCM
 scm_c_make_bitvector (size_t len, SCM fill)
 {
   size_t word_len = (len + 31) / 32;
-  scm_t_uint32 *bits;
+  uint32_t *bits;
   SCM res;
 
-  bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
+  bits = scm_gc_malloc_pointerless (sizeof (uint32_t) * word_len,
 				    "bitvector");
   res = scm_double_cell (scm_tc7_bitvector, len, (scm_t_bits)bits, 0);
 
   if (!SCM_UNBNDP (fill))
     scm_bitvector_fill_x (res, fill);
   else
-    memset (bits, 0, sizeof (scm_t_uint32) * word_len);
+    memset (bits, 0, sizeof (uint32_t) * word_len);
       
   return res;
 }
@@ -176,20 +182,20 @@ SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-const scm_t_uint32 *
+const uint32_t *
 scm_array_handle_bit_elements (scm_t_array_handle *h)
 {
   if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_BIT)
     scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
-  return ((const scm_t_uint32 *) h->elements) + h->base/32;
+  return ((const uint32_t *) h->elements) + h->base/32;
 }
 
-scm_t_uint32 *
+uint32_t *
 scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
 {
   if (h->writable_elements != h->elements)
     scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
-  return (scm_t_uint32 *) scm_array_handle_bit_elements (h);
+  return (uint32_t *) scm_array_handle_bit_elements (h);
 }
 
 size_t
@@ -198,14 +204,19 @@ scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
   return h->base % 32;
 }
 
-const scm_t_uint32 *
+const uint32_t *
 scm_bitvector_elements (SCM vec,
 			scm_t_array_handle *h,
 			size_t *offp,
 			size_t *lenp,
 			ssize_t *incp)
 {
-  scm_generalized_vector_get_handle (vec, h);
+  scm_array_get_handle (vec, h);
+  if (1 != scm_array_handle_rank (h))
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 bit array");
+    }
   if (offp)
     {
       scm_t_array_dim *dim = scm_array_handle_dims (h);
@@ -217,26 +228,26 @@ scm_bitvector_elements (SCM vec,
 }
 
 
-scm_t_uint32 *
+uint32_t *
 scm_bitvector_writable_elements (SCM vec,
 				 scm_t_array_handle *h,
 				 size_t *offp,
 				 size_t *lenp,
 				 ssize_t *incp)
 {
-  const scm_t_uint32 *ret = scm_bitvector_elements (vec, h, offp, lenp, incp);
+  const uint32_t *ret = scm_bitvector_elements (vec, h, offp, lenp, incp);
 
   if (h->writable_elements != h->elements)
     scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
 
-  return (scm_t_uint32 *) ret;
+  return (uint32_t *) ret;
 }
 
 SCM
 scm_c_bitvector_ref (SCM vec, size_t idx)
 {
   scm_t_array_handle handle;
-  const scm_t_uint32 *bits;
+  const uint32_t *bits;
 
   if (IS_BITVECTOR (vec))
     {
@@ -275,7 +286,7 @@ void
 scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
 {
   scm_t_array_handle handle;
-  scm_t_uint32 *bits, mask;
+  uint32_t *bits, mask;
 
   if (IS_MUTABLE_BITVECTOR (vec))
     {
@@ -324,7 +335,7 @@ SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  scm_t_uint32 *bits;
+  uint32_t *bits;
 
   bits = scm_bitvector_writable_elements (vec, &handle,
 					  &off, &len, &inc);
@@ -334,16 +345,16 @@ SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
       /* the usual case
        */
       size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
 
       if (scm_is_true (val))
 	{
-	  memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
+	  memset (bits, 0xFF, sizeof(uint32_t)*(word_len-1));
 	  bits[word_len-1] |= last_mask;
 	}
       else
 	{
-	  memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
+	  memset (bits, 0x00, sizeof(uint32_t)*(word_len-1));
 	  bits[word_len-1] &= ~last_mask;
 	}
     }
@@ -370,13 +381,13 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
   SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
   size_t word_len = (bit_len+31)/32;
   scm_t_array_handle handle;
-  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
+  uint32_t *bits = scm_bitvector_writable_elements (vec, &handle,
 							NULL, NULL, NULL);
   size_t i, j;
 
   for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
     {
-      scm_t_uint32 mask = 1;
+      uint32_t mask = 1;
       bits[i] = 0;
       for (j = 0; j < 32 && j < bit_len;
 	   j++, mask <<= 1, list = SCM_CDR (list))
@@ -399,7 +410,7 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  const scm_t_uint32 *bits;
+  const uint32_t *bits;
   SCM res = SCM_EOL;
 
   bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
@@ -413,7 +424,7 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
 
       for (i = 0; i < word_len; i++, len -= 32)
 	{
-	  scm_t_uint32 mask = 1;
+	  uint32_t mask = 1;
 	  for (j = 0; j < 32 && j < len; j++, mask <<= 1)
 	    res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
 	}
@@ -444,7 +455,7 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
 */
 
 static size_t
-count_ones (scm_t_uint32 x)
+count_ones (uint32_t x)
 {
   x=x-((x>>1)&0x55555555);
   x=(x&0x33333333)+((x>>2)&0x33333333);
@@ -462,7 +473,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  const scm_t_uint32 *bits;
+  const uint32_t *bits;
   int bit = scm_to_bool (b);
   size_t count = 0;
 
@@ -473,7 +484,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
       /* the usual case
        */
       size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
       size_t i;
 
       for (i = 0; i < word_len-1; i++)
@@ -497,7 +508,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
 /* returns 32 for x == 0. 
 */
 static size_t
-find_first_one (scm_t_uint32 x)
+find_first_one (uint32_t x)
 {
   size_t pos = 0;
   /* do a binary search in x. */
@@ -530,7 +541,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
   scm_t_array_handle handle;
   size_t off, len, first_bit;
   ssize_t inc;
-  const scm_t_uint32 *bits;
+  const uint32_t *bits;
   int bit = scm_to_bool (item);
   SCM res = SCM_BOOL_F;
   
@@ -540,11 +551,11 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
   if (off == 0 && inc == 1 && len > 0)
     {
       size_t i, word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
       size_t first_word = first_bit / 32;
-      scm_t_uint32 first_mask =
-	((scm_t_uint32)-1) << (first_bit - 32*first_word);
-      scm_t_uint32 w;
+      uint32_t first_mask =
+	((uint32_t)-1) << (first_bit - 32*first_word);
+      uint32_t w;
       
       for (i = first_word; i < word_len; i++)
 	{
@@ -613,7 +624,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
   scm_t_array_handle v_handle;
   size_t v_off, v_len;
   ssize_t v_inc;
-  scm_t_uint32 *v_bits;
+  uint32_t *v_bits;
   int bit;
 
   /* Validate that OBJ is a boolean so this is done even if we don't
@@ -629,7 +640,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
       scm_t_array_handle kv_handle;
       size_t kv_off, kv_len;
       ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
+      const uint32_t *kv_bits;
       
       kv_bits = scm_bitvector_elements (kv, &kv_handle,
 					&kv_off, &kv_len, &kv_inc);
@@ -642,7 +653,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
       if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
 	{
 	  size_t word_len = (kv_len + 31) / 32;
-	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+	  uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
 	  size_t i;
  
 	  if (bit == 0)
@@ -674,7 +685,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
       scm_t_array_handle kv_handle;
       size_t i, kv_len;
       ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
+      const uint32_t *kv_elts;
 
       kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
       for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
@@ -716,7 +727,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
   scm_t_array_handle v_handle;
   size_t v_off, v_len;
   ssize_t v_inc;
-  const scm_t_uint32 *v_bits;
+  const uint32_t *v_bits;
   size_t count = 0;
   int bit;
 
@@ -733,7 +744,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
       scm_t_array_handle kv_handle;
       size_t kv_off, kv_len;
       ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
+      const uint32_t *kv_bits;
       
       kv_bits = scm_bitvector_elements (kv, &kv_handle,
 					&kv_off, &kv_len, &kv_inc);
@@ -746,8 +757,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
       if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
 	{
 	  size_t i, word_len = (kv_len + 31) / 32;
-	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-	  scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
+	  uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+	  uint32_t xor_mask = bit? 0 : ((uint32_t)-1);
 
 	  for (i = 0; i < word_len-1; i++)
 	    count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
@@ -773,7 +784,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
       scm_t_array_handle kv_handle;
       size_t i, kv_len;
       ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
+      const uint32_t *kv_elts;
 
       kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
       for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
@@ -803,14 +814,14 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  scm_t_uint32 *bits;
+  uint32_t *bits;
 
   bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
   
   if (off == 0 && inc == 1 && len > 0)
     {
       size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
+      uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
       size_t i;
 
       for (i = 0; i < word_len-1; i++)
@@ -840,10 +851,10 @@ scm_istr2bve (SCM str)
   SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
   SCM res = vec;
 
-  scm_t_uint32 mask;
+  uint32_t mask;
   size_t k, j;
   const char *c_str;
-  scm_t_uint32 *data;
+  uint32_t *data;
 
   data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
   c_str = scm_i_string_chars (str);
@@ -879,11 +890,5 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
 void
 scm_init_bitvectors ()
 {
-#include "libguile/bitvectors.x"
+#include "bitvectors.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 57ae52fc8..c3b0b4308 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -1,29 +1,27 @@
-/* classes: h_files */
-
 #ifndef SCM_BITVECTORS_H
 #define SCM_BITVECTORS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/array-handle.h"
 
 
@@ -56,30 +54,24 @@ SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
 SCM_API size_t scm_c_bitvector_length (SCM vec);
 SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
 SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
-SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
+SCM_API const uint32_t *scm_array_handle_bit_elements (scm_t_array_handle *h);
+SCM_API uint32_t *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
 SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
-SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
+SCM_API const uint32_t *scm_bitvector_elements (SCM vec,
 						    scm_t_array_handle *h,
 						    size_t *offp,
 						    size_t *lenp,
 						    ssize_t *incp);
-SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
+SCM_API uint32_t *scm_bitvector_writable_elements (SCM vec, 
 						       scm_t_array_handle *h,
 						       size_t *offp,
 						       size_t *lenp,
 						       ssize_t *incp);
 
-SCM_INTERNAL scm_t_uint32 *scm_i_bitvector_bits (SCM vec);
+SCM_INTERNAL uint32_t *scm_i_bitvector_bits (SCM vec);
 SCM_INTERNAL int scm_i_is_mutable_bitvector (SCM vec);
 SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate);
 SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
 SCM_INTERNAL void scm_init_bitvectors (void);
 
 #endif  /* SCM_BITVECTORS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/boolean.c b/libguile/boolean.c
index 635c14905..e8370331f 100644
--- a/libguile/boolean.c
+++ b/libguile/boolean.c
@@ -1,35 +1,35 @@
-/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008-2011, 2018
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2006,2008-2011,2018,2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
+#include "error.h"
+#include "gsubr.h"
+#include "verify.h"
 
-#include "libguile/validate.h"
-#include "libguile/boolean.h"
-#include "libguile/tags.h"
+#include "boolean.h"
 
-#include "verify.h"
 
 
 
@@ -39,7 +39,7 @@
  * terms of the SCM_MATCHES_BITS_IN_COMMON macro.
  *
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information.
  */
 verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
         (SCM_BOOL_F_BITS, SCM_BOOL_T_BITS));
@@ -115,12 +115,6 @@ scm_is_bool (SCM obj)
 void
 scm_init_boolean ()
 {
-#include "libguile/boolean.x"
+#include "boolean.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/boolean.h b/libguile/boolean.h
index df72728ef..56b30a70c 100644
--- a/libguile/boolean.h
+++ b/libguile/boolean.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_BOOLEAN_H
 #define SCM_BOOLEAN_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009, 2010, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008-2010,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -49,7 +48,7 @@
 
 /*
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information on
  * how the following macro works.
  */
 #define scm_is_false_or_nil(x)    \
@@ -69,7 +68,7 @@
  * which will be ignored by SCM_MATCHES_BITS_IN_COMMON below.
  *
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information.
  *
  * If SCM_ENABLE_ELISP is true, then scm_is_bool_or_nil(x)
  * returns 1 if and only if x is one of the following: SCM_BOOL_F,
@@ -113,7 +112,7 @@ SCM_API int scm_to_bool (SCM x);
  * ignored by SCM_MATCHES_BITS_IN_COMMON below.
  *
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information.
  *
  * scm_is_lisp_false(x) returns 1 if and only if x is one of the
  * following: SCM_BOOL_F, SCM_ELISP_NIL, SCM_EOL or
@@ -122,18 +121,30 @@ SCM_API int scm_to_bool (SCM x);
 #define scm_is_lisp_false(x)  \
   (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_F, SCM_EOL))
 
+
 
 
 SCM_API SCM scm_not (SCM x);
 SCM_API SCM scm_boolean_p (SCM obj);
 SCM_API SCM scm_nil_p (SCM obj);
 
+
+
+
+#define SCM_VALIDATE_BOOL(pos, flag) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_bool (flag), flag, pos, FUNC_NAME, "boolean"); \
+  } while (0)
+
+#define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \
+  do { \
+    SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \
+    cvar = scm_to_bool (flag); \
+  } while (0)
+
+
+
+
 SCM_INTERNAL void scm_init_boolean (void);
 
 #endif  /* SCM_BOOLEAN_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 0ac5ea6a6..7dfdab499 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1,51 +1,60 @@
-/* Copyright (C) 2009-2015, 2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009-2015,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include <alloca.h>
-#include <assert.h>
-
-#include <gmp.h>
-
-#include "libguile/_scm.h"
-#include "libguile/extensions.h"
-#include "libguile/bytevectors.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/arrays.h"
-#include "libguile/array-handle.h"
-#include "libguile/uniform.h"
-#include "libguile/srfi-4.h"
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#endif
 
 #include <byteswap.h>
+#include <errno.h>
 #include <striconveh.h>
 #include <uniconv.h>
 #include <unistr.h>
+#include <string.h>
+#include <alloca.h>
+#include <assert.h>
 
-#ifdef HAVE_LIMITS_H
-# include <limits.h>
-#endif
+#include <gmp.h>
 
-#include <string.h>
+#include "array-handle.h"
+#include "arrays.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "extensions.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "srfi-4.h"
+#include "strings.h"
+#include "symbols.h"
+#include "uniform.h"
+#include "version.h"
+
+#include "bytevectors.h"
 
 
 
@@ -53,12 +62,12 @@
 
 /* Convenience macros.  These are used by the various templates (macros) that
    are parameterized by integer signedness.  */
-#define INT8_T_signed           scm_t_int8
-#define INT8_T_unsigned         scm_t_uint8
-#define INT16_T_signed          scm_t_int16
-#define INT16_T_unsigned        scm_t_uint16
-#define INT32_T_signed          scm_t_int32
-#define INT32_T_unsigned        scm_t_uint32
+#define INT8_T_signed           int8_t
+#define INT8_T_unsigned         uint8_t
+#define INT16_T_signed          int16_t
+#define INT16_T_unsigned        uint16_t
+#define INT32_T_signed          int32_t
+#define INT32_T_unsigned        uint32_t
 #define is_signed_int8(_x)      (((_x) >= -128L) && ((_x) <= 127L))
 #define is_unsigned_int8(_x)    ((_x) <= 255UL)
 #define is_signed_int16(_x)     (((_x) >= -32768L) && ((_x) <= 32767L))
@@ -372,17 +381,17 @@ scm_c_bytevector_length (SCM bv)
 }
 #undef FUNC_NAME
 
-scm_t_uint8
+uint8_t
 scm_c_bytevector_ref (SCM bv, size_t index)
 #define FUNC_NAME "scm_c_bytevector_ref"
 {
   size_t c_len;
-  const scm_t_uint8 *c_bv;
+  const uint8_t *c_bv;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv);
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   if (SCM_UNLIKELY (index >= c_len))
     scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
@@ -392,16 +401,16 @@ scm_c_bytevector_ref (SCM bv, size_t index)
 #undef FUNC_NAME
 
 void
-scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
+scm_c_bytevector_set_x (SCM bv, size_t index, uint8_t value)
 #define FUNC_NAME "scm_c_bytevector_set_x"
 {
   size_t c_len;
-  scm_t_uint8 *c_bv;
+  uint8_t *c_bv;
 
   SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   if (SCM_UNLIKELY (index >= c_len))
     scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
@@ -481,7 +490,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
 {
   SCM bv;
   size_t c_len;
-  scm_t_uint8 c_fill = 0;
+  uint8_t c_fill = 0;
 
   SCM_VALIDATE_SIZE_COPY (1, len, c_len);
   if (!scm_is_eq (fill, SCM_UNDEFINED))
@@ -491,16 +500,16 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       value = scm_to_int (fill);
       if (SCM_UNLIKELY ((value < -128) || (value > 255)))
 	scm_out_of_range (FUNC_NAME, fill);
-      c_fill = (scm_t_uint8) value;
+      c_fill = (uint8_t) value;
     }
 
   bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (!scm_is_eq (fill, SCM_UNDEFINED))
     {
       size_t i;
-      scm_t_uint8 *contents;
+      uint8_t *contents;
 
-      contents = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+      contents = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
       for (i = 0; i < c_len; i++)
 	contents[i] = c_fill;
     }
@@ -556,7 +565,7 @@ SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
 #define FUNC_NAME s_scm_bytevector_fill_x
 {
   size_t c_len, i;
-  scm_t_uint8 *c_bv, c_fill;
+  uint8_t *c_bv, c_fill;
   int value;
 
   SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
@@ -564,10 +573,10 @@ SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
   value = scm_to_int (fill);
   if (SCM_UNLIKELY ((value < -128) || (value > 255)))
     scm_out_of_range (FUNC_NAME, fill);
-  c_fill = (scm_t_uint8) value;
+  c_fill = (uint8_t) value;
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; i++)
     c_bv[i] = c_fill;
@@ -730,12 +739,12 @@ SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
 {
   SCM lst, pair;
   size_t c_len, i;
-  scm_t_uint8 *c_bv;
+  uint8_t *c_bv;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv);
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   lst = scm_make_list (scm_from_size_t (c_len), SCM_UNSPECIFIED);
   for (i = 0, pair = lst;
@@ -756,12 +765,12 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 {
   SCM bv, item;
   size_t c_len, i;
-  scm_t_uint8 *c_bv;
+  uint8_t *c_bv;
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
   bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
-  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
     {
@@ -773,7 +782,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 
 	  c_item = SCM_I_INUM (item);
 	  if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
-	    c_bv[i] = (scm_t_uint8) c_item;
+	    c_bv[i] = (uint8_t) c_item;
 	  else
 	    goto type_error;
 	}
@@ -1610,13 +1619,13 @@ SCM_DEFINE (scm_bytevector_s64_native_set_x, "bytevector-s64-native-set!",
 union scm_ieee754_float
 {
   float f;
-  scm_t_uint32 i;
+  uint32_t i;
 };
 
 union scm_ieee754_double
 {
   double d;
-  scm_t_uint64 i;
+  uint64_t i;
 };
 
 
@@ -1921,7 +1930,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
                                                                         \
   SCM_VALIDATE_STRING (1, str);                                         \
   if (scm_is_eq (endianness, SCM_UNDEFINED))                            \
-    endianness = sym_big;                                           \
+    endianness = sym_big;                                               \
   else                                                                  \
     SCM_VALIDATE_SYMBOL (2, endianness);                                \
                                                                         \
@@ -1943,7 +1952,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
       const scm_t_wchar *wbuf = scm_i_string_wide_chars (str);          \
       c_utf = u32_conv_to_encoding (c_utf_name,                         \
                                     iconveh_question_mark,              \
-                                    (scm_t_uint32 *) wbuf,              \
+                                    (uint32_t *) wbuf,                  \
                                     c_strlen, NULL, NULL, &c_utf_len);  \
       if (SCM_UNLIKELY (c_utf == NULL))                                 \
         scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A",    \
@@ -1967,12 +1976,12 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
 #define FUNC_NAME s_scm_string_to_utf8
 {
   SCM utf;
-  scm_t_uint8 *c_utf;
+  uint8_t *c_utf;
   size_t c_utf_len = 0;
 
   SCM_VALIDATE_STRING (1, str);
 
-  c_utf = (scm_t_uint8 *) scm_to_utf8_stringn (str, &c_utf_len);
+  c_utf = (uint8_t *) scm_to_utf8_stringn (str, &c_utf_len);
   utf = make_bytevector (c_utf_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len);
   free (c_utf);
@@ -2138,5 +2147,5 @@ scm_bootstrap_bytevectors (void)
 void
 scm_init_bytevectors (void)
 {
-#include "libguile/bytevectors.x"
+#include "bytevectors.x"
 }
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 77f0006a4..980d6e267 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -1,27 +1,31 @@
 #ifndef SCM_BYTEVECTORS_H
 #define SCM_BYTEVECTORS_H
 
-/* Copyright (C) 2009, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include "libguile/gc.h"
+
+#include "libguile/uniform.h"
 
 
 /* R6RS bytevectors.  */
@@ -44,8 +48,8 @@ SCM_API SCM scm_endianness_little;
 SCM_API SCM scm_c_make_bytevector (size_t);
 SCM_API int scm_is_bytevector (SCM);
 SCM_API size_t scm_c_bytevector_length (SCM);
-SCM_API scm_t_uint8 scm_c_bytevector_ref (SCM, size_t);
-SCM_API void scm_c_bytevector_set_x (SCM, size_t, scm_t_uint8);
+SCM_API uint8_t scm_c_bytevector_ref (SCM, size_t);
+SCM_API void scm_c_bytevector_set_x (SCM, size_t, uint8_t);
 
 SCM_API SCM scm_make_bytevector (SCM, SCM);
 SCM_API SCM scm_native_endianness (void);
@@ -145,6 +149,10 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
 
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)			\
+  SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos),	\
+		   FUNC_NAME, "bytevector")
+
 SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
 SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
                                               scm_t_array_element_type, SCM);
diff --git a/libguile/cache-internal.h b/libguile/cache-internal.h
index 4c1732f81..abe86b784 100644
--- a/libguile/cache-internal.h
+++ b/libguile/cache-internal.h
@@ -1,34 +1,32 @@
 #ifndef SCM_CACHE_INTERNAL_H
 #define SCM_CACHE_INTERNAL_H
 
-/* Copyright (C) 2016
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
 
 #include <string.h>
 
-#include "libguile/__scm.h"
 #include "libguile/gc.h"
 #include "libguile/hash.h"
-#include "libguile/threads.h"
 
 
 /* A simple cache with 8 entries.  The cache entries are stored in a
diff --git a/libguile/chars.c b/libguile/chars.c
index 408b23996..fe55f9e2e 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -1,38 +1,44 @@
-/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2004, 2006, 2008-2011,
- *   2014, 2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2011,2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <ctype.h>
 #include <limits.h>
+#include <string.h>
 #include <unicase.h>
 #include <unictype.h>
 
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
+#include "boolean.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "srfi-14.h"
+#include "symbols.h"
+
+#include "chars.h"
 
-#include "libguile/chars.h"
-#include "libguile/srfi-14.h"
 
 
 
@@ -536,7 +542,7 @@ static const char *const scm_r5rs_charnames[] = {
   "space", "newline"
 };
 
-static const scm_t_uint32 scm_r5rs_charnums[] = {
+static const uint32_t scm_r5rs_charnums[] = {
   0x20, 0x0a
 };
 
@@ -548,7 +554,7 @@ static const char *const scm_r6rs_charnames[] = {
   /* 'space' and 'newline' are already included from the R5RS list.  */
 };
 
-static const scm_t_uint32 scm_r6rs_charnums[] = {
+static const uint32_t scm_r6rs_charnums[] = {
   0x00, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c,
   0x0d, 0x1b, 0x7f
 };
@@ -559,7 +565,7 @@ static const char *const scm_r7rs_charnames[] = {
   "escape"
 };
 
-static const scm_t_uint32 scm_r7rs_charnums[] = {
+static const uint32_t scm_r7rs_charnums[] = {
   0x1b
 };
 
@@ -575,7 +581,7 @@ static const char *const scm_C0_control_charnames[] = {
   "sp", "del"
 };
 
-static const scm_t_uint32 scm_C0_control_charnums[] = {
+static const uint32_t scm_C0_control_charnums[] = {
   0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
   0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
   0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
@@ -589,7 +595,7 @@ static const char *const scm_alt_charnames[] = {
   "null", "nl", "np"
 };
 
-static const scm_t_uint32 scm_alt_charnums[] = {
+static const uint32_t scm_alt_charnums[] = {
   0x00, 0x0a, 0x0c
 };
 
@@ -601,7 +607,7 @@ const char *
 scm_i_charname (SCM chr)
 {
   size_t c;
-  scm_t_uint32 i = SCM_CHAR (chr);
+  uint32_t i = SCM_CHAR (chr);
 
   for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++)
     if (scm_r5rs_charnums[c] == i)
@@ -676,12 +682,6 @@ scm_i_charname_to_char (const char *charname, size_t charname_len)
 void
 scm_init_chars ()
 {
-#include "libguile/chars.x"
+#include "chars.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/chars.h b/libguile/chars.h
index fea747f1d..f6d4c6354 100644
--- a/libguile/chars.h
+++ b/libguile/chars.h
@@ -1,35 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_CHARS_H
 #define SCM_CHARS_H
 
-/* Copyright (C) 1995, 1996, 2000, 2001, 2004, 2006, 2008, 2009, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2004,2006,2008-2009,2018-2019
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-#ifndef SCM_T_WCHAR_DEFINED
-typedef scm_t_int32 scm_t_wchar;
-#define SCM_T_WCHAR_DEFINED
-#endif /* SCM_T_WCHAR_DEFINED */
+
+
+#include "libguile/error.h"
+#include "libguile/inline.h"
 
 
 /* Immediate Characters
@@ -59,6 +53,14 @@ typedef scm_t_int32 scm_t_wchar;
    || ((scm_t_wchar) (c) > SCM_CODEPOINT_SURROGATE_END                  \
        && (scm_t_wchar) (c) <= SCM_CODEPOINT_MAX))
 
+#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character")
+
+#define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
+  do { \
+    SCM_ASSERT (SCM_CHARP (scm), scm, pos, FUNC_NAME); \
+    cvar = SCM_CHAR (scm); \
+  } while (0)
+
 
 
 SCM_API SCM scm_char_p (SCM x);
@@ -104,9 +106,3 @@ scm_c_make_char (scm_t_wchar c)
 #endif
 
 #endif  /* SCM_CHARS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/chooks.c b/libguile/chooks.c
new file mode 100644
index 000000000..3f50c4034
--- /dev/null
+++ b/libguile/chooks.c
@@ -0,0 +1,109 @@
+/* Copyright 1995-1996,1998-2001,2003,2006,2008-2009,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+
+#include "gc.h"
+
+#include "chooks.h"
+
+
+
+/* C level hooks
+ *
+ */
+
+/* Hint for `scm_gc_malloc ()' and friends.  */
+static const char hook_entry_gc_hint[] = "hook entry";
+
+void
+scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
+{
+  hook->first = 0;
+  hook->type = type;
+  hook->data = hook_data;
+}
+
+void
+scm_c_hook_add (scm_t_c_hook *hook,
+		scm_t_c_hook_function func,
+		void *fn_data, 
+		int appendp)
+{
+  scm_t_c_hook_entry *entry;
+  scm_t_c_hook_entry **loc = &hook->first;
+
+  entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
+  if (appendp)
+    while (*loc)
+      loc = &(*loc)->next;
+  entry->next = *loc;
+  entry->func = func;
+  entry->data = fn_data;
+  *loc = entry;
+}
+
+void
+scm_c_hook_remove (scm_t_c_hook *hook,
+		   scm_t_c_hook_function func,
+		   void *fn_data)
+{
+  scm_t_c_hook_entry **loc = &hook->first;
+  while (*loc)
+    {
+      if ((*loc)->func == func && (*loc)->data == fn_data)
+	{
+	  *loc = (*loc)->next;
+	  return;
+	}
+      loc = &(*loc)->next;
+    }
+  fprintf (stderr, "Attempt to remove non-existent hook function\n");
+  abort ();
+}
+
+void *
+scm_c_hook_run (scm_t_c_hook *hook, void *data)
+{
+  scm_t_c_hook_entry *entry = hook->first;
+  scm_t_c_hook_type type = hook->type;
+  void *res = 0;
+  while (entry)
+    {
+      res = (entry->func) (hook->data, entry->data, data);
+      if (res)
+	{
+	  if (type == SCM_C_HOOK_OR)
+	    break;
+	}
+      else
+	{
+	  if (type == SCM_C_HOOK_AND)
+	    break;
+	}
+      entry = entry->next;
+    }
+  return res;
+}
diff --git a/libguile/chooks.h b/libguile/chooks.h
new file mode 100644
index 000000000..f4fb20d6c
--- /dev/null
+++ b/libguile/chooks.h
@@ -0,0 +1,71 @@
+#ifndef SCM_CHOOKS_H
+#define SCM_CHOOKS_H
+
+/* Copyright 1995-1996,1999,2000-2001,2006,2008-2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+#include "libguile/scm.h"
+
+/*
+ * C level hooks
+ */
+
+/*
+ * The interface is designed for and- and or-type hooks which
+ * both may want to indicate success/failure and return a result.
+ */
+
+typedef enum scm_t_c_hook_type {
+  SCM_C_HOOK_NORMAL,
+  SCM_C_HOOK_OR,
+  SCM_C_HOOK_AND
+} scm_t_c_hook_type;
+
+typedef void  *(*scm_t_c_hook_function) (void *hook_data,
+					 void *fn_data,
+					 void *data);
+
+typedef struct scm_t_c_hook_entry {
+  struct scm_t_c_hook_entry *next;
+  scm_t_c_hook_function func;
+  void *data;
+} scm_t_c_hook_entry;
+
+typedef struct scm_t_c_hook {
+  scm_t_c_hook_entry *first;
+  scm_t_c_hook_type type;
+  void *data;
+} scm_t_c_hook;
+
+SCM_API void scm_c_hook_init (scm_t_c_hook *hook,
+			      void *hook_data,
+			      scm_t_c_hook_type type);
+SCM_API void scm_c_hook_add (scm_t_c_hook *hook,
+			     scm_t_c_hook_function func,
+			     void *fn_data, 
+			     int appendp);
+SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
+				scm_t_c_hook_function func,
+				void *fn_data);
+SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
+
+
+#endif  /* SCM_CHOOKS_H */
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 80914bc04..3f86c6bd4 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,45 +1,59 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-
 #include <assert.h>
 #include <string.h>
 #include <stdio.h>
 
-#include "libguile/async.h"
-#include "libguile/debug.h"
-#include "libguile/stackchk.h"
-#include "libguile/smob.h"
-#include "libguile/ports.h"
-#include "libguile/dynstack.h"
-#include "libguile/eval.h"
-#include "libguile/vm.h"
-#include "libguile/instructions.h"
+#if SCM_HAVE_AUXILIARY_STACK
+#include <ucontext.h>
+#endif
+
+#include "async.h"
+#include "backtrace.h"
+#include "boolean.h"
+#include "debug.h"
+#include "dynstack.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "init.h"
+#include "instructions.h"
+#include "jit.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "stacks.h"
+#include "symbols.h"
+#include "vm.h"
+
+#include "continuations.h"
 
-#include "libguile/validate.h"
-#include "libguile/continuations.h"
 
 
 
@@ -62,10 +76,25 @@ static scm_t_bits tc16_continuation;
    of that trampoline function.
  */
 
-static const scm_t_uint32 continuation_stub_code[] =
+struct goto_continuation_code
+{
+  struct scm_jit_function_data data;
+  uint32_t code[3];
+};
+
+struct goto_continuation_code goto_continuation_code = {
   {
-    SCM_PACK_OP_24 (continuation_call, 0)
-  };
+    /* mcode = */ 0,
+    /* counter = */ 0,
+    /* start = */ sizeof (struct scm_jit_function_data),
+    /* end = */ sizeof (struct scm_jit_function_data) + 12
+  },
+  {
+    SCM_PACK_OP_24 (instrument_entry, 0),
+    ((uint32_t) -(sizeof (struct scm_jit_function_data) / 4)),
+    SCM_PACK_OP_24 (continuation_call, 0),
+  }
+};
 
 static SCM
 make_continuation_trampoline (SCM contregs)
@@ -75,7 +104,7 @@ make_continuation_trampoline (SCM contregs)
   scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
 
   ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
-  SCM_SET_CELL_WORD_1 (ret, continuation_stub_code);
+  SCM_SET_CELL_WORD_1 (ret, goto_continuation_code.code);
   SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs);
 
   return ret;
@@ -110,18 +139,55 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
 # define SCM_FLUSH_REGISTER_WINDOWS /* empty */
 #endif
 
-/* this may return more than once: the first time with the escape
-   procedure, then subsequently with SCM_UNDEFINED (the vals already having been
-   placed on the VM stack). */
-#define FUNC_NAME "scm_i_make_continuation"
+static void
+capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+{
+#if SCM_HAVE_AUXILIARY_STACK
+# if !(defined __ia64 or defined __ia64__)
+# error missing auxiliary stack implementation for architecture
+# endif
+  char *top;
+  ucontext_t ctx;
+
+  if (getcontext (&ctx) != 0)
+    abort ();
+
+#if defined __hpux
+  __uc_get_ar_bsp (ctx, (uint64_t *) &top);
+#elif defined linux
+  top = (char *) ctx->uc_mcontext.sc_ar_bsp;
+#elif defined __FreeBSD__
+  top = (char *)(ctx->uc_mcontext.mc_special.bspstore
+                 + ctx->uc_mcontext.mc_special.ndirty);
+#else
+#error missing auxiliary stack implementation for ia64 on this OS
+#endif
+
+  continuation->auxiliary_stack_size =
+    top - (char *) thread->auxiliary_stack_base;
+  continuation->auxiliary_stack =
+    scm_gc_malloc (continuation->auxiliary_stack_size,
+                   "continuation auxiliary stack");
+  memcpy (continuation->auxiliary_stack, thread->auxiliary_stack_base,
+          continuation->auxiliary_stack_size);
+#endif /* SCM_HAVE_AUXILIARY_STACK */
+}
+
+static void
+restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+{
+#if SCM_HAVE_AUXILIARY_STACK
+  memcpy (thread->auxiliary_stack_base, continuation->auxiliary_stack,
+          continuation->auxiliary_stack_size);
+#endif
+}
+
 SCM 
-scm_i_make_continuation (int *first, struct scm_vm *vp, SCM vm_cont)
+scm_i_make_continuation (scm_thread *thread, SCM vm_cont)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
   SCM cont;
   scm_t_contregs *continuation;
   long stack_size;
-  const void *saved_cookie;
   SCM_STACKITEM * src;
 
   SCM_FLUSH_REGISTER_WINDOWS;
@@ -137,38 +203,14 @@ scm_i_make_continuation (int *first, struct scm_vm *vp, SCM vm_cont)
 #endif
   continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
-  continuation->vp = vp;
+  memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
   continuation->vm_cont = vm_cont;
-  saved_cookie = vp->resumable_prompt_cookie;
+  capture_auxiliary_stack (thread, continuation);
 
   SCM_NEWSMOB (cont, tc16_continuation, continuation);
 
-  *first = !SCM_I_SETJMP (continuation->jmpbuf);
-  if (*first)
-    {
-#ifdef __ia64__
-      continuation->backing_store_size =
-	(char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx)
-	-
-	(char *) thread->register_backing_store_base;
-      continuation->backing_store = NULL;
-      continuation->backing_store = 
-        scm_gc_malloc (continuation->backing_store_size,
-		       "continuation backing store");
-      memcpy (continuation->backing_store, 
-              (void *) thread->register_backing_store_base, 
-              continuation->backing_store_size);
-#endif /* __ia64__ */
-      return make_continuation_trampoline (cont);
-    }
-  else
-    {
-      vp->resumable_prompt_cookie = saved_cookie;
-      scm_gc_after_nonlocal_exit ();
-      return SCM_UNDEFINED;
-    }
+  return make_continuation_trampoline (cont);
 }
-#undef FUNC_NAME
 
 int
 scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
@@ -186,7 +228,7 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
       frame->stack_holder = data;
       frame->fp_offset = data->fp_offset;
       frame->sp_offset = data->stack_size;
-      frame->ip = data->ra;
+      frame->ip = data->vra;
 
       return 1;
     }
@@ -194,16 +236,13 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
     return 0;
 }
 
-struct scm_vm *
-scm_i_contregs_vp (SCM contregs)
+scm_t_contregs *
+scm_i_contregs (SCM contregs)
 {
-  return SCM_CONTREGS (contregs)->vp;
-}
+  if (!SCM_CONTREGSP (contregs))
+    abort ();
 
-SCM
-scm_i_contregs_vm_cont (SCM contregs)
-{
-  return SCM_CONTREGS (contregs)->vm_cont;
+  return SCM_CONTREGS (contregs);
 }
 
 
@@ -222,7 +261,7 @@ scm_i_contregs_vm_cont (SCM contregs)
  * with their correct stack.
  */
 
-static void scm_dynthrow (SCM);
+static void scm_dynthrow (SCM, uint8_t *);
 
 /* Grow the stack by a fixed amount to provide space to copy in the
  * continuation.  Possibly this function has to be called several times
@@ -234,12 +273,12 @@ static void scm_dynthrow (SCM);
 static scm_t_bits scm_i_dummy;
 
 static void 
-grow_stack (SCM cont)
+grow_stack (SCM cont, uint8_t *mra)
 {
   scm_t_bits growth[100];
 
   scm_i_dummy = (scm_t_bits) growth;
-  scm_dynthrow (cont);
+  scm_dynthrow (cont, mra);
 }
 
 
@@ -250,11 +289,11 @@ grow_stack (SCM cont)
 
 static void
 copy_stack_and_call (scm_t_contregs *continuation,
-		     SCM_STACKITEM * dst)
+		     SCM_STACKITEM * dst, uint8_t *mra)
 {
   scm_t_dynstack *dynstack;
   scm_t_bits *joint;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   dynstack = SCM_VM_CONT_DATA (continuation->vm_cont)->dynstack;
 
@@ -262,40 +301,22 @@ copy_stack_and_call (scm_t_contregs *continuation,
 
   memcpy (dst, continuation->stack,
 	  sizeof (SCM_STACKITEM) * continuation->num_stack_items);
-#ifdef __ia64__
-  thread->pending_rbs_continuation = continuation;
-#endif
+  restore_auxiliary_stack (thread, continuation);
 
   scm_dynstack_wind (&thread->dynstack, joint);
 
-  SCM_I_LONGJMP (continuation->jmpbuf, 1);
+  thread->vm.mra_after_abort = mra;
+  longjmp (continuation->jmpbuf, 1);
 }
 
-#ifdef __ia64__
-void
-scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
-{
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
-
-  if (t->pending_rbs_continuation)
-    {
-      memcpy (t->register_backing_store_base,
-	      t->pending_rbs_continuation->backing_store,
-	      t->pending_rbs_continuation->backing_store_size);
-      t->pending_rbs_continuation = NULL;
-    }
-  setcontext (&JB->ctx);
-}
-#endif
-
 /* Call grow_stack until the stack space is large enough, then, as the current
  * stack frame might get overwritten, let copy_stack_and_call perform the
  * actual copying and continuation calling.
  */
 static void 
-scm_dynthrow (SCM cont)
+scm_dynthrow (SCM cont, uint8_t *mra)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_t_contregs *continuation = SCM_CONTREGS (cont);
   SCM_STACKITEM *dst = thread->continuation_base;
   SCM_STACKITEM stack_top_element;
@@ -306,31 +327,18 @@ scm_dynthrow (SCM cont)
 #else
   dst -= continuation->num_stack_items;
   if (dst <= &stack_top_element)
-    grow_stack (cont);
+    grow_stack (cont, mra);
 #endif /* def SCM_STACK_GROWS_UP */
 
   SCM_FLUSH_REGISTER_WINDOWS;
-  copy_stack_and_call (continuation, dst);
+  copy_stack_and_call (continuation, dst, mra);
 }
 
-
 void
-scm_i_check_continuation (SCM cont)
+scm_i_reinstate_continuation (SCM cont, uint8_t *mra)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
-  scm_t_contregs *continuation = SCM_CONTREGS (cont);
-
-  if (!scm_is_eq (continuation->root, thread->continuation_root))
-    scm_misc_error
-      ("%continuation-call", 
-       "invoking continuation would cross continuation barrier: ~A",
-       scm_list_1 (cont));
-}
-
-void
-scm_i_reinstate_continuation (SCM cont)
-{
-  scm_dynthrow (cont);
+  scm_dynthrow (cont, mra);
+  abort (); /* Unreachable.  */
 }
 
 SCM
@@ -342,7 +350,7 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
 				 void *pre_unwind_handler_data)
 {
   SCM_STACKITEM stack_item;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   SCM old_controot;
   SCM_STACKITEM *old_contbase;
   SCM result;
@@ -509,11 +517,5 @@ scm_init_continuations ()
 {
   tc16_continuation = scm_make_smob_type ("continuation", 0);
   scm_set_smob_print (tc16_continuation, continuation_print);
-#include "libguile/continuations.x"
+#include "continuations.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/continuations.h b/libguile/continuations.h
index ec12b463a..d83bed9b7 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -1,34 +1,32 @@
-/* classes: h_files */
-
 #ifndef SCM_CONTINUATIONS_H
 #define SCM_CONTINUATIONS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2006,2008-2010,2012-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <setjmp.h>
+
+#include "libguile/programs.h"
+#include "libguile/throw.h"
 
-#ifdef __ia64__
-#include <signal.h>
-#include <ucontext.h>
-#endif /* __ia64__ */
 
 
 #define SCM_CONTINUATIONP(x) \
@@ -44,14 +42,13 @@
 
 typedef struct 
 {
-  scm_i_jmp_buf jmpbuf;
-#ifdef __ia64__
-  void *backing_store;
-  unsigned long backing_store_size;
-#endif /* __ia64__ */
+  jmp_buf jmpbuf;
+#if SCM_HAVE_AUXILIARY_STACK
+  void *auxiliary_stack;
+  unsigned long auxiliary_stack_size;
+#endif
   size_t num_stack_items;   /* size of the saved stack.  */
   SCM root;                 /* continuation root identifier.  */
-  struct scm_vm *vp;        /* vm */
   SCM vm_cont;              /* vm's stack and regs */
 
   /* The offset from the live stack location to this copy.  This is
@@ -62,7 +59,7 @@ typedef struct
      into the live stack, you need to add OFFSET so that it points
      into the copy.
   */
-  scm_t_ptrdiff offset;
+  ptrdiff_t offset;
 
   SCM_STACKITEM stack[1];    /* copied stack of size num_stack_items.  */ 
 } scm_t_contregs;
@@ -70,18 +67,14 @@ typedef struct
 
 
 
-SCM_INTERNAL SCM scm_i_make_continuation (int *first,
-                                          struct scm_vm *vp,
-                                          SCM vm_cont);
-SCM_INTERNAL void scm_i_check_continuation (SCM cont);
-SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont);
+SCM_INTERNAL SCM scm_i_make_continuation (scm_thread *thread, SCM vm_cont);
+SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont,
+                                                uint8_t *mra) SCM_NORETURN;
 
-struct scm_frame;
 SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont,
                                               struct scm_frame *frame);
 
-SCM_INTERNAL struct scm_vm* scm_i_contregs_vp (SCM contregs);
-SCM_INTERNAL SCM scm_i_contregs_vm_cont (SCM contregs);
+SCM_INTERNAL scm_t_contregs* scm_i_contregs (SCM contregs);
 
 SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
 SCM_API SCM scm_with_continuation_barrier (SCM proc);
@@ -97,9 +90,3 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
 SCM_INTERNAL void scm_init_continuations (void);
 
 #endif  /* SCM_CONTINUATIONS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/control.c b/libguile/control.c
index 636718d02..5e24bb706 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2010, 2011, 2012, 2013  Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
@@ -22,11 +23,20 @@
 
 #include <alloca.h>
 
-#include "libguile/_scm.h"
-#include "libguile/control.h"
-#include "libguile/programs.h"
-#include "libguile/instructions.h"
-#include "libguile/vm.h"
+#include "dynstack.h"
+#include "extensions.h"
+#include "frames.h"
+#include "gsubr.h"
+#include "instructions.h"
+#include "jit.h"
+#include "list.h"
+#include "pairs.h"
+#include "programs.h"
+#include "threads.h"
+#include "version.h"
+#include "vm.h"
+
+#include "control.h"
 
 
 
@@ -37,13 +47,13 @@
 
 
 
-/* Only to be called if the SCM_I_SETJMP returns 1 */
+/* Only to be called if the setjmp returns 1 */
 SCM
 scm_i_prompt_pop_abort_args_x (struct scm_vm *vp,
-                               scm_t_ptrdiff saved_stack_depth)
+                               ptrdiff_t saved_stack_depth)
 {
   size_t i, n;
-  scm_t_ptrdiff stack_depth;
+  ptrdiff_t stack_depth;
   SCM vals = SCM_EOL;
 
   stack_depth = vp->stack_top - vp->sp;
@@ -60,144 +70,58 @@ scm_i_prompt_pop_abort_args_x (struct scm_vm *vp,
 }
 
 
-static const scm_t_uint32 compose_continuation_code[] =
-  {
-    SCM_PACK_OP_24 (compose_continuation, 0)
-  };
+struct compose_continuation_code
+{
+  struct scm_jit_function_data data;
+  uint32_t code[3];
+};
 
+struct compose_continuation_code compose_continuation_code = {
+  {
+    /* mcode = */ 0,
+    /* counter = */ 0,
+    /* start = */ sizeof (struct scm_jit_function_data),
+    /* end = */ sizeof (struct scm_jit_function_data) + 12
+  },
+  {
+    SCM_PACK_OP_24 (instrument_entry, 0),
+    ((uint32_t) -(sizeof (struct scm_jit_function_data) / 4)),
+    SCM_PACK_OP_24 (compose_continuation, 0),
+  }
+};
 
-static SCM
-make_partial_continuation (SCM vm_cont)
+SCM
+scm_i_make_composable_continuation (SCM vmcont)
 {
   scm_t_bits nfree = 1;
   scm_t_bits flags = SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION;
   SCM ret;
 
   ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
-  SCM_SET_CELL_WORD_1 (ret, compose_continuation_code);
-  SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
+  SCM_SET_CELL_WORD_1 (ret, compose_continuation_code.code);
+  SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vmcont);
 
   return ret;
 }
 
-static SCM
-reify_partial_continuation (struct scm_vm *vp,
-                            union scm_vm_stack_element *saved_fp,
-                            union scm_vm_stack_element *saved_sp,
-                            scm_t_uint32 *saved_ip,
-                            scm_i_jmp_buf *saved_registers,
-                            scm_t_dynstack *dynstack,
-                            scm_i_jmp_buf *current_registers)
-{
-  SCM vm_cont;
-  scm_t_uint32 flags;
-  union scm_vm_stack_element *base_fp;
-
-  flags = SCM_F_VM_CONT_PARTIAL;
-  /* If we are aborting to a prompt that has the same registers as those
-     of the abort, it means there are no intervening C frames on the
-     stack, and so the continuation can be relocated elsewhere on the
-     stack: it is rewindable.  */
-  if (saved_registers && saved_registers == current_registers)
-    flags |= SCM_F_VM_CONT_REWINDABLE;
-
-  /* Walk the stack until we find the first frame newer than saved_fp.
-     We will save the stack until that frame.  It used to be that we
-     could determine the stack base in O(1) time, but that's no longer
-     the case, since the thunk application doesn't occur where the
-     prompt is saved.  */
-  for (base_fp = vp->fp;
-       SCM_FRAME_DYNAMIC_LINK (base_fp) < saved_fp;
-       base_fp = SCM_FRAME_DYNAMIC_LINK (base_fp));
-
-  if (SCM_FRAME_DYNAMIC_LINK (base_fp) != saved_fp)
-    abort();
-
-  scm_dynstack_relocate_prompts (dynstack, vp->stack_top - base_fp);
-
-  /* Capture from the base_fp to the top thunk application frame. */
-  vm_cont = scm_i_vm_capture_stack (base_fp, vp->fp, vp->sp, vp->ip, dynstack,
-                                    flags);
-
-  return make_partial_continuation (vm_cont);
-}
-
-void
-scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
-             scm_i_jmp_buf *current_registers)
-{
-  SCM cont;
-  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
-  scm_t_bits *prompt;
-  scm_t_dynstack_prompt_flags flags;
-  scm_t_ptrdiff fp_offset, sp_offset;
-  union scm_vm_stack_element *fp, *sp;
-  scm_t_uint32 *ip;
-  scm_i_jmp_buf *registers;
-  size_t i;
-
-  prompt = scm_dynstack_find_prompt (dynstack, tag,
-                                     &flags, &fp_offset, &sp_offset, &ip,
-                                     &registers);
-
-  if (!prompt)
-    scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
-
-  fp = vp->stack_top - fp_offset;
-  sp = vp->stack_top - sp_offset;
-
-  /* Only reify if the continuation referenced in the handler. */
-  if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
-    cont = SCM_BOOL_F;
-  else
-    {
-      scm_t_dynstack *captured;
-
-      captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
-      cont = reify_partial_continuation (vp, fp, sp, ip, registers, captured,
-                                         current_registers);
-    }
-
-  /* Unwind.  */
-  scm_dynstack_unwind (dynstack, prompt);
-
-  /* Restore VM regs */
-  vp->fp = fp;
-  vp->sp = sp - n - 1;
-  vp->ip = ip;
-
-  /* Since we're jumping down, we should always have enough space.  */
-  if (vp->sp < vp->stack_limit)
-    abort ();
-
-  /* Push vals */
-  vp->sp[n].as_scm = cont;
-  for (i = 0; i < n; i++)
-    vp->sp[n - i - 1].as_scm = argv[i];
-
-  /* Jump! */
-  SCM_I_LONGJMP (*registers, 1);
-
-  /* Shouldn't get here */
-  abort ();
-}
-
 SCM_DEFINE (scm_abort_to_prompt_star, "abort-to-prompt*", 2, 0, 0,
             (SCM tag, SCM args),
             "Abort to the nearest prompt with tag @var{tag}, yielding the\n"
             "values in the list, @var{args}.")
 #define FUNC_NAME s_scm_abort_to_prompt_star
 {
-  SCM *argv;
+  SCM *tag_and_argv;
   size_t i;
   long n;
 
   SCM_VALIDATE_LIST_COPYLEN (SCM_ARG2, args, n);
-  argv = alloca (sizeof (SCM)*n);
-  for (i = 0; i < n; i++, args = scm_cdr (args))
-    argv[i] = scm_car (args);
+  n = n + 1; /* Add space for the tag.  */
+  tag_and_argv = alloca (sizeof (SCM)*(n+1));
+  tag_and_argv[0] = tag;
+  for (i = 1; i < n; i++, args = scm_cdr (args))
+    tag_and_argv[i] = scm_car (args);
 
-  scm_c_abort (scm_the_vm (), tag, n, argv, NULL);
+  scm_i_vm_abort (tag_and_argv, n);
 
   /* Oh, what, you're still here? The abort must have been reinstated. Actually,
      that's quite impossible, given that we're already in C-land here, so...
@@ -211,12 +135,12 @@ static SCM
 scm_suspendable_continuation_p (SCM tag)
 {
   scm_t_dynstack_prompt_flags flags;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
-  scm_i_jmp_buf *registers;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+  jmp_buf *registers;
 
   if (scm_dynstack_find_prompt (&thread->dynstack, tag, &flags,
-                                NULL, NULL, NULL, &registers))
-    return scm_from_bool (registers == thread->vp->resumable_prompt_cookie);
+                                NULL, NULL, NULL, NULL, &registers))
+    return scm_from_bool (registers == thread->vm.registers);
 
   return SCM_BOOL_F;
 }
@@ -231,15 +155,9 @@ scm_init_ice_9_control (void *unused)
 void
 scm_init_control (void)
 {
-#include "libguile/control.x"
+#include "control.x"
 
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_ice_9_control", scm_init_ice_9_control,
 			    NULL);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/control.h b/libguile/control.h
index 84990ab10..4f64f41ea 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -1,32 +1,33 @@
-/* Copyright (C) 2010, 2011, 2012, 2013  Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef SCM_CONTROL_H
 #define SCM_CONTROL_H
 
-#include "libguile/vm.h"
+#include "libguile/scm.h"
 
 
 SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (struct scm_vm *vp,
-                                                scm_t_ptrdiff saved_stack_depth);
+                                                ptrdiff_t saved_stack_depth);
+
+SCM_INTERNAL SCM scm_i_make_composable_continuation (SCM vmcont);
 
-SCM_INTERNAL void scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
-                               scm_i_jmp_buf *registers) SCM_NORETURN;
 SCM_INTERNAL SCM scm_abort_to_prompt_star (SCM tag, SCM args) SCM_NORETURN;
 
 
diff --git a/libguile/conv-integer.i.c b/libguile/conv-integer.i.c
index 0aa81dc74..7d6bd347e 100644
--- a/libguile/conv-integer.i.c
+++ b/libguile/conv-integer.i.c
@@ -29,7 +29,7 @@ SCM_TO_TYPE_PROTO (SCM val)
   if (SCM_I_INUMP (val))
     {
       scm_t_signed_bits n = SCM_I_INUM (val);
-#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS
+#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_UINTPTR_T
       return n;
 #else
       if (n >= TYPE_MIN && n <= TYPE_MAX)
@@ -64,15 +64,15 @@ SCM_TO_TYPE_PROTO (SCM val)
 	}
       else
 	{
-	  scm_t_uintmax abs_n;
+	  uintmax_t abs_n;
 	  TYPE n;
 	  size_t count;
 
 	  if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
-	      > CHAR_BIT*sizeof (scm_t_uintmax))
+	      > CHAR_BIT*sizeof (uintmax_t))
 	    goto out_of_range;
 	  
-	  mpz_export (&abs_n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
+	  mpz_export (&abs_n, &count, 1, sizeof (uintmax_t), 0, 0,
 		      SCM_I_BIG_MPZ (val));
 
 	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
@@ -113,7 +113,7 @@ SCM_TO_TYPE_PROTO (SCM val)
 SCM
 SCM_FROM_TYPE_PROTO (TYPE val)
 {
-#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
+#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_UINTPTR_T
   return SCM_I_MAKINUM (val);
 #else
   if (SCM_FIXABLE (val))
@@ -146,9 +146,3 @@ SCM_FROM_TYPE_PROTO (TYPE val)
 #undef SIZEOF_TYPE
 #undef SCM_TO_TYPE_PROTO
 #undef SCM_FROM_TYPE_PROTO
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/conv-uinteger.i.c b/libguile/conv-uinteger.i.c
index f62dc41ad..f9203771a 100644
--- a/libguile/conv-uinteger.i.c
+++ b/libguile/conv-uinteger.i.c
@@ -30,7 +30,7 @@ SCM_TO_TYPE_PROTO (SCM val)
     {
       scm_t_signed_bits n = SCM_I_INUM (val);
       if (n >= 0
-	  && ((scm_t_uintmax)n) >= TYPE_MIN && ((scm_t_uintmax)n) <= TYPE_MAX)
+	  && ((uintmax_t)n) >= TYPE_MIN && ((uintmax_t)n) <= TYPE_MAX)
 	return n;
       else
 	{
@@ -66,7 +66,7 @@ SCM_TO_TYPE_PROTO (SCM val)
 	}
       else
 	{
-	  scm_t_uintmax n;
+	  uintmax_t n;
 	  size_t count;
 
 	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0)
@@ -95,7 +95,7 @@ SCM_TO_TYPE_PROTO (SCM val)
 SCM
 SCM_FROM_TYPE_PROTO (TYPE val)
 {
-#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
+#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_UINTPTR_T
   return SCM_I_MAKINUM (val);
 #else
   if (SCM_POSFIXABLE (val))
diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c
index 2f2d0ab74..ac8bf710a 100644
--- a/libguile/debug-malloc.c
+++ b/libguile/debug-malloc.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 2000-2002, 2004, 2006, 2008, 2009, 2018
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2000-2002,2004,2006,2008-2009,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -24,11 +24,13 @@
 #include <string.h>
 #include <stdio.h>
 
-#include "libguile/_scm.h"
-#include "libguile/alist.h"
-#include "libguile/strings.h"
+#include "alist.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "strings.h"
+
+#include "debug-malloc.h"
 
-#include "libguile/debug-malloc.h"
 
 /*
  * The following code is a hack which I wrote quickly in order to
@@ -243,6 +245,6 @@ scm_debug_malloc_prehistory ()
 void
 scm_init_debug_malloc ()
 {
-#include "libguile/debug-malloc.x"
+#include "debug-malloc.x"
 }
 
diff --git a/libguile/debug-malloc.h b/libguile/debug-malloc.h
index 7830adbac..4ced0d144 100644
--- a/libguile/debug-malloc.h
+++ b/libguile/debug-malloc.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_DEBUG_MALLOC_H
 #define SCM_DEBUG_MALLOC_H
 
-/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -37,9 +36,3 @@ SCM_INTERNAL void scm_debug_malloc_prehistory (void);
 SCM_INTERNAL void scm_init_debug_malloc (void);
 
 #endif  /* SCM_DEBUG_MALLOC_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/debug.c b/libguile/debug.c
index c653cdf85..8b6122642 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,27 +1,31 @@
 /* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 1995-2003,2006,2008-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
+#include <errno.h>
+
 #ifdef HAVE_GETRLIMIT
 #include <sys/time.h>
 #include <sys/resource.h>
@@ -32,36 +36,37 @@
 # include <windows.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/eval.h"
-#include "libguile/list.h"
-#include "libguile/stackchk.h"
-#include "libguile/throw.h"
-#include "libguile/macros.h"
-#include "libguile/smob.h"
-#include "libguile/struct.h"
-#include "libguile/procprop.h"
-#include "libguile/srcprop.h"
-#include "libguile/alist.h"
-#include "libguile/continuations.h"
-#include "libguile/strports.h"
-#include "libguile/read.h"
-#include "libguile/feature.h"
-#include "libguile/dynwind.h"
-#include "libguile/modules.h"
-#include "libguile/ports.h"
-#include "libguile/fluids.h"
-#include "libguile/programs.h"
-#include "libguile/memoize.h"
-#include "libguile/vm.h"
-
-#include "libguile/validate.h"
-#include "libguile/debug.h"
-
-#include "libguile/private-options.h"
-
+#include "alist.h"
+#include "async.h"
+#include "continuations.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "feature.h"
+#include "fluids.h"
+#include "gsubr.h"
+#include "list.h"
+#include "macros.h"
+#include "memoize.h"
+#include "modules.h"
+#include "pairs.h"
+#include "ports.h"
+#include "private-options.h"
+#include "procprop.h"
+#include "programs.h"
+#include "read.h"
+#include "smob.h"
+#include "srcprop.h"
+#include "stackchk.h"
+#include "strports.h"
+#include "struct.h"
+#include "throw.h"
+#include "variable.h"
+#include "vm.h"
+
+#include "debug.h"
+
 
+
 
 /*
  * Debugging options.
@@ -217,11 +222,5 @@ scm_init_debug ()
 
   scm_add_feature ("debug-extensions");
 
-#include "libguile/debug.x"
+#include "debug.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/debug.h b/libguile/debug.h
index ab301a003..33c7a5969 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -1,32 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_DEBUG_H
 #define SCM_DEBUG_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2012,2013,2015
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2002,2004,2008-2013,2015,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
 #include "libguile/options.h"
+
 
 
 SCM_API SCM scm_local_eval (SCM exp, SCM env);
@@ -41,9 +38,3 @@ SCM_API SCM scm_debug_hang (SCM obj);
 #endif /*GUILE_DEBUG*/
 
 #endif  /* SCM_DEBUG_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 9d94bc2d8..cc8e78b97 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1,1018 +1,92 @@
-/* This file contains definitions for deprecated features.  When you
-   deprecate something, move it here when that is feasible.
-*/
+/* Copyright 2003-2004,2006,2008-2018
+     Free Software Foundation, Inc.
 
-/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#define SCM_BUILDING_DEPRECATED_CODE
-
-#include <alloca.h>
-#include <sys/types.h>
+#include <stdio.h>
+#include <string.h>
 #include <unistd.h>
 
-#include "libguile/_scm.h"
-#include "libguile/deprecation.h"
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-
-
-SCM
-scm_internal_dynamic_wind (scm_t_guard before,
-			   scm_t_inner inner,
-			   scm_t_guard after,
-			   void *inner_data,
-			   void *guard_data)
-{
-  SCM ans;
-
-  scm_c_issue_deprecation_warning
-    ("`scm_internal_dynamic_wind' is deprecated.  "
-     "Use the `scm_dynwind_begin' / `scm_dynwind_end' API instead.");
-
-  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
-  scm_dynwind_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY);
-  scm_dynwind_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY);
-  ans = inner (inner_data);
-  scm_dynwind_end ();
-  return ans;
-}
-
-
-
-SCM
-scm_immutable_cell (scm_t_bits car, scm_t_bits cdr)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_immutable_cell is deprecated.  Use scm_cell instead.");
-
-  return scm_cell (car, cdr);
-}
-
-SCM
-scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
-			   scm_t_bits ccr, scm_t_bits cdr)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_immutable_double_cell is deprecated.  Use scm_double_cell instead.");
-
-  return scm_double_cell (car, cbr, ccr, cdr);
-}
-
-
-
+#define SCM_BUILDING_DEPRECATED_CODE
 
-SCM_GLOBAL_SYMBOL (scm_memory_alloc_key, "memory-allocation-error");
-void
-scm_memory_error (const char *subr)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_memory_error is deprecated.  Use scm_report_out_of_memory to raise "
-     "an exception, or abort() to cause the program to exit.");
+#include "deprecation.h"
+#include "gc.h"
 
-  fprintf (stderr, "FATAL: memory error in %s\n", subr);
-  abort ();
-}
+#include "deprecated.h"
 
+#if (SCM_ENABLE_DEPRECATED == 1)
 
 
 
-static SCM var_slot_ref_using_class = SCM_BOOL_F;
-static SCM var_slot_set_using_class_x = SCM_BOOL_F;
-static SCM var_slot_bound_using_class_p = SCM_BOOL_F;
-static SCM var_slot_exists_using_class_p = SCM_BOOL_F;
-
-SCM scm_no_applicable_method = SCM_BOOL_F;
-
-SCM var_get_keyword = SCM_BOOL_F;
-
-SCM scm_class_boolean, scm_class_char, scm_class_pair;
-SCM scm_class_procedure, scm_class_string, scm_class_symbol;
-SCM scm_class_primitive_generic;
-SCM scm_class_vector, scm_class_null;
-SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction;
-SCM scm_class_unknown;
-SCM scm_class_top, scm_class_object, scm_class_class;
-SCM scm_class_applicable;
-SCM scm_class_applicable_struct, scm_class_applicable_struct_with_setter;
-SCM scm_class_generic, scm_class_generic_with_setter;
-SCM scm_class_accessor;
-SCM scm_class_extended_generic, scm_class_extended_generic_with_setter;
-SCM scm_class_extended_accessor;
-SCM scm_class_method;
-SCM scm_class_accessor_method;
-SCM scm_class_procedure_class;
-SCM scm_class_applicable_struct_class;
-SCM scm_class_number, scm_class_list;
-SCM scm_class_keyword;
-SCM scm_class_port, scm_class_input_output_port;
-SCM scm_class_input_port, scm_class_output_port;
-SCM scm_class_foreign_slot;
-SCM scm_class_self, scm_class_protected;
-SCM scm_class_hidden, scm_class_opaque, scm_class_read_only;
-SCM scm_class_protected_hidden, scm_class_protected_opaque, scm_class_protected_read_only;
-SCM scm_class_scm;
-SCM scm_class_int, scm_class_float, scm_class_double;
-
-SCM *scm_port_class, *scm_smob_class;
-
-void
-scm_init_deprecated_goops (void)
-{
-  var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
-  var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
-  var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
-  var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?");
-
-  scm_no_applicable_method =
-    scm_variable_ref (scm_c_lookup ("no-applicable-method"));
-
-  var_get_keyword = scm_c_lookup ("get-keyword");
-
-  scm_class_class = scm_variable_ref (scm_c_lookup ("<class>"));
-  scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
-  scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
-
-  scm_class_foreign_slot = scm_variable_ref (scm_c_lookup ("<foreign-slot>"));
-  scm_class_protected = scm_variable_ref (scm_c_lookup ("<protected-slot>"));
-  scm_class_hidden = scm_variable_ref (scm_c_lookup ("<hidden-slot>"));
-  scm_class_opaque = scm_variable_ref (scm_c_lookup ("<opaque-slot>"));
-  scm_class_read_only = scm_variable_ref (scm_c_lookup ("<read-only-slot>"));
-  scm_class_self = scm_variable_ref (scm_c_lookup ("<self-slot>"));
-  scm_class_protected_opaque = scm_variable_ref (scm_c_lookup ("<protected-opaque-slot>"));
-  scm_class_protected_hidden = scm_variable_ref (scm_c_lookup ("<protected-hidden-slot>"));
-  scm_class_protected_read_only = scm_variable_ref (scm_c_lookup ("<protected-read-only-slot>"));
-  scm_class_scm = scm_variable_ref (scm_c_lookup ("<scm-slot>"));
-  scm_class_int = scm_variable_ref (scm_c_lookup ("<int-slot>"));
-  scm_class_float = scm_variable_ref (scm_c_lookup ("<float-slot>"));
-  scm_class_double = scm_variable_ref (scm_c_lookup ("<double-slot>"));
-
-  /* scm_class_generic functions classes */
-  scm_class_procedure_class = scm_variable_ref (scm_c_lookup ("<procedure-class>"));
-  scm_class_applicable_struct_class = scm_variable_ref (scm_c_lookup ("<applicable-struct-class>"));
-
-  scm_class_method = scm_variable_ref (scm_c_lookup ("<method>"));
-  scm_class_accessor_method = scm_variable_ref (scm_c_lookup ("<accessor-method>"));
-  scm_class_applicable = scm_variable_ref (scm_c_lookup ("<applicable>"));
-  scm_class_applicable_struct = scm_variable_ref (scm_c_lookup ("<applicable-struct>"));
-  scm_class_applicable_struct_with_setter = scm_variable_ref (scm_c_lookup ("<applicable-struct-with-setter>"));
-  scm_class_generic = scm_variable_ref (scm_c_lookup ("<generic>"));
-  scm_class_extended_generic = scm_variable_ref (scm_c_lookup ("<extended-generic>"));
-  scm_class_generic_with_setter = scm_variable_ref (scm_c_lookup ("<generic-with-setter>"));
-  scm_class_accessor = scm_variable_ref (scm_c_lookup ("<accessor>"));
-  scm_class_extended_generic_with_setter = scm_variable_ref (scm_c_lookup ("<extended-generic-with-setter>"));
-  scm_class_extended_accessor = scm_variable_ref (scm_c_lookup ("<extended-accessor>"));
-
-  /* Primitive types classes */
-  scm_class_boolean = scm_variable_ref (scm_c_lookup ("<boolean>"));
-  scm_class_char = scm_variable_ref (scm_c_lookup ("<char>"));
-  scm_class_list = scm_variable_ref (scm_c_lookup ("<list>"));
-  scm_class_pair = scm_variable_ref (scm_c_lookup ("<pair>"));
-  scm_class_null = scm_variable_ref (scm_c_lookup ("<null>"));
-  scm_class_string = scm_variable_ref (scm_c_lookup ("<string>"));
-  scm_class_symbol = scm_variable_ref (scm_c_lookup ("<symbol>"));
-  scm_class_vector = scm_variable_ref (scm_c_lookup ("<vector>"));
-  scm_class_number = scm_variable_ref (scm_c_lookup ("<number>"));
-  scm_class_complex = scm_variable_ref (scm_c_lookup ("<complex>"));
-  scm_class_real = scm_variable_ref (scm_c_lookup ("<real>"));
-  scm_class_integer = scm_variable_ref (scm_c_lookup ("<integer>"));
-  scm_class_fraction = scm_variable_ref (scm_c_lookup ("<fraction>"));
-  scm_class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
-  scm_class_unknown = scm_variable_ref (scm_c_lookup ("<unknown>"));
-  scm_class_procedure = scm_variable_ref (scm_c_lookup ("<procedure>"));
-  scm_class_primitive_generic = scm_variable_ref (scm_c_lookup ("<primitive-generic>"));
-  scm_class_port = scm_variable_ref (scm_c_lookup ("<port>"));
-  scm_class_input_port = scm_variable_ref (scm_c_lookup ("<input-port>"));
-  scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
-  scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>"));
-
-  scm_smob_class = scm_i_smob_class;
-}
-
-SCM
-scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_get_keyword is deprecated.  Use `kw-arg-ref' from Scheme instead.");
-
-  return scm_call_3 (scm_variable_ref (var_get_keyword),
-                     kw, initargs, default_value);
-}
-
-#define BUFFSIZE 32		/* big enough for most uses */
-#define SPEC_OF(x) \
-  (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))
-#define CPL_OF(x) \
-  (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("cpl"))))
-
-static SCM
-scm_i_vector2list (SCM l, long len)
-{
-  long j;
-  SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
-
-  for (j = 0; j < len; j++, l = SCM_CDR (l)) {
-    SCM_SIMPLE_VECTOR_SET (z, j, SCM_CAR (l));
-  }
-  return z;
-}
-
-static int
-applicablep (SCM actual, SCM formal)
-{
-  /* We already know that the cpl is well formed. */
-  return scm_is_true (scm_c_memq (formal, CPL_OF (actual)));
-}
-
-static int
-more_specificp (SCM m1, SCM m2, SCM const *targs)
-{
-  register SCM s1, s2;
-  register long i;
-  /*
-   * Note:
-   *   m1 and m2 can have != length (i.e. one can be one element longer than the
-   * other when we have a dotted parameter list). For instance, with the call
-   *   (M 1)
-   * with
-   *   (define-method M (a . l) ....)
-   *   (define-method M (a) ....)
-   *
-   * we consider that the second method is more specific.
-   *
-   * BTW, targs is an array of types. We don't need it's size since
-   * we already know that m1 and m2 are applicable (no risk to go past
-   * the end of this array).
-   *
-   */
-  for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) {
-    if (scm_is_null(s1)) return 1;
-    if (scm_is_null(s2)) return 0;
-    if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
-      register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
-
-      for (l = CPL_OF (targs[i]);   ; l = SCM_CDR(l)) {
-	if (scm_is_eq (cs1, SCM_CAR (l)))
-	  return 1;
-	if (scm_is_eq (cs2, SCM_CAR (l)))
-	  return 0;
-      }
-      return 0;/* should not occur! */
-    }
-  }
-  return 0; /* should not occur! */
-}
-
-static SCM
-sort_applicable_methods (SCM method_list, long size, SCM const *targs)
-{
-  long i, j, incr;
-  SCM *v, vector = SCM_EOL;
-  SCM buffer[BUFFSIZE];
-  SCM save = method_list;
-  scm_t_array_handle handle;
-
-  /* For reasonably sized method_lists we can try to avoid all the
-   * consing and reorder the list in place...
-   * This idea is due to David McClain <Dave_McClain@msn.com>
-   */
-  if (size <= BUFFSIZE)
-    {
-      for (i = 0;  i < size; i++)
-	{
-	  buffer[i]   = SCM_CAR (method_list);
-	  method_list = SCM_CDR (method_list);
-	}
-      v = buffer;
-    }
-  else
-    {
-      /* Too many elements in method_list to keep everything locally */
-      vector = scm_i_vector2list (save, size);
-      v = scm_vector_writable_elements (vector, &handle, NULL, NULL);
-    }
-
-  /* Use a simple shell sort since it is generally faster than qsort on
-   * small vectors (which is probably mostly the case when we have to
-   * sort a list of applicable methods).
-   */
-  for (incr = size / 2; incr; incr /= 2)
-    {
-      for (i = incr; i < size; i++)
-	{
-	  for (j = i - incr; j >= 0; j -= incr)
-	    {
-	      if (more_specificp (v[j], v[j+incr], targs))
-		break;
-	      else
-		{
-		  SCM tmp = v[j + incr];
-		  v[j + incr] = v[j];
-		  v[j] = tmp;
-		}
-	    }
-	}
-    }
-
-  if (size <= BUFFSIZE)
-    {
-      /* We did it in locally, so restore the original list (reordered) in-place */
-      for (i = 0, method_list = save; i < size; i++, v++)
-	{
-	  SCM_SETCAR (method_list, *v);
-	  method_list = SCM_CDR (method_list);
-	}
-      return save;
-    }
-
-  /* If we are here, that's that we did it the hard way... */
-  scm_array_handle_release (&handle);
-  return scm_vector_to_list (vector);
-}
-
-SCM
-scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
-{
-  register long i;
-  long count = 0;
-  SCM l, fl, applicable = SCM_EOL;
-  SCM save = args;
-  SCM buffer[BUFFSIZE];
-  SCM const *types;
-  SCM *p;
-  SCM tmp = SCM_EOL;
-  scm_t_array_handle handle;
-
-  scm_c_issue_deprecation_warning
-    ("scm_compute_applicable_methods is deprecated.  Use "
-     "`compute-applicable-methods' from Scheme instead.");
-
-  /* Build the list of arguments types */
-  if (len >= BUFFSIZE) 
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 80
+#endif /* ndef MAXPATHLEN */
+#ifndef X_OK
+#define X_OK 1
+#endif /* ndef X_OK */
+
+char *
+scm_find_executable (const char *name)
+{
+  char tbuf[MAXPATHLEN];
+  int i = 0, c;
+  FILE *f;
+
+  scm_c_issue_deprecation_warning ("scm_find_executable is deprecated.");
+
+  /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
+  if (access (name, X_OK))
+    return 0L;
+  f = fopen (name, "r");
+  if (!f)
+    return 0L;
+  if ((fgetc (f) == '#') && (fgetc (f) == '!'))
     {
-      tmp = scm_c_make_vector (len, SCM_UNDEFINED);
-      types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL);
-
-    /*
-      note that we don't have to work to reset the generation
-      count. TMP is a new vector anyway, and it is found
-      conservatively.
-    */
-    }
-  else
-    types = p = buffer;
-
-  for (  ; !scm_is_null (args); args = SCM_CDR (args))
-    *p++ = scm_class_of (SCM_CAR (args));
-  
-  /* Build a list of all applicable methods */
-  for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l))
-    {
-      fl = SPEC_OF (SCM_CAR (l));
-      for (i = 0; ; i++, fl = SCM_CDR (fl))
-	{
-	  if (SCM_INSTANCEP (fl)
-	      /* We have a dotted argument list */
-	      || (i >= len && scm_is_null (fl)))
-	    {	/* both list exhausted */
-	      applicable = scm_cons (SCM_CAR (l), applicable);
-	      count     += 1;
-	      break;
-	    }
-	  if (i >= len
-	      || scm_is_null (fl)
-	      || !applicablep (types[i], SCM_CAR (fl)))
+      while (1)
+	switch (c = fgetc (f))
+	  {
+	  case /*WHITE_SPACES */ ' ':
+	  case '\t':
+	  case '\r':
+	  case '\f':
+	  case EOF:
+	    tbuf[i] = 0;
+	    fclose (f);
+	    return strdup (tbuf);
+	  default:
+	    tbuf[i++] = c;
 	    break;
-	}
-    }
-
-  if (len >= BUFFSIZE)
-      scm_array_handle_release (&handle);
-
-  if (count == 0)
-    {
-      if (find_method_p)
-	return SCM_BOOL_F;
-      scm_call_2 (scm_no_applicable_method, gf, save);
-      /* if we are here, it's because no-applicable-method hasn't signaled an error */
-      return SCM_BOOL_F;
+	  }
     }
-
-  return (count == 1
-	  ? applicable
-	  : sort_applicable_methods (applicable, count, types));
-}
-
-SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
-
-SCM
-scm_find_method (SCM l)
-#define FUNC_NAME "find-method"
-{
-  SCM gf;
-  long len = scm_ilength (l);
-
-  if (len == 0)
-    SCM_WRONG_NUM_ARGS ();
-
-  scm_c_issue_deprecation_warning
-    ("scm_find_method is deprecated.  Use `compute-applicable-methods' "
-     "from Scheme instead.");
-
-  gf = SCM_CAR(l); l = SCM_CDR(l);
-  SCM_VALIDATE_GENERIC (1, gf);
-  if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods"))))
-    SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
-
-  return scm_compute_applicable_methods (gf, l, len - 1, 1);
-}
-#undef FUNC_NAME
-
-SCM
-scm_basic_make_class (SCM meta, SCM name, SCM dsupers, SCM dslots)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_basic_make_class is deprecated.  Use `define-class' in Scheme,"
-     "or use `(make META #:name NAME #:dsupers DSUPERS #:slots DSLOTS)' "
-     "in Scheme.");
-
-  return scm_make_standard_class (meta, name, dsupers, dslots);
-}
-
-/* Scheme will issue the deprecation warning for these.  */
-SCM
-scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_ref_using_class),
-                     class, obj, slot_name);
-}
-
-SCM
-scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value)
-{
-  return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x),
-                     class, obj, slot_name, value);
-}
-
-SCM
-scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p),
-                     class, obj, slot_name);
-}
-
-SCM
-scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p),
-                     class, obj, slot_name);
+  fclose (f);
+  return strdup (name);
 }
 
 
 
-#define FETCH_STORE(fet,mem,sto)                        \
-  do {                                                  \
-    scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);   \
-    (fet) = (mem);                                      \
-    (mem) = (sto);                                      \
-    scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);     \
-  } while (0)
-
-static scm_t_bits scm_tc16_arbiter;
-
-
-#define SCM_LOCK_VAL         (scm_tc16_arbiter | (1L << 16))
-#define SCM_UNLOCK_VAL       scm_tc16_arbiter
-#define SCM_ARB_LOCKED(arb)  ((SCM_CELL_WORD_0 (arb)) & (1L << 16))
-
-
-static int 
-arbiter_print (SCM exp, SCM port, scm_print_state *pstate)
-{
-  scm_puts ("#<arbiter ", port);
-  if (SCM_ARB_LOCKED (exp))
-    scm_puts ("locked ", port);
-  scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate);
-  scm_putc ('>', port);
-  return !0;
-}
-
-SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, 
-	    (SCM name),
-	    "Return an arbiter object, initially unlocked.  Currently\n"
-	    "@var{name} is only used for diagnostic output.")
-#define FUNC_NAME s_scm_make_arbiter
-{
-  scm_c_issue_deprecation_warning
-    ("Arbiters are deprecated.  "
-     "Use mutexes or atomic variables instead.");
-
-  SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name));
-}
-#undef FUNC_NAME
-
-
-/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
-   unlocked and return #t.  The arbiter itself wouldn't be corrupted by
-   this, but two threads both getting #t would be contrary to the intended
-   semantics.  */
-
-SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, 
-	    (SCM arb),
-	    "If @var{arb} is unlocked, then lock it and return @code{#t}.\n"
-	    "If @var{arb} is already locked, then do nothing and return\n"
-	    "@code{#f}.")
-#define FUNC_NAME s_scm_try_arbiter
-{
-  scm_t_bits old;
-  scm_t_bits *loc;
-  SCM_VALIDATE_SMOB (1, arb, arbiter);
-  loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
-  FETCH_STORE (old, *loc, SCM_LOCK_VAL);
-  return scm_from_bool (old == SCM_UNLOCK_VAL);
-}
-#undef FUNC_NAME
-
-
-/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
-   locked and return #t.  The arbiter itself wouldn't be corrupted by this,
-   but we don't want two threads both thinking they were the unlocker.  The
-   intended usage is for the code which locked to be responsible for
-   unlocking, but we guarantee the return value even if multiple threads
-   compete.  */
-
-SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0,
-	    (SCM arb),
-	    "If @var{arb} is locked, then unlock it and return @code{#t}.\n"
-	    "If @var{arb} is already unlocked, then do nothing and return\n"
-	    "@code{#f}.\n"
-	    "\n"
-	    "Typical usage is for the thread which locked an arbiter to\n"
-	    "later release it, but that's not required, any thread can\n"
-	    "release it.")
-#define FUNC_NAME s_scm_release_arbiter
-{
-  scm_t_bits old;
-  scm_t_bits *loc;
-  SCM_VALIDATE_SMOB (1, arb, arbiter);
-  loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
-  FETCH_STORE (old, *loc, SCM_UNLOCK_VAL);
-  return scm_from_bool (old == SCM_LOCK_VAL);
-}
-#undef FUNC_NAME
-
-
-
-
-/* User asyncs. */
-
-static scm_t_bits tc16_async;
-
-/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it.
-   this is ugly.  */
-#define SCM_ASYNCP(X)		SCM_TYP16_PREDICATE (tc16_async, X)
-#define VALIDATE_ASYNC(pos, a)	SCM_MAKE_VALIDATE_MSG(pos, a, ASYNCP, "user async")
-
-#define ASYNC_GOT_IT(X)        (SCM_SMOB_FLAGS (X))
-#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_SMOB_FLAGS ((X), ((V))))
-#define ASYNC_THUNK(X)         SCM_SMOB_OBJECT_1 (X)
-
-
-SCM_DEFINE (scm_async, "async", 1, 0, 0,
-	    (SCM thunk),
-	    "Create a new async for the procedure @var{thunk}.")
-#define FUNC_NAME s_scm_async
-{
-  scm_c_issue_deprecation_warning
-    ("\"User asyncs\" are deprecated.  Use closures instead.");
-
-  SCM_RETURN_NEWSMOB (tc16_async, SCM_UNPACK (thunk));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0,
-            (SCM a),
-	    "Mark the async @var{a} for future execution.")
-#define FUNC_NAME s_scm_async_mark
-{
-  VALIDATE_ASYNC (1, a);
-  SET_ASYNC_GOT_IT (a, 1);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0,
-	    (SCM list_of_a),
-	    "Execute all thunks from the asyncs of the list @var{list_of_a}.")
-#define FUNC_NAME s_scm_run_asyncs
-{
-  while (! SCM_NULL_OR_NIL_P (list_of_a))
-    {
-      SCM a;
-      SCM_VALIDATE_CONS (1, list_of_a);
-      a = SCM_CAR (list_of_a);
-      VALIDATE_ASYNC (SCM_ARG1, a);
-      if (ASYNC_GOT_IT (a))
-	{
-	  SET_ASYNC_GOT_IT (a, 0);
-	  scm_call_0 (ASYNC_THUNK (a));
-	}
-      list_of_a = SCM_CDR (list_of_a);
-    }
-  return SCM_BOOL_T;
-}
-#undef FUNC_NAME
-
-
-static scm_i_pthread_mutex_t critical_section_mutex;
-static SCM dynwind_critical_section_mutex;
-
-void
-scm_critical_section_start (void)
-{
-  scm_c_issue_deprecation_warning
-    ("Critical sections are deprecated.  Instead use dynwinds and "
-     "\"scm_dynwind_pthread_mutex_lock\" together with "
-     "\"scm_dynwind_block_asyncs\" if appropriate.");
-
-  scm_i_pthread_mutex_lock (&critical_section_mutex);
-  SCM_I_CURRENT_THREAD->block_asyncs++;
-}
-
-void
-scm_critical_section_end (void)
-{
-  SCM_I_CURRENT_THREAD->block_asyncs--;
-  scm_i_pthread_mutex_unlock (&critical_section_mutex);
-  scm_async_tick ();
-}
-
-void
-scm_dynwind_critical_section (SCM mutex)
-{
-  scm_c_issue_deprecation_warning
-    ("Critical sections are deprecated.  Instead use dynwinds and "
-     "\"scm_dynwind_pthread_mutex_lock\" together with "
-     "\"scm_dynwind_block_asyncs\" if appropriate.");
-
-  if (scm_is_false (mutex))
-    mutex = dynwind_critical_section_mutex;
-  scm_dynwind_lock_mutex (mutex);
-  scm_dynwind_block_asyncs ();
-}
-
-
-
-
-SCM
-scm_make_mutex_with_flags (SCM flags)
-{
-  SCM kind = SCM_UNDEFINED;
-
-  scm_c_issue_deprecation_warning
-    ("'scm_make_mutex_with_flags' is deprecated.  "
-     "Use 'scm_make_mutex_with_kind' instead.");
-
-  if (!scm_is_null (flags))
-    {
-      if (!scm_is_null (scm_cdr (flags)))
-	scm_misc_error (NULL, "too many mutex options: ~a", scm_list_1 (flags));
-      kind = scm_car (flags);
-    }
-
-  return scm_make_mutex_with_kind (kind);
-}
-
-SCM
-scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner)
-{
-  scm_c_issue_deprecation_warning
-    ("'scm_lock_mutex_timed' is deprecated.  "
-     "Use 'scm_timed_lock_mutex' instead.");
-
-  if (!SCM_UNBNDP (owner) && !scm_is_false (owner))
-    scm_c_issue_deprecation_warning
-      ("The 'owner' argument to 'scm_lock_mutex_timed' is deprecated.  "
-       "Use SRFI-18 directly if you need this concept.");
-
-  return scm_timed_lock_mutex (m, timeout);
-}
-
-SCM
-scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout)
-{
-  scm_c_issue_deprecation_warning
-    ("'scm_unlock_mutex_timed' is deprecated.  "
-     "Use just plain old 'scm_unlock_mutex' instead, or otherwise "
-     "'scm_wait_condition_variable' if you need to.");
-
-  if (!SCM_UNBNDP (cond) &&
-      scm_is_false (scm_timed_wait_condition_variable (cond, mx, timeout)))
-    return SCM_BOOL_F;
-
-  return scm_unlock_mutex (mx);
-}
-
-
-
-SCM
-scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
-#define FUNC_NAME "scm_from_contiguous_array"
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  SCM ra;
-  scm_t_array_handle h;
-
-  scm_c_issue_deprecation_warning
-    ("`scm_from_contiguous_array' is deprecated. Use make-array and array-copy!\n"
-     "instead.\n");
-  
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-  if (rlen != len)
-    SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
-
-  SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
-  scm_array_get_handle (ra, &h);
-  memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
-  scm_array_handle_release (&h);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (0 == s->lbnd)
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-
-
-/* {call-with-dynamic-root}
- *
- * Suspending the current thread to evaluate a thunk on the
- * same C stack but under a new root.
- *
- * Calls to call-with-dynamic-root return exactly once (unless
- * the process is somehow exitted).  */
-
-/* cwdr fills out both of these structures, and then passes a pointer
-   to them through scm_internal_catch to the cwdr_body and
-   cwdr_handler functions, to tell them how to behave and to get
-   information back from them.
-
-   A cwdr is a lot like a catch, except there is no tag (all
-   exceptions are caught), and the body procedure takes the arguments
-   passed to cwdr as A1 and ARGS.  The handler is also special since
-   it is not directly run from scm_internal_catch.  It is executed
-   outside the new dynamic root. */
-
-struct cwdr_body_data {
-  /* Arguments to pass to the cwdr body function.  */
-  SCM a1, args;
-
-  /* Scheme procedure to use as body of cwdr.  */
-  SCM body_proc;
-};
-
-struct cwdr_handler_data {
-  /* Do we need to run the handler? */
-  int run_handler;
-
-  /* The tag and args to pass it. */
-  SCM tag, args;
-};
-
-
-/* Invoke the body of a cwdr, assuming that the throw handler has
-   already been set up.  DATA points to a struct set up by cwdr that
-   says what proc to call, and what args to apply it to.
-
-   With a little thought, we could replace this with scm_body_thunk,
-   but I don't want to mess with that at the moment.  */
-static SCM
-cwdr_body (void *data)
-{
-  struct cwdr_body_data *c = (struct cwdr_body_data *) data;
-
-  return scm_apply (c->body_proc, c->a1, c->args);
-}
-
-/* Record the fact that the body of the cwdr has thrown.  Record
-   enough information to invoke the handler later when the dynamic
-   root has been deestablished.  */
-
-static SCM
-cwdr_handler (void *data, SCM tag, SCM args)
-{
-  struct cwdr_handler_data *c = (struct cwdr_handler_data *) data;
-
-  c->run_handler = 1;
-  c->tag = tag;
-  c->args = args;
-  return SCM_UNSPECIFIED;
-}
-
-SCM 
-scm_internal_cwdr (scm_t_catch_body body, void *body_data,
-		   scm_t_catch_handler handler, void *handler_data,
-		   SCM_STACKITEM *stack_start)
-{
-  struct cwdr_handler_data my_handler_data;
-  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
-  SCM answer;
-  scm_t_dynstack *old_dynstack;
-
-  /* Exit caller's dynamic state.
-   */
-  old_dynstack = scm_dynstack_capture_all (dynstack);
-  scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack));
-
-  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
-  scm_dynwind_current_dynamic_state (scm_current_dynamic_state ());
-
-  my_handler_data.run_handler = 0;
-  answer = scm_i_with_continuation_barrier (body, body_data,
-					    cwdr_handler, &my_handler_data,
-					    NULL, NULL);
-
-  scm_dynwind_end ();
-
-  /* Enter caller's dynamic state.
-   */
-  scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack));
-
-  /* Now run the real handler iff the body did a throw. */
-  if (my_handler_data.run_handler)
-    return handler (handler_data, my_handler_data.tag, my_handler_data.args);
-  else
-    return answer;
-}
-
-/* The original CWDR for invoking Scheme code with a Scheme handler. */
-
-static SCM 
-cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start)
-{
-  struct cwdr_body_data c;
-  
-  c.a1 = a1;
-  c.args = args;
-  c.body_proc = proc;
-
-  return scm_internal_cwdr (cwdr_body, &c,
-			    scm_handle_by_proc, &handler,
-			    stack_start);
-}
-
-SCM_DEFINE (scm_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0,
-           (SCM thunk, SCM handler),
-	    "Call @var{thunk} with a new dynamic state and within\n"
-	    "a continuation barrier.  The @var{handler} catches all\n"
-	    "otherwise uncaught throws and executes within the same\n"
-	    "dynamic context as @var{thunk}.")
-#define FUNC_NAME s_scm_call_with_dynamic_root
-{
-  SCM_STACKITEM stack_place;
-  scm_c_issue_deprecation_warning
-    ("call-with-dynamic-root is deprecated.  There is no replacement.");
-  return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_dynamic_root, "dynamic-root", 0, 0, 0, 
-           (),
-	    "Return an object representing the current dynamic root.\n\n"
-	    "These objects are only useful for comparison using @code{eq?}.\n")
-#define FUNC_NAME s_scm_dynamic_root
-{
-  scm_c_issue_deprecation_warning
-    ("dynamic-root is deprecated.  There is no replacement.");
-  return SCM_I_CURRENT_THREAD->continuation_root;
-}
-#undef FUNC_NAME
-
-SCM
-scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler)
-{
-  SCM_STACKITEM stack_place;
-  scm_c_issue_deprecation_warning
-    ("scm_apply_with_dynamic_root is deprecated.  There is no replacement.");
-  return cwdr (proc, a1, args, handler, &stack_place);
-}
-
-
-
-
-SCM
-scm_make_dynamic_state (SCM parent)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_make_dynamic_state is deprecated.  Dynamic states are "
-     "now immutable; just use the parent directly.");
-  return SCM_UNBNDP (parent) ? scm_current_dynamic_state () : parent;
-}
-
-
-
-
-int
-SCM_FDES_RANDOM_P (int fdes)
-{
-  scm_c_issue_deprecation_warning
-    ("SCM_FDES_RANDOM_P is deprecated.  Use lseek (fd, 0, SEEK_CUR).");
-
-  return (lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1;
-}
-
-
-
-SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, 
-            (SCM vtable, SCM tail_array_size, SCM init),
-	    "Create a new structure.\n\n"
-	    "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
-	    "@var{tail_array_size} must be a non-negative integer.  If the layout\n"
-	    "specification indicated by @var{vtable} includes a tail-array,\n"
-	    "this is the number of elements allocated to that array.\n\n"
-	    "The @var{init1}, @dots{} are optional arguments describing how\n"
-	    "successive fields of the structure should be initialized.  Only fields\n"
-	    "with protection 'r' or 'w' can be initialized, except for fields of\n"
-	    "type 's', which are automatically initialized to point to the new\n"
-	    "structure itself. Fields with protection 'o' can not be initialized by\n"
-	    "Scheme programs.\n\n"
-	    "If fewer optional arguments than initializable fields are supplied,\n"
-	    "fields of type 'p' get default value #f while fields of type 'u' are\n"
-	    "initialized to 0.")
-#define FUNC_NAME s_scm_make_struct
-{
-  size_t i, n_init;
-  long ilen;
-  scm_t_bits *v;
-
-  scm_c_issue_deprecation_warning
-    ("make-struct is deprecated.  Use make-struct/no-tail instead.");
-
-  SCM_VALIDATE_VTABLE (1, vtable);
-  ilen = scm_ilength (init);
-  if (ilen < 0)
-    SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL);
-  
-  n_init = (size_t)ilen;
-
-  /* best to use alloca, but init could be big, so hack to avoid a possible
-     stack overflow */
-  if (n_init < 64)
-    v = alloca (n_init * sizeof(scm_t_bits));
-  else
-    v = scm_gc_malloc (n_init * sizeof(scm_t_bits), "struct");
-
-  for (i = 0; i < n_init; i++, init = SCM_CDR (init))
-    v[i] = SCM_UNPACK (SCM_CAR (init));
-
-  return scm_c_make_structv (vtable, scm_to_size_t (tail_array_size), n_init, v);
-}
-#undef FUNC_NAME
-
-
 
 void
 scm_i_init_deprecated ()
 {
-  scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0);
-  scm_set_smob_print (scm_tc16_arbiter, arbiter_print);
-  tc16_async = scm_make_smob_type ("async", 0);
-  scm_i_pthread_mutex_init (&critical_section_mutex,
-			    scm_i_pthread_mutexattr_recursive);
-  dynwind_critical_section_mutex = scm_make_recursive_mutex ();
-#include "libguile/deprecated.x"
+#include "deprecated.x"
 }
 
-#endif
+#endif /* SCM_ENABLE_DEPRECATD == 1 */
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 68cd65448..543d1b813 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -1,282 +1,117 @@
-/* This file contains definitions for deprecated features.  When you
-   deprecate something, move it here when that is feasible.
-*/
-
 #ifndef SCM_DEPRECATED_H
 #define SCM_DEPRECATED_H
 
-/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-#include "libguile/__scm.h"
-#include "libguile/strings.h"
-#include "libguile/eval.h"
-#include "libguile/throw.h"
-#include "libguile/iselect.h"
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-/* Deprecated 13-05-2011 because it's better just to scm_dynwind_begin.
-   That also avoids the temptation to stuff pointers in an SCM.  */
+/* Copyright 2003-2007,2009-2018
+     Free Software Foundation, Inc.
 
-typedef SCM (*scm_t_inner) (void *);
-SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before,
-                                              scm_t_inner inner,
-                                              scm_t_guard after,
-                                              void *inner_data,
-                                              void *guard_data);
+   This file is part of Guile.
 
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-/* Deprecated 15-05-2011 because it's better to be explicit with the
-   `return'.  Code is more readable that way.  */
-#define SCM_WTA_DISPATCH_0(gf, subr)			        \
-  return scm_wta_dispatch_0 ((gf), (subr))
-#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr)			\
-  return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
-#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr)          \
-  return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
-#define SCM_WTA_DISPATCH_N(gf, args, pos, subr)			\
-  return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-/* Deprecated 15-05-2011 because this idiom is not very readable.  */
-#define SCM_GASSERT0(cond, gf, subr)            \
-  if (SCM_UNLIKELY (!(cond)))                   \
-    return scm_wta_dispatch_0 ((gf), (subr))
-#define SCM_GASSERT1(cond, gf, a1, pos, subr)           \
-  if (SCM_UNLIKELY (!(cond)))                           \
-    return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
-#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr)	\
-  if (SCM_UNLIKELY (!(cond)))                           \
-    return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
-#define SCM_GASSERTn(cond, gf, args, pos, subr)         \
-  if (SCM_UNLIKELY (!(cond)))                           \
-    return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-/* Deprecated 15-05-2011 because this is a one-off macro that does
-   strange things.  */
-#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)				\
-  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))			\
-	  ? scm_call_1 ((*SCM_SUBR_GENERIC (subr)), (a1))               \
-	  : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED))
+#include "libguile/snarf.h"
 
-#define SCM_LIST0 SCM_EOL
-#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
-#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
-#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2)))
-#define SCM_LIST4(e0, e1, e2, e3)\
-     scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3)))
-#define SCM_LIST5(e0, e1, e2, e3, e4)\
-     scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4)))
-#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\
-     scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5)))
-#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\
-     scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6)))
-#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\
-     scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7)))
-#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\
-     scm_cons ((e0),\
-	       SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
+#if (SCM_ENABLE_DEPRECATED == 1)
 
-#define SCM_CHAR_CODE_LIMIT SCM_CHAR_CODE_LIMIT__GONE__REPLACE_WITH__256L
-#define SCM_OPDIRP SCM_OPDIRP__GONE__REPLACE_WITH__SCM_DIRP_and_SCM_DIR_OPEN_P
-#define SCM_PROCEDURE SCM_PROCEDURE__GONE__REPLACE_WITH__scm_procedure
-#define SCM_PROCEDURE_WITH_SETTER_P SCM_PROCEDURE_WITH_SETTER_P__GONE__REPLACE_WITH__scm_is_true__scm_procedure_with_setter_p
-#define SCM_SETTER SCM_SETTER__GONE__REPLACE_WITH__scm_setter
-#define SCM_THREAD_SWITCHING_CODE SCM_THREAD_SWITCHING_CODE__GONE__REMOVE_FROM_YOUR_CODE
-#define SCM_VALIDATE_NUMBER_COPY SCM_VALIDATE_NUMBER_COPY__GONE__REPLACE_WITH__SCM_VALIDATE_DOUBLE_COPY
-#define SCM_VALIDATE_NUMBER_DEF_COPY SCM_VALIDATE_NUMBER_DEF_COPY__GONE__REPLACE_WITH__SCM_UNBNDP_and_SCM_VALIDATE_DOUBLE_COPY
-#define SCM_VALIDATE_OPDIR SCM_VALIDATE_OPDIR__GONE
-#define SCM_VALIDATE_STRING_COPY SCM_VALIDATE_STRING_COPY__GONE
-#define SCM_VALIDATE_SUBSTRING_SPEC_COPY SCM_VALIDATE_SUBSTRING_SPEC_COPY__GONE
-#define scm_array scm_array__GONE__REPLACE_WITH__scm_t_array
-#define scm_array_dim scm_array_dim__GONE__REPLACE_WITH__scm_t_array_dim
-#define scm_async_click scm_async_click__GONE__REPLACE_WITH__scm_async_tick
-#define scm_call_generic_0 scm_call_generic_0__GONE__REPLACE_WITH__scm_call_0
-#define scm_call_generic_1 scm_call_generic_1__GONE__REPLACE_WITH__scm_call_1
-#define scm_call_generic_2 scm_call_generic_2__GONE__REPLACE_WITH__scm_call_2
-#define scm_call_generic_3 scm_call_generic_3__GONE__REPLACE_WITH__scm_call_3
-#define scm_apply_generic scm_apply_generic__GONE__REPLACE_WITH__scm_apply_0
-#define scm_fport scm_fport__GONE__REPLACE_WITH__scm_t_fport
-#define scm_listify scm_listify__GONE__REPLACE_WITH__scm_list_n
-#define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option
-#define scm_port scm_port__GONE__REPLACE_WITH__scm_t_port
-#define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_port_type
-#define scm_rng scm_rng__GONE__REPLACE_WITH__scm_t_rng
-#define scm_rstate scm_rstate__GONE__REPLACE_WITH__scm_t_rstate
-#define scm_sizet scm_sizet__GONE__REPLACE_WITH__size_t
-#define scm_srcprops scm_srcprops__GONE__REPLACE_WITH__scm_t_srcprops
-#define scm_srcprops_chunk scm_srcprops_chunk__GONE__REPLACE_WITH__scm_t_srcprops_chunk
-#define scm_struct_i_flags scm_struct_i_flags__GONE__REPLACE_WITH__scm_vtable_index_flags
-#define scm_struct_i_free scm_struct_i_free__GONE__REPLACE_WITH__scm_vtable_index_instance_finalize
-#define scm_subr_entry scm_subr_entry__GONE__REPLACE_WITH__scm_t_subr_entry
-#define scm_substring_move_left_x scm_substring_move_left_x__GONE__REPLACE_WITH__scm_substring_move_x
-#define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x
-#define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer
-#define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
+/* Deprecated declarations go here.  */
 
-#ifndef BUILDING_LIBGUILE
-#define SCM_ASYNC_TICK  SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick
+/* Return true (non-zero) if GCC version MAJ.MIN or later is being used
+ * (macro taken from glibc.)  */
+#if defined __GNUC__ && defined __GNUC_MINOR__
+# define SCM_GNUC_PREREQ(maj, min) \
+	((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min))
+#else
+# define SCM_GNUC_PREREQ(maj, min) 0
 #endif
 
+#define scm_i_jmp_buf scm_i_jmp_buf_GONE__USE_JMP_BUF_INSTEAD
 
-
-
-/* Deprecated 26-05-2011, as the GC_STUBBORN API doesn't do anything any
-   more.  */
-SCM_DEPRECATED SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr);
-SCM_DEPRECATED SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
-                                              scm_t_bits ccr, scm_t_bits cdr);
-
-
-
-SCM_DEPRECATED SCM scm_memory_alloc_key;
-SCM_DEPRECATED void scm_memory_error (const char *subr) SCM_NORETURN;
-
-
-
-SCM_DEPRECATED SCM scm_no_applicable_method;
-
-SCM_DEPRECATED SCM scm_class_boolean;
-SCM_DEPRECATED SCM scm_class_char;
-SCM_DEPRECATED SCM scm_class_pair;
-SCM_DEPRECATED SCM scm_class_procedure;
-SCM_DEPRECATED SCM scm_class_string;
-SCM_DEPRECATED SCM scm_class_symbol;
-SCM_DEPRECATED SCM scm_class_primitive_generic;
-SCM_DEPRECATED SCM scm_class_vector;
-SCM_DEPRECATED SCM scm_class_null;
-SCM_DEPRECATED SCM scm_class_real;
-SCM_DEPRECATED SCM scm_class_complex;
-SCM_DEPRECATED SCM scm_class_integer;
-SCM_DEPRECATED SCM scm_class_fraction;
-SCM_DEPRECATED SCM scm_class_unknown;
-SCM_DEPRECATED SCM scm_class_top;
-SCM_DEPRECATED SCM scm_class_object;
-SCM_DEPRECATED SCM scm_class_class;
-SCM_DEPRECATED SCM scm_class_applicable;
-SCM_DEPRECATED SCM scm_class_applicable_struct;
-SCM_DEPRECATED SCM scm_class_applicable_struct_with_setter;
-SCM_DEPRECATED SCM scm_class_generic;
-SCM_DEPRECATED SCM scm_class_generic_with_setter;
-SCM_DEPRECATED SCM scm_class_accessor;
-SCM_DEPRECATED SCM scm_class_extended_generic;
-SCM_DEPRECATED SCM scm_class_extended_generic_with_setter;
-SCM_DEPRECATED SCM scm_class_extended_accessor;
-SCM_DEPRECATED SCM scm_class_method;
-SCM_DEPRECATED SCM scm_class_accessor_method;
-SCM_DEPRECATED SCM scm_class_procedure_class;
-SCM_DEPRECATED SCM scm_class_applicable_struct_class;
-SCM_DEPRECATED SCM scm_class_number;
-SCM_DEPRECATED SCM scm_class_list;
-SCM_DEPRECATED SCM scm_class_keyword;
-SCM_DEPRECATED SCM scm_class_port;
-SCM_DEPRECATED SCM scm_class_input_output_port;
-SCM_DEPRECATED SCM scm_class_input_port;
-SCM_DEPRECATED SCM scm_class_output_port;
-SCM_DEPRECATED SCM scm_class_foreign_slot;
-SCM_DEPRECATED SCM scm_class_self;
-SCM_DEPRECATED SCM scm_class_protected;
-SCM_DEPRECATED SCM scm_class_hidden;
-SCM_DEPRECATED SCM scm_class_opaque;
-SCM_DEPRECATED SCM scm_class_read_only;
-SCM_DEPRECATED SCM scm_class_protected_hidden;
-SCM_DEPRECATED SCM scm_class_protected_opaque;
-SCM_DEPRECATED SCM scm_class_protected_read_only;
-SCM_DEPRECATED SCM scm_class_scm;
-SCM_DEPRECATED SCM scm_class_int;
-SCM_DEPRECATED SCM scm_class_float;
-SCM_DEPRECATED SCM scm_class_double;
+#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
+  do { \
+    SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
+                v, pos, FUNC_NAME); \
+  } while (0)
 
-SCM_DEPRECATED SCM *scm_smob_class;
+#ifdef SCM_SUPPORT_STATIC_ALLOCATION
+#define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr)		\
+  static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell                          \
+  c_name ## _raw_cell [2] =						\
+    {									\
+      { SCM_PACK (car), SCM_PACK (cbr) },				\
+      { SCM_PACK (ccr), SCM_PACK (cdr) }				\
+    };									\
+  static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
+#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
 
-SCM_INTERNAL void scm_init_deprecated_goops (void);
+#define scm_gc_running_p  0
 
-SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method);
-SCM_DEPRECATED SCM scm_find_method (SCM l);
-SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots);
-SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value);
-SCM_DEPRECATED SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);
-SCM_DEPRECATED SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value);
-SCM_DEPRECATED SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name);
-SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name);
+#define SCM_I_UTYPE_MAX(type)      ((type)-1)
+#define SCM_I_TYPE_MAX(type,umax)  ((type)((umax)/2))
+#define SCM_I_TYPE_MIN(type,umax)  (-((type)((umax)/2))-1)
 
-
+#define SCM_T_UINT8_MAX   UINT8_MAX
+#define SCM_T_INT8_MIN    INT8_MIN
+#define SCM_T_INT8_MAX    INT8_MAX
 
-SCM_DEPRECATED SCM scm_make_arbiter (SCM name);
-SCM_DEPRECATED SCM scm_try_arbiter (SCM arb);
-SCM_DEPRECATED SCM scm_release_arbiter (SCM arb);
+#define SCM_T_UINT16_MAX  UINT16_MAX
+#define SCM_T_INT16_MIN   INT16_MIN
+#define SCM_T_INT16_MAX   INT16_MAX
 
-
+#define SCM_T_UINT32_MAX  UINT32_MAX
+#define SCM_T_INT32_MIN   INT32_MIN
+#define SCM_T_INT32_MAX   INT32_MAX
 
-SCM_DEPRECATED SCM scm_async (SCM thunk);
-SCM_DEPRECATED SCM scm_async_mark (SCM a);
-SCM_DEPRECATED SCM scm_run_asyncs (SCM list_of_a);
+#define SCM_T_UINT64_MAX  UINT64_MAX
+#define SCM_T_INT64_MIN   INT64_MIN
+#define SCM_T_INT64_MAX   INT64_MAX
 
-
+#define SCM_T_UINTMAX_MAX UINTMAX_MAX
+#define SCM_T_INTMAX_MIN  INTMAX_MIN
+#define SCM_T_INTMAX_MAX  INTMAX_MAX
 
-SCM_DEPRECATED void scm_critical_section_start (void);
-SCM_DEPRECATED void scm_critical_section_end (void);
-SCM_DEPRECATED void scm_dynwind_critical_section (SCM mutex);
+#define SCM_T_UINTPTR_MAX UINTPTR_MAX
+#define SCM_T_INTPTR_MIN  INTPTR_MIN
+#define SCM_T_INTPTR_MAX  INTPTR_MAX
 
-#define SCM_CRITICAL_SECTION_START  scm_critical_section_start ()
-#define SCM_CRITICAL_SECTION_END    scm_critical_section_end ()
+#define SCM_HAVE_T_INT64 1 /* 0 or 1 */
+#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */
 
-
+#define SCM_HAVE_ARRAYS 1 /* always true now */
 
-SCM_DEPRECATED SCM scm_make_mutex_with_flags (SCM flags);
-SCM_DEPRECATED SCM scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout);
-SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner);
-
-
-
-SCM_DEPRECATED SCM scm_internal_cwdr (scm_t_catch_body body,
-                                      void *body_data,
-                                      scm_t_catch_handler handler,
-                                      void *handler_data,
-                                      SCM_STACKITEM *stack_start);
-SCM_DEPRECATED SCM scm_call_with_dynamic_root (SCM thunk, SCM handler);
-SCM_DEPRECATED SCM scm_dynamic_root (void);
-SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc, SCM a1,
-                                                SCM args, SCM handler);
-
-
-
-SCM_DEPRECATED SCM scm_make_dynamic_state (SCM parent);
-
-
-
-/* Deprecated 2016-11-18. Never documented. Unnecessary, since
-   array-copy! already unrolls and does it in more general cases. */
-/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS,
-   SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG,
-   scm_i_ra_set_contp, and uses thereof. */
-SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, const SCM *elts,
-                                              size_t len);
-
-
-
-SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes);
-
-
-
-SCM_DEPRECATED SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
-
-
+#ifdef __GNUC__
+#define SCM_DEPRECATED_TYPE __attribute__((__deprecated__))
+#else
+#define SCM_DEPRECATED_TYPE /*deprecated*/
+#endif
+typedef int8_t scm_t_int8 SCM_DEPRECATED_TYPE;
+typedef uint8_t scm_t_uint8 SCM_DEPRECATED_TYPE;
+typedef int16_t scm_t_int16 SCM_DEPRECATED_TYPE;
+typedef uint16_t scm_t_uint16 SCM_DEPRECATED_TYPE;
+typedef int32_t scm_t_int32 SCM_DEPRECATED_TYPE;
+typedef uint32_t scm_t_uint32 SCM_DEPRECATED_TYPE;
+typedef intmax_t scm_t_intmax SCM_DEPRECATED_TYPE;
+typedef uintmax_t scm_t_uintmax SCM_DEPRECATED_TYPE;
+typedef intptr_t scm_t_intptr SCM_DEPRECATED_TYPE;
+typedef uintptr_t scm_t_uintptr SCM_DEPRECATED_TYPE;
+typedef int64_t scm_t_int64 SCM_DEPRECATED_TYPE;
+typedef uint64_t scm_t_uint64 SCM_DEPRECATED_TYPE;
+typedef ptrdiff_t scm_t_ptrdiff SCM_DEPRECATED_TYPE;
+
+typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
+#undef SCM_DEPRECATED_TYPE
+
+SCM_DEPRECATED char* scm_find_executable (const char *name);
 
 void scm_i_init_deprecated (void);
 
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index 6ebe398f8..a85ed1972 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 2001, 2005, 2006, 2009-2012, 2016, 2018
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2005-2006,2009-2012,2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -27,13 +27,15 @@
 #include <string.h>
 #include <stdarg.h>
 
-#include "libguile/_scm.h"
-
-#include "libguile/deprecation.h"
-#include "libguile/strings.h"
-#include "libguile/ports.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "ports.h"
+#include "private-options.h"
+#include "strings.h"
+#include "threads.h"
 
-#include "libguile/private-options.h"
+#include "deprecation.h"
 
 
 
@@ -80,13 +82,8 @@ scm_c_issue_deprecation_warning (const char *msg)
          which could recurse and deadlock.  */
       if (msg)
         {
-          if (scm_gc_running_p)
-            fprintf (stderr, "%s\n", msg);
-          else
-            {
-              scm_puts (msg, scm_current_warning_port ());
-              scm_newline (scm_current_warning_port ());
-            }
+          scm_puts (msg, scm_current_warning_port ());
+          scm_newline (scm_current_warning_port ());
         }
     }
 }
@@ -179,11 +176,5 @@ scm_init_deprecation ()
       SCM_WARN_DEPRECATED = 0;
       atexit (print_deprecation_summary);
     }
-#include "libguile/deprecation.x"
+#include "deprecation.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
- */
diff --git a/libguile/deprecation.h b/libguile/deprecation.h
index 06027c694..d0230c892 100644
--- a/libguile/deprecation.h
+++ b/libguile/deprecation.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_DEPRECATION_H
 #define SCM_DEPRECATION_H
 
-/* Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2008-2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -39,9 +38,3 @@ SCM_API SCM scm_include_deprecated_features (void);
 SCM_INTERNAL void scm_init_deprecation (void);
 
 #endif  /* SCM_DEPRECATION_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 2a25e5d2e..bf7163c38 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -1,71 +1,56 @@
 /* dynl.c - dynamic linking
- *
- * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
- * 2003, 2008, 2009, 2010, 2011, 2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
 
+   Copyright 1990-2003,2008-2011,2017-2018
+     Free Software Foundation, Inc.
 
+   This file is part of Guile.
 
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-#include <alloca.h>
-#include <string.h>
 
 /* "dynl.c" dynamically link&load object files.
    Author: Aubrey Jaffer
    Modified for libguile by Marius Vollmer */
 
-#if 0 /* Disabled until we know for sure that it isn't needed */
-/* XXX - This is only here to drag in a definition of __eprintf. This
-   is needed for proper operation of dynamic linking. The real
-   solution would probably be a shared libgcc. */
-
-#undef NDEBUG
-#include <assert.h>
-
-static void
-maybe_drag_in_eprintf ()
-{
-  assert (!maybe_drag_in_eprintf);
-}
+#ifdef HAVE_CONFIG_H
+# include <config.h>
 #endif
 
-#include <stdlib.h>
+#include <alloca.h>
 #include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/libpath.h"
-#include "libguile/dynl.h"
-#include "libguile/smob.h"
-#include "libguile/keywords.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/deprecation.h"
-#include "libguile/validate.h"
-#include "libguile/dynwind.h"
-#include "libguile/foreign.h"
-#include "libguile/gc.h"
-
 #include <ltdl.h>
 
+#include "deprecation.h"
+#include "dynwind.h"
+#include "foreign.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "libpath.h"
+#include "list.h"
+#include "ports.h"
+#include "smob.h"
+#include "strings.h"
+#include "threads.h"
+
+#include "dynl.h"
+
+
 /* From the libtool manual: "Note that libltdl is not threadsafe,
    i.e. a multithreaded application has to use a mutex for libltdl.".
    Note: We initialize it as a recursive mutex below.  */
@@ -408,11 +393,5 @@ scm_init_dynamic_linking ()
 			    scm_i_pthread_mutexattr_recursive);
 
   sysdep_dynl_init ();
-#include "libguile/dynl.x"
+#include "dynl.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynl.h b/libguile/dynl.h
index e735bccfa..3178c9a75 100644
--- a/libguile/dynl.h
+++ b/libguile/dynl.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_DYNL_H
 #define SCM_DYNL_H
 
-/* Copyright (C) 1996,1998,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996,1998,2000-2001,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -37,9 +36,3 @@ SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj);
 SCM_INTERNAL void scm_init_dynamic_linking (void);
 
 #endif  /* SCM_DYNL_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 7448a9ab5..2eec7a7eb 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2012-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,24 +25,28 @@
 #endif
 
 #include <assert.h>
+#include <setjmp.h>
+
+#include "control.h"
+#include "eval.h"
+#include "fluids.h"
+#include "variable.h"
+#include "threads.h"
 
-#include "libguile/_scm.h"
-#include "libguile/control.h"
-#include "libguile/eval.h"
-#include "libguile/fluids.h"
-#include "libguile/dynstack.h"
+#include "dynstack.h"
 
 
 
 
-#define PROMPT_WORDS 5
+#define PROMPT_WORDS 6
 #define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
-#define PROMPT_FP(top) ((scm_t_ptrdiff) ((top)[1]))
+#define PROMPT_FP(top) ((ptrdiff_t) ((top)[1]))
 #define SET_PROMPT_FP(top, fp) do { top[1] = (scm_t_bits)(fp); } while (0)
-#define PROMPT_SP(top) ((scm_t_ptrdiff) ((top)[2]))
+#define PROMPT_SP(top) ((ptrdiff_t) ((top)[2]))
 #define SET_PROMPT_SP(top, sp) do { top[2] = (scm_t_bits)(sp); } while (0)
-#define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3]))
-#define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
+#define PROMPT_VRA(top) ((uint32_t *) ((top)[3]))
+#define PROMPT_MRA(top) ((uint8_t *) ((top)[4]))
+#define PROMPT_JMPBUF(top) ((jmp_buf *) ((top)[5]))
 
 #define WINDER_WORDS 2
 #define WINDER_PROC(top) ((scm_t_guard) ((top)[0]))
@@ -192,8 +197,8 @@ void
 scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
                           scm_t_dynstack_prompt_flags flags,
                           SCM key,
-                          scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset,
-                          scm_t_uint32 *ip, scm_i_jmp_buf *registers)
+                          ptrdiff_t fp_offset, ptrdiff_t sp_offset,
+                          uint32_t *vra, uint8_t *mra, jmp_buf *registers)
 {
   scm_t_bits *words;
 
@@ -202,8 +207,9 @@ scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
   words[0] = SCM_UNPACK (key);
   words[1] = (scm_t_bits) fp_offset;
   words[2] = (scm_t_bits) sp_offset;
-  words[3] = (scm_t_bits) ip;
-  words[4] = (scm_t_bits) registers;
+  words[3] = (scm_t_bits) vra;
+  words[4] = (scm_t_bits) mra;
+  words[5] = (scm_t_bits) registers;
 }
 
 void
@@ -290,7 +296,7 @@ scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits *item)
 }
 
 void
-scm_dynstack_relocate_prompts (scm_t_dynstack *dynstack, scm_t_ptrdiff base)
+scm_dynstack_relocate_prompts (scm_t_dynstack *dynstack, ptrdiff_t base)
 {
   scm_t_bits *walk;
 
@@ -495,8 +501,8 @@ scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch)
 scm_t_bits*
 scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
                           scm_t_dynstack_prompt_flags *flags,
-                          scm_t_ptrdiff *fp_offset, scm_t_ptrdiff *sp_offset,
-                          scm_t_uint32 **ip, scm_i_jmp_buf **registers)
+                          ptrdiff_t *fp_offset, ptrdiff_t *sp_offset,
+                          uint32_t **vra, uint8_t **mra, jmp_buf **registers)
 {
   scm_t_bits *walk;
 
@@ -514,8 +520,10 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
             *fp_offset = PROMPT_FP (walk);
           if (sp_offset)
             *sp_offset = PROMPT_SP (walk);
-          if (ip)
-            *ip = PROMPT_IP (walk);
+          if (vra)
+            *vra = PROMPT_VRA (walk);
+          if (mra)
+            *mra = PROMPT_MRA (walk);
           if (registers)
             *registers = PROMPT_JMPBUF (walk);
           return walk;
@@ -576,8 +584,8 @@ scm_dynstack_find_old_fluid_value (scm_t_dynstack *dynstack, SCM fluid,
 
 void
 scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item,
-                          scm_t_ptrdiff base_fp_offset,
-                          scm_i_jmp_buf *registers)
+                          ptrdiff_t base_fp_offset,
+                          jmp_buf *registers)
 {
   scm_t_bits tag = SCM_DYNSTACK_TAG (item);
 
@@ -589,7 +597,8 @@ scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item,
                             PROMPT_KEY (item),
                             PROMPT_FP (item) + base_fp_offset,
                             PROMPT_SP (item) + base_fp_offset,
-                            PROMPT_IP (item),
+                            PROMPT_VRA (item),
+                            PROMPT_MRA (item),
                             registers);
 }
 
@@ -664,9 +673,3 @@ scm_dynstack_unwind_dynamic_state (scm_t_dynstack *dynstack,
   clear_scm_t_bits (words, len);
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index bd34d25a8..4c32a0943 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -1,33 +1,35 @@
-/* classes: h_files */
-
 #ifndef SCM_DYNSTACK_H
 #define SCM_DYNSTACK_H
 
-/* Copyright (C) 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2012-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <setjmp.h>
+#include <signal.h>
+
+#include "libguile/scm.h"
 
 
 
-typedef struct
+typedef struct scm_dynstack
 {
   scm_t_bits *base;
   scm_t_bits *top;
@@ -156,10 +158,11 @@ SCM_INTERNAL void scm_dynstack_push_dynamic_state (scm_t_dynstack *, SCM,
 SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
                                             scm_t_dynstack_prompt_flags,
                                             SCM key,
-                                            scm_t_ptrdiff fp_offset,
-                                            scm_t_ptrdiff sp_offset,
-                                            scm_t_uint32 *ip,
-                                            scm_i_jmp_buf *registers);
+                                            ptrdiff_t fp_offset,
+                                            ptrdiff_t sp_offset,
+                                            uint32_t *vra,
+                                            uint8_t *mra,
+                                            jmp_buf *registers);
 SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
                                              SCM enter, SCM leave);
 
@@ -196,25 +199,20 @@ SCM_INTERNAL void scm_dynstack_unwind_dynamic_state
 
 SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
                                                    scm_t_dynstack_prompt_flags *,
-                                                   scm_t_ptrdiff *,
-                                                   scm_t_ptrdiff *,
-                                                   scm_t_uint32 **,
-                                                   scm_i_jmp_buf **);
+                                                   ptrdiff_t *,
+                                                   ptrdiff_t *,
+                                                   uint32_t **,
+                                                   uint8_t **,
+                                                   jmp_buf **);
 
 SCM_INTERNAL SCM scm_dynstack_find_old_fluid_value (scm_t_dynstack *,
                                                     SCM, size_t, SCM);
 
 SCM_INTERNAL void scm_dynstack_relocate_prompts (scm_t_dynstack *,
-                                                 scm_t_ptrdiff);
+                                                 ptrdiff_t);
 
 SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,
-                                            scm_t_ptrdiff, scm_i_jmp_buf *);
+                                            ptrdiff_t, jmp_buf *);
 
 
 #endif  /* SCM_DYNSTACK_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index 4a0b0dd2b..85bf5aabc 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -1,23 +1,21 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
+/* Copyright 1995-1996,1998-2001,2003-2004,2006,2008,2010-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -25,22 +23,23 @@
 
 #include <assert.h>
 
-#include "libguile/_scm.h"
-#include "libguile/dynstack.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-
-#include "libguile/dynwind.h"
+#include "boolean.h"
+#include "dynstack.h"
+#include "eval.h"
+#include "pairs.h"
+#include "ports.h"
+#include "threads.h"
+#include "variable.h"
 
+#include "dynwind.h"
 
-
 
 SCM
 scm_dynamic_wind (SCM in_guard, SCM thunk, SCM out_guard)
 #define FUNC_NAME "dynamic-wind"
 {
   SCM ans;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), out_guard,
 	      SCM_ARG3, FUNC_NAME);
@@ -61,7 +60,7 @@ scm_dynamic_wind (SCM in_guard, SCM thunk, SCM out_guard)
 void
 scm_dynwind_begin (scm_t_dynwind_flags flags)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   scm_dynstack_push_frame (&thread->dynstack, flags);
 }
@@ -76,7 +75,7 @@ void
 scm_dynwind_unwind_handler (void (*proc) (void *), void *data,
 			    scm_t_wind_flags flags)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_t_dynstack *dynstack = &thread->dynstack;
 
   scm_dynstack_push_unwinder (dynstack, flags, proc, data);
@@ -86,7 +85,7 @@ void
 scm_dynwind_rewind_handler (void (*proc) (void *), void *data,
 			    scm_t_wind_flags flags)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_t_dynstack *dynstack = &thread->dynstack;
 
   scm_dynstack_push_rewinder (dynstack, 0, proc, data);
@@ -134,11 +133,5 @@ scm_swap_bindings (SCM vars, SCM vals)
 void
 scm_init_dynwind ()
 {
-#include "libguile/dynwind.x"
+#include "dynwind.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/dynwind.h b/libguile/dynwind.h
index 9ade05c0b..099fee7af 100644
--- a/libguile/dynwind.h
+++ b/libguile/dynwind.h
@@ -1,29 +1,27 @@
-/* classes: h_files */
-
 #ifndef SCM_DYNWIND_H
 #define SCM_DYNWIND_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008, 2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2000,2003-2004,2006,2008,2011-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/dynstack.h"
 
 
@@ -59,9 +57,3 @@ SCM_API void scm_dynwind_free (void *mem);
 
 
 #endif  /* SCM_DYNWIND_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/eq.c b/libguile/eq.c
index 4680de7d8..627d6f09b 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
@@ -22,34 +23,33 @@
 #endif
 
 #include <math.h>
+#include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/array-map.h"
-#include "libguile/stackchk.h"
-#include "libguile/strorder.h"
-#include "libguile/async.h"
-#include "libguile/smob.h"
-#include "libguile/arrays.h"
-#include "libguile/vectors.h"
-#include "libguile/hashtab.h"
-#include "libguile/bytevectors.h"
-#include "libguile/syntax.h"
-
-#include "libguile/struct.h"
-#include "libguile/goops.h"
-
-#include "libguile/validate.h"
-#include "libguile/eq.h"
+#include "array-map.h"
+#include "async.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "eval.h"
+#include "foreign.h"
+#include "generalized-arrays.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "pairs.h"
+#include "private-options.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "strorder.h"
+#include "struct.h"
+#include "syntax.h"
+#include "vectors.h"
+
+#include "eq.h"
 
-#include "libguile/private-options.h"
 
 
 
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-
 static SCM scm_i_eq_p (SCM x, SCM y, SCM rest);
 SCM_DEFINE (scm_i_eq_p, "eq?", 0, 2, 1,
             (SCM x, SCM y, SCM rest),
@@ -156,6 +156,25 @@ scm_i_fraction_equalp (SCM x, SCM y)
 				  SCM_FRACTION_DENOMINATOR (y))));
 }
 
+int
+scm_i_heap_numbers_equal_p (SCM x, SCM y)
+{
+  if (SCM_IMP (x)) abort();
+  switch (SCM_TYP16 (x))
+    {
+    case scm_tc16_big:
+      return scm_is_true (scm_bigequal (x, y));
+    case scm_tc16_real:
+      return scm_is_true (scm_real_equalp (x, y));
+    case scm_tc16_complex:
+      return scm_is_true (scm_complex_equalp (x, y));
+    case scm_tc16_fraction:
+      return scm_is_true (scm_i_fraction_equalp (x, y));
+    default:
+      abort ();
+    }
+}
+
 static SCM scm_i_eqv_p (SCM x, SCM y, SCM rest);
 #include <stdio.h>
 SCM_DEFINE (scm_i_eqv_p, "eqv?", 0, 2, 1,
@@ -210,17 +229,7 @@ SCM scm_eqv_p (SCM x, SCM y)
     default:
       break;
     case scm_tc7_number:
-      switch SCM_TYP16 (x)
-        {
-        case scm_tc16_big:
-          return scm_bigequal (x, y);
-        case scm_tc16_real:
-          return scm_real_equalp (x, y);
-        case scm_tc16_complex:
-          return scm_complex_equalp (x, y);
-	case scm_tc16_fraction:
-          return scm_i_fraction_equalp (x, y);
-        }
+      return scm_from_bool (scm_i_heap_numbers_equal_p (x, y));
     }
   return SCM_BOOL_F;
 }
@@ -396,12 +405,6 @@ scm_equal_p (SCM x, SCM y)
 void
 scm_init_eq ()
 {
-#include "libguile/eq.x"
+#include "eq.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/eq.h b/libguile/eq.h
index c09d6670b..90d93f9f8 100644
--- a/libguile/eq.h
+++ b/libguile/eq.h
@@ -1,33 +1,32 @@
-/* classes: h_files */
-
 #ifndef SCM_EQ_H
 #define SCM_EQ_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
-/* scm_is_eq is defined in tags.h for some reason. */
+/* scm_is_eq is defined in scm.h for some reason. */
 
 /* An older spelling for scm_is_eq. */
 #define SCM_EQ_P(x,y) (scm_is_eq (x, y))
@@ -40,9 +39,3 @@ SCM_API SCM scm_equal_p (SCM x, SCM y);
 SCM_INTERNAL void scm_init_eq (void);
 
 #endif  /* SCM_EQ_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/error.c b/libguile/error.c
index 7a8657846..aa45aec27 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-1998, 2000, 2001, 2004, 2006, 2010, 2012-2016,
- *   2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2004,2006,2010,2012-2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,28 +24,31 @@
 #  include <config.h>
 #endif
 
-#include <stdlib.h>
-#include <stdio.h>
 #include <errno.h>
-
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/pairs.h"
-#include "libguile/strings.h"
-#include "libguile/throw.h"
-
-#include "libguile/validate.h"
-#include "libguile/error.h"
-
-#ifdef HAVE_STRING_H
+#include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
-#endif
 #include <unistd.h>
 
 /* For Windows... */
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
+
+#include "async.h"
+#include "dynwind.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "strings.h"
+#include "symbols.h"
+#include "throw.h"
+
+#include "error.h"
+
+
 
 
 /* {Errors and Exceptional Conditions}
@@ -84,13 +87,6 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
 	    "it will usually be @code{#f}.")
 #define FUNC_NAME s_scm_error_scm
 {
-  if (scm_gc_running_p)
-    {
-      /* The error occured during GC --- abort */
-      fprintf (stderr, "Guile: error during GC.\n"),
-      abort ();
-    }
-
   scm_ithrow (key, scm_list_4 (subr, message, args, data), 1);
   
   /* No return, but just in case: */
@@ -302,13 +298,7 @@ scm_misc_error (const char *subr, const char *message, SCM args)
 void
 scm_init_error ()
 {
-#include "libguile/cpp-E.c"
-#include "libguile/error.x"
+#include "cpp-E.c"
+#include "error.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/error.h b/libguile/error.h
index 6985dbc4a..cd134e650 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_ERROR_H
 #define SCM_ERROR_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2002,2006,2008,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 SCM_API SCM scm_system_error_key;
@@ -35,9 +34,12 @@ SCM_API SCM scm_misc_error_key;
 
 
 
+/* Snarfing for docs may override SCM_ASSERT; see snarf.h.  */
+#ifndef SCM_ASSERT
 #define SCM_ASSERT(_cond, _arg, _pos, _subr)			\
   do { if (SCM_UNLIKELY (!(_cond)))                             \
       scm_wrong_type_arg (_subr, _pos, _arg); } while (0)
+#endif
 #define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg)			\
   do { if (SCM_UNLIKELY (!(_cond)))                                     \
       scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg);  } while (0)
@@ -70,10 +72,58 @@ SCM_API void scm_misc_error (const char *subr, const char *message,
 			     SCM args) SCM_NORETURN;
 SCM_INTERNAL void scm_init_error (void);
 
-#endif  /* SCM_ERROR_H */
+
+
+#ifndef SCM_MAGIC_SNARFER
+/* Let these macros pass through if
+   we are snarfing;  thus we can tell the
+   difference between the use of an actual
+   number vs. the use of one of these macros --
+   actual numbers in SCM_VALIDATE_* and SCM_ASSERT
+   constructs must match the formal argument name,
+   but using SCM_ARG* avoids the test */
+
+#define SCM_ARGn 		0
+#define SCM_ARG1 		1
+#define SCM_ARG2 		2
+#define SCM_ARG3 		3
+#define SCM_ARG4 		4
+#define SCM_ARG5 		5
+#define SCM_ARG6 		6
+#define SCM_ARG7 		7
+
+#endif /* SCM_MAGIC_SNARFER */
+
+
 
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#define SCM_MAKE_VALIDATE(pos, var, pred) \
+  do { \
+    SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \
+  } while (0)
+
+#define SCM_I_MAKE_VALIDATE_MSG2(pos, var, pred, msg) \
+  do { \
+    SCM_ASSERT_TYPE (pred (var), var, pos, FUNC_NAME, msg); \
+  } while (0)
+
+#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_ ## pred, msg)
+
+#define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0)
+
+#define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0)
+
+#define SCM_SYSERROR_MSG(str, args, val) \
+  do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0)
+
+#define SCM_MISC_ERROR(str, args) \
+  do { scm_misc_error (FUNC_NAME, str, args); } while (0)
+
+#define SCM_WRONG_NUM_ARGS() \
+  do { scm_error_num_args_subr (FUNC_NAME); } while (0)
+
+#define SCM_WRONG_TYPE_ARG(pos, obj) \
+  do { scm_wrong_type_arg (FUNC_NAME, pos, obj); } while (0)
+
+
+#endif  /* SCM_ERROR_H */
diff --git a/libguile/eval.c b/libguile/eval.c
index a1e7f5b70..db6d3a5e9 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995-2018 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,46 +26,51 @@
 #include <alloca.h>
 #include <stdarg.h>
 
-#include "libguile/__scm.h"
-
-#include "libguile/_scm.h"
-#include "libguile/alist.h"
-#include "libguile/async.h"
-#include "libguile/continuations.h"
-#include "libguile/control.h"
-#include "libguile/debug.h"
-#include "libguile/deprecation.h"
-#include "libguile/dynwind.h"
-#include "libguile/eq.h"
-#include "libguile/expand.h"
-#include "libguile/feature.h"
-#include "libguile/goops.h"
-#include "libguile/hash.h"
-#include "libguile/hashtab.h"
-#include "libguile/list.h"
-#include "libguile/macros.h"
-#include "libguile/memoize.h"
-#include "libguile/modules.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/procprop.h"
-#include "libguile/programs.h"
-#include "libguile/smob.h"
-#include "libguile/srcprop.h"
-#include "libguile/stackchk.h"
-#include "libguile/strings.h"
-#include "libguile/threads.h"
-#include "libguile/throw.h"
-#include "libguile/validate.h"
-#include "libguile/values.h"
-#include "libguile/vectors.h"
-#include "libguile/vm.h"
-
-#include "libguile/eval.h"
-#include "libguile/private-options.h"
+#include "alist.h"
+#include "async.h"
+#include "boolean.h"
+#include "continuations.h"
+#include "control.h"
+#include "debug.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "expand.h"
+#include "feature.h"
+#include "frames.h"
+#include "fluids.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "list.h"
+#include "macros.h"
+#include "memoize.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "print.h"
+#include "private-options.h"
+#include "procprop.h"
+#include "programs.h"
+#include "smob.h"
+#include "srcprop.h"
+#include "stackchk.h"
+#include "strings.h"
+#include "symbols.h"
+#include "threads.h"
+#include "throw.h"
+#include "values.h"
+#include "variable.h"
+#include "vectors.h"
+#include "vm.h"
+
+#include "eval.h"
 
-
 
+
 
 /* We have three levels of EVAL here:
 
@@ -219,13 +225,12 @@ static void error_unrecognized_keyword (SCM proc, SCM kw)
 static SCM
 truncate_values (SCM x)
 {
-  if (SCM_LIKELY (!SCM_VALUESP (x)))
+  if (SCM_LIKELY (!scm_is_values (x)))
     return x;
   else
     {
-      SCM l = scm_struct_ref (x, SCM_INUM0);
-      if (SCM_LIKELY (scm_is_pair (l)))
-        return scm_car (l);
+      if (SCM_LIKELY (scm_i_nvalues (x) > 0))
+        return scm_i_value_ref (x, 0);
       else
         {
           scm_ithrow (scm_from_utf8_symbol ("vm-run"),
@@ -363,8 +368,13 @@ eval (SCM x, SCM env)
         /* `proc' is the consumer.  */
         proc = EVAL1 (CDR (mx), env);
         v = scm_call_0 (producer);
-        if (SCM_VALUESP (v))
-          args = scm_struct_ref (v, SCM_INUM0);
+        if (scm_is_values (v))
+          {
+            size_t i = scm_i_nvalues (v);
+            args = SCM_EOL;
+            while (i--)
+              args = scm_cons (scm_i_value_ref (v, i), args);
+          }
         else
           args = scm_list_1 (v);
         goto apply_proc;
@@ -426,40 +436,41 @@ eval (SCM x, SCM env)
 
     case SCM_M_CALL_WITH_PROMPT:
       {
-        struct scm_vm *vp;
+        scm_thread *t;
         SCM k, handler, res;
-        scm_i_jmp_buf registers;
-        const void *prev_cookie;
-        scm_t_ptrdiff saved_stack_depth;
+        jmp_buf registers;
+        jmp_buf *prev_registers;
+        ptrdiff_t saved_stack_depth;
+        uint8_t *mra = NULL;
 
         k = EVAL1 (CAR (mx), env);
         handler = EVAL1 (CDDR (mx), env);
-        vp = scm_the_vm ();
+        t = SCM_I_CURRENT_THREAD;
 
-        saved_stack_depth = vp->stack_top - vp->sp;
+        saved_stack_depth = t->vm.stack_top - t->vm.sp;
 
         /* Push the prompt onto the dynamic stack. */
-        scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+        scm_dynstack_push_prompt (&t->dynstack,
                                   SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
                                   k,
-                                  vp->stack_top - vp->fp,
+                                  t->vm.stack_top - t->vm.fp,
                                   saved_stack_depth,
-                                  vp->ip,
+                                  t->vm.ip, mra,
                                   &registers);
 
-        prev_cookie = vp->resumable_prompt_cookie;
-        if (SCM_I_SETJMP (registers))
+        prev_registers = t->vm.registers;
+        if (setjmp (registers))
           {
             /* The prompt exited nonlocally. */
-            vp->resumable_prompt_cookie = prev_cookie;
+            t->vm.registers = prev_registers;
             scm_gc_after_nonlocal_exit ();
             proc = handler;
-            args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
+            args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth);
             goto apply_proc;
           }
         
         res = scm_call_0 (eval (CADR (mx), env));
-        scm_dynstack_pop (&SCM_I_CURRENT_THREAD->dynstack);
+        scm_dynstack_pop (&t->dynstack);
         return res;
       }
 
@@ -967,12 +978,5 @@ scm_init_eval ()
   var_primitive_eval = scm_define (SCM_SUBR_NAME (primitive_eval),
                                    primitive_eval);
 
-#include "libguile/eval.x"
+#include "eval.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
-
diff --git a/libguile/eval.h b/libguile/eval.h
index 9e5f65467..b25e76f94 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -1,30 +1,26 @@
-/* classes: h_files */
-
 #ifndef SCM_EVAL_H
 #define SCM_EVAL_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2004,2008-2012,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
 
-#include "libguile/__scm.h"
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
 #include "libguile/struct.h"
 #include "libguile/memoize.h"
@@ -94,9 +90,3 @@ SCM_INTERNAL void scm_init_eval (void);
 
 
 #endif  /* SCM_EVAL_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 33205a2ca..4ac434343 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998-2003,2006,2008-2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -22,13 +23,16 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/fluids.h"
-#include "libguile/modules.h"
+#include "gsubr.h"
+#include "eval.h"
+#include "list.h"
+#include "fluids.h"
+#include "modules.h"
+#include "pairs.h"
+#include "symbols.h"
+#include "variable.h"
 
-#include "libguile/validate.h"
-#include "libguile/evalext.h"
+#include "evalext.h"
 
 SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
             (SCM sym, SCM module),
@@ -106,11 +110,5 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 void 
 scm_init_evalext ()
 {
-#include "libguile/evalext.x"
+#include "evalext.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/evalext.h b/libguile/evalext.h
index 7718ec621..6c028486e 100644
--- a/libguile/evalext.h
+++ b/libguile/evalext.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_EVALEXT_H
 #define SCM_EVALEXT_H
 
-/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998-2000,2003,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -32,9 +31,3 @@ SCM_API SCM scm_self_evaluating_p (SCM obj);
 SCM_INTERNAL void scm_init_evalext (void);
 
 #endif  /* SCM_EVALEXT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/expand.c b/libguile/expand.c
index f00e66420..dd6eab0fe 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995-2014, 2016, 2018 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2014,2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -22,20 +23,27 @@
 #  include <config.h>
 #endif
 
-#include "libguile/__scm.h"
-#include "libguile/_scm.h"
-#include "libguile/continuations.h"
-#include "libguile/eq.h"
-#include "libguile/list.h"
-#include "libguile/macros.h"
-#include "libguile/expand.h"
-#include "libguile/modules.h"
-#include "libguile/srcprop.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/strings.h"
-#include "libguile/throw.h"
-#include "libguile/validate.h"
+#include "alist.h"
+#include "boolean.h"
+#include "continuations.h"
+#include "eq.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "list.h"
+#include "macros.h"
+#include "modules.h"
+#include "pairs.h"
+#include "ports.h"
+#include "print.h"
+#include "srcprop.h"
+#include "strings.h"
+#include "symbols.h"
+#include "throw.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "expand.h"
 
 
 
@@ -1647,11 +1655,5 @@ scm_init_expand ()
 
   scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list));
   
-#include "libguile/expand.x"
+#include "expand.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/expand.h b/libguile/expand.h
index 9c2732d87..86054a5f4 100644
--- a/libguile/expand.h
+++ b/libguile/expand.h
@@ -1,30 +1,27 @@
-/* classes: h_files */
-
 #ifndef SCM_EXPAND_H
 #define SCM_EXPAND_H
 
-/* Copyright (C) 2010, 2011, 2013, 2014
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010, 2011, 2013, 2014, 2018    Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/struct.h"
 
 
 
@@ -343,9 +340,3 @@ SCM_INTERNAL void scm_init_expand (void);
 
 
 #endif  /* SCM_EXPAND_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/extensions.c b/libguile/extensions.c
index ab108930d..a094159d4 100644
--- a/libguile/extensions.c
+++ b/libguile/extensions.c
@@ -1,23 +1,21 @@
-/* extensions.c - registering and loading extensions.
- *
- * Copyright (C) 2001, 2002, 2004, 2006, 2009-2011, 2018
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
@@ -25,13 +23,15 @@
 
 #include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/strings.h"
-#include "libguile/gc.h"
-#include "libguile/dynl.h"
-#include "libguile/dynwind.h"
+#include "dynl.h"
+#include "dynwind.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "strings.h"
+#include "threads.h"
+
+#include "extensions.h"
 
-#include "libguile/extensions.h"
 
 typedef struct extension_t
 {
@@ -173,11 +173,5 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
 void
 scm_init_extensions ()
 {
-#include "libguile/extensions.x"
+#include "extensions.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/extensions.h b/libguile/extensions.h
index 765f9bee1..fc690a48b 100644
--- a/libguile/extensions.h
+++ b/libguile/extensions.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_EXTENSIONS_H
 #define SCM_EXTENSIONS_H
 
-/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -38,9 +37,3 @@ SCM_API SCM scm_load_extension (SCM lib, SCM init);
 SCM_INTERNAL void scm_init_extensions (void);
 
 #endif  /* SCM_EXTENSIONS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/fdes-finalizers.c b/libguile/fdes-finalizers.c
index fd4689e13..4b3fced02 100644
--- a/libguile/fdes-finalizers.c
+++ b/libguile/fdes-finalizers.c
@@ -1,30 +1,40 @@
-/* Copyright (C) 2016  Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/hashtab.h"
-#include "libguile/numbers.h"
-#include "libguile/fdes-finalizers.h"
+#include "boolean.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "threads.h"
+#include "version.h"
+
+#include "fdes-finalizers.h"
+
 
 
 
@@ -114,7 +124,7 @@ scm_run_fdes_finalizers (int fd)
 static void
 scm_init_fdes_finalizers (void)
 {
-#include "libguile/fdes-finalizers.x"
+#include "fdes-finalizers.x"
 }
 
 void
diff --git a/libguile/fdes-finalizers.h b/libguile/fdes-finalizers.h
index cadbb0404..dbbe8f943 100644
--- a/libguile/fdes-finalizers.h
+++ b/libguile/fdes-finalizers.h
@@ -1,27 +1,28 @@
 #ifndef SCM_FDES_FINALIZERS_H
 #define SCM_FDES_FINALIZERS_H
 
-/* Copyright (C) 2016  Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
diff --git a/libguile/feature.c b/libguile/feature.c
index 114d875a9..709bc0465 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -1,38 +1,41 @@
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- *   2006, 2007, 2009, 2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2004,2006-2007,2009,2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#ifdef HAVE_STRING_H
 #include <string.h>
-#endif
 
-#include "libguile/_scm.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/fluids.h"
+#include "fluids.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "pairs.h"
+#include "strings.h"
+#include "symbols.h"
+#include "variable.h"
+
+#include "feature.h"
 
-#include "libguile/feature.h"
 
 
 
@@ -106,9 +109,6 @@ scm_init_feature()
 #ifndef _Windows
   scm_add_feature("system");
 #endif
-#ifdef vms
-  scm_add_feature(s_ed);
-#endif
 #ifndef GO32
   scm_add_feature("char-ready?");
 #endif
@@ -116,11 +116,5 @@ scm_init_feature()
   scm_add_feature ("threads");
 #endif
 
-#include "libguile/feature.x"
+#include "feature.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/feature.h b/libguile/feature.h
index 467f9ed74..b5c40a3fa 100644
--- a/libguile/feature.h
+++ b/libguile/feature.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_FEATURE_H
 #define SCM_FEATURE_H
 
-/* Copyright (C) 1995, 1996, 1999, 2000, 2001, 2006, 2007, 2008,
- *   2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1999-2001,2006-2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API void scm_add_feature (const char* str);
 SCM_API SCM scm_program_arguments (void);
@@ -35,9 +33,3 @@ SCM_INTERNAL SCM scm_program_arguments_fluid;
 SCM_INTERNAL void scm_init_feature (void);
 
 #endif  /* SCM_FEATURE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 3cf474c05..4f7115397 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1996-2002, 2004, 2006, 2009-2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-2002,2004,2006,2009-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -32,37 +32,26 @@
 #endif
 
 #include <alloca.h>
+#include <dirent.h>
 #include <dirname.h>
-
-#include <stdlib.h>
-#include <stdio.h>
 #include <errno.h>
+#include <fcntl.h>
+#include <full-read.h>
+#include <full-write.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <unistd.h>
 
-#include "libguile/_scm.h"
-#include "libguile/smob.h"
-#include "libguile/fdes-finalizers.h"
-#include "libguile/feature.h"
-#include "libguile/fports.h"
-#include "libguile/strings.h"
-#include "libguile/iselect.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-
-#include "libguile/validate.h"
-#include "libguile/filesys.h"
-#include "libguile/load.h"	/* for scm_i_mirror_backslashes */
+#ifdef HAVE_DIRECT_H
+#include <direct.h>
+#endif
 
-
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
 
-#ifdef HAVE_DIRECT_H
-#include <direct.h>
-#endif
-
 #ifdef TIME_WITH_SYS_TIME
 # include <sys/time.h>
 # include <time.h>
@@ -74,8 +63,6 @@
 # endif
 #endif
 
-#include <unistd.h>
-
 #ifdef LIBC_H_WITH_UNISTD_H
 #include <libc.h>
 #endif
@@ -84,29 +71,48 @@
 #include <string.h>
 #endif
 
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-
 #ifdef HAVE_PWD_H
 #include <pwd.h>
 #endif
 
-#include <dirent.h>
-
-#define NAMLEN(dirent)  strlen ((dirent)->d_name)
-
 #ifdef HAVE_SYS_SENDFILE_H
 # include <sys/sendfile.h>
 #endif
 
+#include "async.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "fdes-finalizers.h"
+#include "feature.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "iselect.h"
+#include "list.h"
+#include "load.h"	/* for scm_i_mirror_backslashes */
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "posix.h"
+#include "smob.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "vectors.h"
+
+#include "filesys.h"
+
+
+
+
+#define NAMLEN(dirent)  strlen ((dirent)->d_name)
+
 /* Glibc's `sendfile' function.  */
 #define sendfile_or_sendfile64			\
   CHOOSE_LARGEFILE (sendfile, sendfile64)
 
-#include <full-read.h>
-#include <full-write.h>
-
 
 
 
@@ -1956,11 +1962,5 @@ scm_init_filesys ()
 
   scm_dot_string = scm_from_utf8_string (".");
 
-#include "libguile/filesys.x"
+#include "filesys.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/filesys.h b/libguile/filesys.h
index fc66e40b2..f870ee434 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_FILESYS_H
 #define SCM_FILESYS_H
 
-/* Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
- *   2010, 2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,1997-2001,2006,2008-2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
 
 
 
@@ -35,6 +33,9 @@ SCM_API scm_t_bits scm_tc16_dir;
 #define SCM_DIRP(x) (SCM_HAS_TYP16 (x, scm_tc16_dir))
 #define SCM_DIR_OPEN_P(x) (SCM_SMOB_FLAGS (x) & SCM_DIR_FLAG_OPEN)
 
+#define SCM_VALIDATE_DIR(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port")
+
 
 
 SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
@@ -73,9 +74,3 @@ SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
 SCM_INTERNAL void scm_init_filesys (void);
 
 #endif  /* SCM_FILESYS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/finalizers.c b/libguile/finalizers.c
index c5d69e8e3..3d1126f5c 100644
--- a/libguile/finalizers.c
+++ b/libguile/finalizers.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2012-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,16 +24,21 @@
 # include <config.h>
 #endif
 
-#include <unistd.h>
+#include <errno.h>
 #include <fcntl.h>
-
 #include <full-write.h>
+#include <stdio.h>
+#include <unistd.h>
+
+#include "async.h"
+#include "bdw-gc.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "init.h"
+#include "threads.h"
+
+#include "finalizers.h"
 
-#include "libguile/bdw-gc.h"
-#include "libguile/_scm.h"
-#include "libguile/finalizers.h"
-#include "libguile/gc.h"
-#include "libguile/threads.h"
 
 
 
@@ -149,7 +155,7 @@ run_finalizers_async_thunk (void)
 static void
 queue_finalizer_async (void)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   /* Could be that the current thread is is NULL when we're allocating
      in threads.c:guilify_self_1.  In that case, rely on the
diff --git a/libguile/finalizers.h b/libguile/finalizers.h
index 27b2cbf82..44bafb22e 100644
--- a/libguile/finalizers.h
+++ b/libguile/finalizers.h
@@ -1,27 +1,28 @@
 #ifndef SCM_FINALIZERS_H
 #define SCM_FINALIZERS_H
 
-/* Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2012, 2013, 2014, 2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
diff --git a/libguile/fluids.c b/libguile/fluids.c
index c3dd1c9ea..f62693338 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010,
- *    2011, 2012, 2013, 2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-1997,2000-2001,2004,2006-2013,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -24,18 +24,25 @@
 #include <stdio.h>
 #include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/atomics-internal.h"
-#include "libguile/cache-internal.h"
-#include "libguile/print.h"
-#include "libguile/dynwind.h"
-#include "libguile/fluids.h"
-#include "libguile/alist.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/deprecation.h"
-#include "libguile/validate.h"
-#include "libguile/bdw-gc.h"
+#include "alist.h"
+#include "atomics-internal.h"
+#include "bdw-gc.h"
+#include "cache-internal.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "list.h"
+#include "pairs.h"
+#include "ports.h"
+#include "print.h"
+#include "threads.h"
+#include "variable.h"
+#include "weak-table.h"
+
+#include "fluids.h"
+
 
 /* A dynamic state associates fluids with values.  There are two
    representations of a dynamic state in Guile: the active
@@ -363,6 +370,17 @@ fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
   return val;
 }
 
+SCM
+scm_i_fluid_ref (scm_thread *thread, SCM fluid)
+{
+  SCM ret = fluid_ref (thread->dynamic_state, fluid);
+
+  if (SCM_UNBNDP (ret))
+    scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
+
+  return ret;
+}
+
 SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, 
 	    (SCM fluid),
 	    "Return the value associated with @var{fluid} in the current\n"
@@ -370,12 +388,8 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
 	    "its default value.")
 #define FUNC_NAME s_scm_fluid_ref
 {
-  SCM ret;
   SCM_VALIDATE_FLUID (1, fluid);
-  ret = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
-  if (SCM_UNBNDP (ret))
-    scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
-  return ret;
+  return scm_i_fluid_ref (SCM_I_CURRENT_THREAD, fluid);
 }
 #undef FUNC_NAME
 
@@ -502,7 +516,7 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 {
   SCM ans;
   long flen, vlen, i;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
   SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
@@ -539,7 +553,7 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
 #define FUNC_NAME "scm_c_with_fluid"
 {
   SCM ans;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   scm_dynstack_push_fluid (&thread->dynstack, fluid, value,
                            thread->dynamic_state);
@@ -610,7 +624,7 @@ SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
 	    "and return the previous current dynamic state object.")
 #define FUNC_NAME s_scm_set_current_dynamic_state
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   SCM old = scm_current_dynamic_state ();
   SCM_ASSERT (is_dynamic_state (state), state, SCM_ARG1, FUNC_NAME);
   restore_dynamic_state (get_dynamic_state (state), t->dynamic_state);
@@ -673,11 +687,5 @@ SCM_DEFINE (scm_with_dynamic_state, "with-dynamic-state", 2, 0, 0,
 void
 scm_init_fluids ()
 {
-#include "libguile/fluids.x"
+#include "fluids.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 7997ad4d3..ffcb48931 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996,2000-2001,2006,2008-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
 #include "libguile/vectors.h"
 
 
@@ -39,6 +38,9 @@
 
 #define SCM_FLUID_P(x)          (SCM_HAS_TYP7 (x, scm_tc7_fluid))
 
+#define SCM_VALIDATE_FLUID(pos, fluid) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, fluid, scm_is_fluid, "fluid")
+
 #ifdef BUILDING_LIBGUILE
 # include <libguile/cache-internal.h>
 
@@ -64,6 +66,8 @@ SCM_API SCM scm_fluid_set_x (SCM fluid, SCM value);
 SCM_API SCM scm_fluid_unset_x (SCM fluid);
 SCM_API SCM scm_fluid_bound_p (SCM fluid);
 
+SCM_INTERNAL SCM scm_i_fluid_ref (scm_thread *thread, SCM fluid);
+
 SCM_INTERNAL void scm_swap_fluid (SCM fluid, SCM value_box,
                                   scm_t_dynamic_state *dynamic_state);
 
@@ -93,9 +97,3 @@ SCM_INTERNAL void scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state
 SCM_INTERNAL void scm_init_fluids (void);
 
 #endif  /* SCM_FLUIDS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/foreign-object.c b/libguile/foreign-object.c
index 830f73f80..21dc2c007 100644
--- a/libguile/foreign-object.c
+++ b/libguile/foreign-object.c
@@ -1,30 +1,43 @@
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/goops.h"
-#include "libguile/foreign-object.h"
+#include "eval.h"
+#include "extensions.h"
+#include "finalizers.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "procs.h"
+#include "threads.h"
+#include "variable.h"
+#include "version.h"
+
+#include "foreign-object.h"
 
 
 
@@ -58,6 +71,7 @@ scm_make_foreign_object_type (SCM name, SCM slot_names,
 void
 scm_assert_foreign_object_type (SCM type, SCM val)
 {
+  /* FIXME: Add fast path for when type == struct vtable */
   if (!SCM_IS_A_P (val, type))
     scm_error (scm_arg_type_key, NULL, "Wrong type (expecting ~A): ~S",
                scm_list_2 (scm_class_name (type), val), scm_list_1 (val));
@@ -103,21 +117,16 @@ scm_make_foreign_object_n (SCM type, size_t n, void *vals[])
 #define FUNC_NAME "make-foreign-object"
 {
   SCM obj;
-  SCM layout;
   size_t i;
-  const char *layout_chars;
 
   SCM_VALIDATE_VTABLE (SCM_ARG1, type);
 
-  layout = SCM_VTABLE_LAYOUT (type);
-
-  if (scm_i_symbol_length (layout) / 2 < n)
+  if (SCM_VTABLE_SIZE (type) < n)
     scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
 
-  layout_chars = scm_i_symbol_chars (layout);
   for (i = 0; i < n; i++)
-    if (layout_chars[i * 2] != 'u')
-      scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+    if (!SCM_VTABLE_FIELD_IS_UNBOXED (type, i))
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, type, "foreign object type");
 
   obj = scm_c_make_structv (type, 0, 0, NULL);
 
@@ -132,16 +141,13 @@ scm_t_bits
 scm_foreign_object_unsigned_ref (SCM obj, size_t n)
 #define FUNC_NAME "foreign-object-ref"
 {
-  SCM layout;
-
   SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
   
-  layout = SCM_STRUCT_LAYOUT (obj);
-  if (scm_i_symbol_length (layout) / 2 < n)
+  if (SCM_STRUCT_SIZE (obj) <= n)
     scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
 
-  if (scm_i_symbol_ref (layout, n * 2) != 'u')
-    scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+  if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
+    scm_wrong_type_arg_msg (FUNC_NAME, 0, scm_from_size_t (n), "unboxed field");
 
   return SCM_STRUCT_DATA_REF (obj, n);
 }
@@ -151,16 +157,13 @@ void
 scm_foreign_object_unsigned_set_x (SCM obj, size_t n, scm_t_bits val)
 #define FUNC_NAME "foreign-object-set!"
 {
-  SCM layout;
-
   SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
   
-  layout = SCM_STRUCT_LAYOUT (obj);
-  if (scm_i_symbol_length (layout) / 2 < n)
+  if (SCM_STRUCT_SIZE (obj) <= n)
     scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
 
-  if (scm_i_symbol_ref (layout, n * 2) != 'u')
-    scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+  if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
+    scm_wrong_type_arg_msg (FUNC_NAME, 0, scm_from_size_t (n), "unboxed field");
 
   SCM_STRUCT_DATA_SET (obj, n, val);
 }
diff --git a/libguile/foreign-object.h b/libguile/foreign-object.h
index 806b7eddb..d6ca94512 100644
--- a/libguile/foreign-object.h
+++ b/libguile/foreign-object.h
@@ -1,27 +1,27 @@
 #ifndef SCM_FOREIGN_OBJECT_H
 #define SCM_FOREIGN_OBJECT_H
 
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/print.h"
 
 
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 927c46fad..1368cc9da 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1,41 +1,65 @@
-/* Copyright (C) 2010-2016  Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010-2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include <ffi.h>
-
-#include <alloca.h>
 #include <alignof.h>
-#include <string.h>
+#include <alloca.h>
 #include <assert.h>
 #include <errno.h>
+#include <string.h>
+
+#include <ffi.h>
 
-#include "libguile/_scm.h"
-#include "libguile/bytevectors.h"
-#include "libguile/instructions.h"
-#include "libguile/threads.h"
-#include "libguile/foreign.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "eval.h"
+#include "extensions.h"
+#include "finalizers.h"
+#include "gsubr.h"
+#include "instructions.h"
+#include "intrinsics.h"
+#include "keywords.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "stacks.h"
+#include "symbols.h"
+#include "threads.h"
+#include "weak-table.h"
+#include "version.h"
+
+#include "foreign.h"
 
 
 
+/* Return the first integer greater than or equal to LEN such that
+   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
+#define ROUND_UP(len, align)					\
+  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
+
 SCM_SYMBOL (sym_void, "void");
 SCM_SYMBOL (sym_float, "float");
 SCM_SYMBOL (sym_double, "double");
@@ -116,7 +140,7 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
 #define FUNC_NAME s_scm_make_pointer
 {
   void *c_finalizer;
-  scm_t_uintptr c_address;
+  uintptr_t c_address;
 
   c_address = scm_to_uintptr_t (address);
   if (SCM_UNBNDP (finalizer))
@@ -166,7 +190,7 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
 {
   SCM_VALIDATE_POINTER (1, pointer);
 
-  return scm_from_uintptr_t ((scm_t_uintptr) SCM_POINTER_VALUE (pointer));
+  return scm_from_uintptr_t ((uintptr_t) SCM_POINTER_VALUE (pointer));
 }
 #undef FUNC_NAME
 
@@ -214,7 +238,7 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
 #define FUNC_NAME s_scm_pointer_to_bytevector
 {
   SCM ret;
-  scm_t_int8 *ptr;
+  int8_t *ptr;
   size_t boffset, blen;
   scm_t_array_element_type btype;
 
@@ -447,21 +471,21 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
         case SCM_FOREIGN_TYPE_DOUBLE:
           return scm_from_size_t (alignof_type (double));
         case SCM_FOREIGN_TYPE_UINT8:
-          return scm_from_size_t (alignof_type (scm_t_uint8));
+          return scm_from_size_t (alignof_type (uint8_t));
         case SCM_FOREIGN_TYPE_INT8:
-          return scm_from_size_t (alignof_type (scm_t_int8));
+          return scm_from_size_t (alignof_type (int8_t));
         case SCM_FOREIGN_TYPE_UINT16:
-          return scm_from_size_t (alignof_type (scm_t_uint16));
+          return scm_from_size_t (alignof_type (uint16_t));
         case SCM_FOREIGN_TYPE_INT16:
-          return scm_from_size_t (alignof_type (scm_t_int16));
+          return scm_from_size_t (alignof_type (int16_t));
         case SCM_FOREIGN_TYPE_UINT32:
-          return scm_from_size_t (alignof_type (scm_t_uint32));
+          return scm_from_size_t (alignof_type (uint32_t));
         case SCM_FOREIGN_TYPE_INT32:
-          return scm_from_size_t (alignof_type (scm_t_int32));
+          return scm_from_size_t (alignof_type (int32_t));
         case SCM_FOREIGN_TYPE_UINT64:
-          return scm_from_size_t (alignof_type (scm_t_uint64));
+          return scm_from_size_t (alignof_type (uint64_t));
         case SCM_FOREIGN_TYPE_INT64:
-          return scm_from_size_t (alignof_type (scm_t_int64));
+          return scm_from_size_t (alignof_type (int64_t));
         default:
           scm_wrong_type_arg (FUNC_NAME, 1, type);
         }
@@ -511,21 +535,21 @@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0, 0, (SCM type),
         case SCM_FOREIGN_TYPE_DOUBLE:
           return scm_from_size_t (sizeof (double));
         case SCM_FOREIGN_TYPE_UINT8:
-          return scm_from_size_t (sizeof (scm_t_uint8));
+          return scm_from_size_t (sizeof (uint8_t));
         case SCM_FOREIGN_TYPE_INT8:
-          return scm_from_size_t (sizeof (scm_t_int8));
+          return scm_from_size_t (sizeof (int8_t));
         case SCM_FOREIGN_TYPE_UINT16:
-          return scm_from_size_t (sizeof (scm_t_uint16));
+          return scm_from_size_t (sizeof (uint16_t));
         case SCM_FOREIGN_TYPE_INT16:
-          return scm_from_size_t (sizeof (scm_t_int16));
+          return scm_from_size_t (sizeof (int16_t));
         case SCM_FOREIGN_TYPE_UINT32:
-          return scm_from_size_t (sizeof (scm_t_uint32));
+          return scm_from_size_t (sizeof (uint32_t));
         case SCM_FOREIGN_TYPE_INT32:
-          return scm_from_size_t (sizeof (scm_t_int32));
+          return scm_from_size_t (sizeof (int32_t));
         case SCM_FOREIGN_TYPE_UINT64:
-          return scm_from_size_t (sizeof (scm_t_uint64));
+          return scm_from_size_t (sizeof (uint64_t));
         case SCM_FOREIGN_TYPE_INT64:
-          return scm_from_size_t (sizeof (scm_t_int64));
+          return scm_from_size_t (sizeof (int64_t));
         default:
           scm_wrong_type_arg (FUNC_NAME, 1, type);
         }
@@ -802,29 +826,28 @@ SCM_DEFINE (scm_i_pointer_to_procedure, "pointer->procedure", 3, 0, 1,
 
 
 
-static const scm_t_uint32 *
+static const uint32_t *
 get_foreign_stub_code (unsigned int nargs, int with_errno)
 {
   size_t i;
   size_t code_len = with_errno ? 4 : 5;
-  scm_t_uint32 *code;
-
-  code = scm_gc_malloc_pointerless (code_len * sizeof (scm_t_uint32),
-                                    "foreign code");
+  uint32_t *ret, *code;
 
   if (nargs >= (1 << 24) + 1)
     scm_misc_error ("make-foreign-function", "too many arguments: ~a",
                     scm_list_1 (scm_from_uint (nargs)));
 
+  ret = scm_i_alloc_primitive_code_with_instrumentation (code_len, &code);
+
   i = 0;
   code[i++] = SCM_PACK_OP_24 (assert_nargs_ee, nargs + 1);
   code[i++] = SCM_PACK_OP_12_12 (foreign_call, 0, 1);
   code[i++] = SCM_PACK_OP_24 (handle_interrupts, 0);
   if (!with_errno)
-    code[i++] = SCM_PACK_OP_24 (reset_frame, 2);
+    code[i++] = SCM_PACK_OP_24 (reset_frame, 1);
   code[i++] = SCM_PACK_OP_24 (return_values, 0);
 
-  return code;
+  return ret;
 }
 
 static SCM
@@ -848,7 +871,7 @@ cif_to_procedure (SCM cif, SCM func_ptr, int with_errno)
 /* Set *LOC to the foreign representation of X with TYPE.  */
 static void
 unpack (const ffi_type *type, void *loc, SCM x, int return_value_p)
-#define FUNC_NAME "scm_i_foreign_call"
+#define FUNC_NAME "foreign-call"
 {
   switch (type->type)
     {
@@ -866,43 +889,43 @@ unpack (const ffi_type *type, void *loc, SCM x, int return_value_p)
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_uint8 (x);
       else
-	*(scm_t_uint8 *) loc = scm_to_uint8 (x);
+	*(uint8_t *) loc = scm_to_uint8 (x);
       break;
     case FFI_TYPE_SINT8:
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_int8 (x);
       else
-	*(scm_t_int8 *) loc = scm_to_int8 (x);
+	*(int8_t *) loc = scm_to_int8 (x);
       break;
     case FFI_TYPE_UINT16:
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_uint16 (x);
       else
-	*(scm_t_uint16 *) loc = scm_to_uint16 (x);
+	*(uint16_t *) loc = scm_to_uint16 (x);
       break;
     case FFI_TYPE_SINT16:
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_int16 (x);
       else
-	*(scm_t_int16 *) loc = scm_to_int16 (x);
+	*(int16_t *) loc = scm_to_int16 (x);
       break;
     case FFI_TYPE_UINT32:
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_uint32 (x);
       else
-	*(scm_t_uint32 *) loc = scm_to_uint32 (x);
+	*(uint32_t *) loc = scm_to_uint32 (x);
       break;
     case FFI_TYPE_SINT32:
       if (return_value_p)
 	*(ffi_arg *) loc = scm_to_int32 (x);
       else
-	*(scm_t_int32 *) loc = scm_to_int32 (x);
+	*(int32_t *) loc = scm_to_int32 (x);
       break;
     case FFI_TYPE_UINT64:
-      *(scm_t_uint64 *) loc = scm_to_uint64 (x);
+      *(uint64_t *) loc = scm_to_uint64 (x);
       break;
     case FFI_TYPE_SINT64:
-      *(scm_t_int64 *) loc = scm_to_int64 (x);
+      *(int64_t *) loc = scm_to_int64 (x);
       break;
     case FFI_TYPE_STRUCT:
       SCM_VALIDATE_POINTER (1, x);
@@ -945,38 +968,38 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
 
     case FFI_TYPE_UINT8:
       if (return_value_p)
-	return scm_from_uint8 ((scm_t_uint8) *(ffi_arg *) loc);
+	return scm_from_uint8 ((uint8_t) *(ffi_arg *) loc);
       else
-	return scm_from_uint8 (* (scm_t_uint8 *) loc);
+	return scm_from_uint8 (* (uint8_t *) loc);
     case FFI_TYPE_SINT8:
       if (return_value_p)
-	return scm_from_int8 ((scm_t_int8) *(ffi_arg *) loc);
+	return scm_from_int8 ((int8_t) *(ffi_arg *) loc);
       else
-	return scm_from_int8 (* (scm_t_int8 *) loc);
+	return scm_from_int8 (* (int8_t *) loc);
     case FFI_TYPE_UINT16:
       if (return_value_p)
-	return scm_from_uint16 ((scm_t_uint16) *(ffi_arg *) loc);
+	return scm_from_uint16 ((uint16_t) *(ffi_arg *) loc);
       else
-	return scm_from_uint16 (* (scm_t_uint16 *) loc);
+	return scm_from_uint16 (* (uint16_t *) loc);
     case FFI_TYPE_SINT16:
       if (return_value_p)
-	return scm_from_int16 ((scm_t_int16) *(ffi_arg *) loc);
+	return scm_from_int16 ((int16_t) *(ffi_arg *) loc);
       else
-	return scm_from_int16 (* (scm_t_int16 *) loc);
+	return scm_from_int16 (* (int16_t *) loc);
     case FFI_TYPE_UINT32:
       if (return_value_p)
-	return scm_from_uint32 ((scm_t_uint32) *(ffi_arg *) loc);
+	return scm_from_uint32 ((uint32_t) *(ffi_arg *) loc);
       else
-	return scm_from_uint32 (* (scm_t_uint32 *) loc);
+	return scm_from_uint32 (* (uint32_t *) loc);
     case FFI_TYPE_SINT32:
       if (return_value_p)
-	return scm_from_int32 ((scm_t_int32) *(ffi_arg *) loc);
+	return scm_from_int32 ((int32_t) *(ffi_arg *) loc);
       else
-	return scm_from_int32 (* (scm_t_int32 *) loc);
+	return scm_from_int32 (* (int32_t *) loc);
     case FFI_TYPE_UINT64:
-      return scm_from_uint64 (*(scm_t_uint64 *) loc);
+      return scm_from_uint64 (*(uint64_t *) loc);
     case FFI_TYPE_SINT64:
-      return scm_from_int64 (*(scm_t_int64 *) loc);
+      return scm_from_int64 (*(int64_t *) loc);
 
     case FFI_TYPE_STRUCT:
       {
@@ -992,6 +1015,8 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
 }
 
 
+#define MAX(A, B) ((A) >= (B) ? (A) : (B))
+
 SCM
 scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
                     const union scm_vm_stack_element *argv)
@@ -1000,12 +1025,12 @@ scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
      objtable. */
   ffi_cif *cif;
   void (*func) (void);
-  scm_t_uint8 *data;
+  uint8_t *data;
   void *rvalue;
   void **args;
   unsigned i;
   size_t arg_size;
-  scm_t_ptrdiff off;
+  ptrdiff_t off;
 
   cif = SCM_POINTER_VALUE (cif_scm);
   func = SCM_POINTER_VALUE (pointer_scm);
@@ -1021,18 +1046,18 @@ scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
 
   /* Space for argument values, followed by return value.  */
   data = alloca (arg_size + cif->rtype->size
-		 + max (sizeof (void *), cif->rtype->alignment));
+		 + MAX (sizeof (void *), cif->rtype->alignment));
 
   /* Unpack ARGV to native values, setting ARGV pointers.  */
   for (i = 0, off = 0;
        i < cif->nargs;
-       off = (scm_t_uint8 *) args[i] - data + cif->arg_types[i]->size,
+       off = (uint8_t *) args[i] - data + cif->arg_types[i]->size,
 	 i++)
     {
       /* Suitably align the storage area for argument I.  */
-      args[i] = (void *) ROUND_UP ((scm_t_uintptr) data + off,
+      args[i] = (void *) ROUND_UP ((uintptr_t) data + off,
 				   cif->arg_types[i]->alignment);
-      assert ((scm_t_uintptr) args[i] % cif->arg_types[i]->alignment == 0);
+      assert ((uintptr_t) args[i] % cif->arg_types[i]->alignment == 0);
       unpack (cif->arg_types[i], args[i], argv[cif->nargs - i - 1].as_scm, 0);
     }
 
@@ -1040,8 +1065,8 @@ scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
      `armv5tel-*-linux-gnueabi', the return value has to be at least
      word-aligned, even if its type doesn't have any alignment requirement as is
      the case with `char'.  */
-  rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off,
-			      max (sizeof (void *), cif->rtype->alignment));
+  rvalue = (void *) ROUND_UP ((uintptr_t) data + off,
+			      MAX (sizeof (void *), cif->rtype->alignment));
 
   /* off we go! */
   errno = 0;
@@ -1142,7 +1167,7 @@ static void
 scm_init_foreign (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/foreign.x"
+#include "foreign.x"
 #endif
   scm_define (sym_void, scm_from_uint8 (SCM_FOREIGN_TYPE_VOID));
   scm_define (sym_float, scm_from_uint8 (SCM_FOREIGN_TYPE_FLOAT));
@@ -1246,7 +1271,7 @@ scm_init_foreign (void)
 #elif SCM_SIZEOF_SCM_T_PTRDIFF == 4
 	      scm_from_uint8 (SCM_FOREIGN_TYPE_INT32)
 #else
-# error unsupported sizeof (scm_t_ptrdiff)
+# error unsupported sizeof (ptrdiff_t)
 #endif
 	      );
 
@@ -1256,7 +1281,7 @@ scm_init_foreign (void)
 #elif SCM_SIZEOF_INTPTR_T == 4
 	      scm_from_uint8 (SCM_FOREIGN_TYPE_INT32)
 #else
-# error unsupported sizeof (scm_t_intptr)
+# error unsupported sizeof (intptr_t)
 #endif
 	      );
 
@@ -1266,7 +1291,7 @@ scm_init_foreign (void)
 #elif SCM_SIZEOF_UINTPTR_T == 4
 	      scm_from_uint8 (SCM_FOREIGN_TYPE_UINT32)
 #else
-# error unsupported sizeof (scm_t_uintptr)
+# error unsupported sizeof (uintptr_t)
 #endif
 	      );
 
@@ -1283,9 +1308,3 @@ scm_register_foreign (void)
                             NULL);
   pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/foreign.h b/libguile/foreign.h
index a0c09cc0f..41f26b335 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -1,25 +1,27 @@
 #ifndef SCM_FOREIGN_H
 #define SCM_FOREIGN_H
 
-/* Copyright (C) 2010, 2011, 2012, 2013, 2016  Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010-2013,2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#include "libguile/gc.h"
+#include "libguile/snarf.h"
 
 /* A "foreign pointer" is a wrapped C pointer.  It is represented by a
    cell whose second word is a pointer.  The first word has the
@@ -54,6 +56,9 @@ typedef void (*scm_t_pointer_finalizer) (void *);
 #define SCM_POINTER_VALUE(x)			\
   ((void *) SCM_CELL_WORD_1 (x))
 
+#define SCM_IMMUTABLE_POINTER(c_name, ptr)		\
+  SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
+
 SCM_API void *scm_to_pointer (SCM pointer);
 SCM_API SCM scm_from_pointer (void *, scm_t_pointer_finalizer);
 
@@ -93,8 +98,6 @@ SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM length, SCM encoding);
    arguments.
  */
 
-union scm_vm_stack_element;
-
 SCM_API SCM scm_pointer_to_procedure (SCM return_type, SCM func_ptr,
 				      SCM arg_types);
 SCM_API SCM scm_pointer_to_procedure_with_errno (SCM return_type, SCM func_ptr,
diff --git a/libguile/fports.c b/libguile/fports.c
index 5de08d319..b9b16f3b7 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-2004, 2006-2015, 2017, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2004,2006-2015,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -44,20 +44,33 @@
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <sys/select.h>
-
 #include <full-write.h>
 
-#include "libguile/_scm.h"
-#include "libguile/fdes-finalizers.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/gc.h"
-#include "libguile/posix.h"
-#include "libguile/dynwind.h"
-#include "libguile/hashtab.h"
+#include "async.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "extensions.h"
+#include "fdes-finalizers.h"
+#include "filesys.h"
+#include "fluids.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "posix.h"
+#include "read.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "variable.h"
+#include "version.h"
+
+#include "fports.h"
 
-#include "libguile/fports.h"
-#include "libguile/ports-internal.h"
 
 #if SIZEOF_OFF_T == SIZEOF_INT
 #define OFF_T_MAX  INT_MAX
@@ -720,7 +733,7 @@ scm_init_fports_keywords ()
 static void
 scm_init_ice_9_fports (void)
 {
-#include "libguile/fports.x"
+#include "fports.x"
 }
 
 void
@@ -746,9 +759,3 @@ scm_init_fports ()
   scm_c_define ("%file-port-name-canonicalization",
                 sys_file_port_name_canonicalization);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/fports.h b/libguile/fports.h
index e397fcc59..fd5b86d96 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -1,31 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995-2001, 2006, 2008, 2009, 2011, 2012,
- *   2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2006,2008-2009,2011-2012,2017-2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
+
+
+#include "libguile/gc.h"
 #include "libguile/ports.h"
 
 
@@ -51,6 +48,11 @@ SCM_API scm_t_port_type *scm_file_port_type;
 #define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
 #define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
 
+#define SCM_VALIDATE_FPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port")
+#define SCM_VALIDATE_OPFPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port")
+
 
 SCM_API void scm_evict_ports (int fd);
 SCM_INTERNAL int scm_i_mode_to_open_flags (SCM mode, int *is_binary,
@@ -89,9 +91,3 @@ SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name,
 #endif /* BUILDING_LIBGUILE */
 
 #endif  /* SCM_FPORTS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/frames.c b/libguile/frames.c
index 11d4f12ee..0bb40579c 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -1,31 +1,47 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
 #include <stdlib.h>
 #include <string.h>
-#include "_scm.h"
-#include "frames.h"
+
+#include "boolean.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "instructions.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "symbols.h"
+#include "threads.h"
+#include "variable.h"
+#include "version.h"
 #include "vm.h"
 
+#include "frames.h"
+
+
 SCM
 scm_c_make_frame (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
 {
@@ -315,6 +331,33 @@ scm_frame_local_set_x (SCM frame, SCM index, SCM val, SCM representation)
 }
 #undef FUNC_NAME
 
+static const char s_scm_frame_return_values[] = "frame-return-values";
+static SCM
+scm_frame_return_values (SCM frame)
+#define FUNC_NAME s_scm_frame_return_values
+{
+  const uint32_t *ip;
+  union scm_vm_stack_element *fp, *sp;
+  SCM vals = SCM_EOL;
+  size_t n;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  ip = SCM_VM_FRAME_IP (frame);
+  fp = SCM_VM_FRAME_FP (frame);
+  sp = SCM_VM_FRAME_SP (frame);
+
+  if ((*ip & 0xff) != scm_op_return_values)
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, frame, "not a return frame");
+
+  n = SCM_FRAME_NUM_LOCALS (fp, sp);
+  while (n--)
+    vals = scm_cons (SCM_FRAME_LOCAL (fp, n), vals);
+
+  return vals;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0,
 	    (SCM frame),
 	    "Return the frame pointer for @var{frame}.")
@@ -343,7 +386,7 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_from_uintptr_t ((scm_t_uintptr) SCM_VM_FRAME_IP (frame));
+  return scm_from_uintptr_t ((uintptr_t) SCM_VM_FRAME_IP (frame));
 }
 #undef FUNC_NAME
 
@@ -353,8 +396,8 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
 #define FUNC_NAME s_scm_frame_return_address
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
-  return scm_from_uintptr_t ((scm_t_uintptr) (SCM_FRAME_RETURN_ADDRESS
-                                              (SCM_VM_FRAME_FP (frame))));
+  return scm_from_uintptr_t ((uintptr_t) (SCM_FRAME_VIRTUAL_RETURN_ADDRESS
+                                          (SCM_VM_FRAME_FP (frame))));
 }
 #undef FUNC_NAME
 
@@ -366,7 +409,7 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
   SCM_VALIDATE_VM_FRAME (1, frame);
   /* fixme: munge fp if holder is a continuation */
   return scm_from_uintptr_t
-    ((scm_t_uintptr)
+    ((uintptr_t)
      SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame)));
 }
 #undef FUNC_NAME
@@ -391,7 +434,7 @@ scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
   new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
   frame->fp_offset = stack_top - new_fp;
   frame->sp_offset = stack_top - new_sp;
-  frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
+  frame->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (this_fp);
 
   if (scm_i_vm_is_boot_continuation_code (frame->ip))
     goto again;
@@ -429,13 +472,15 @@ scm_init_frames_builtins (void *unused)
                       (scm_t_subr) scm_frame_local_ref);
   scm_c_define_gsubr (s_scm_frame_local_set_x, 4, 0, 0,
                       (scm_t_subr) scm_frame_local_set_x);
+  scm_c_define_gsubr (s_scm_frame_return_values, 1, 0, 0,
+                      (scm_t_subr) scm_frame_return_values);
 }
 
 void
 scm_init_frames (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/frames.x"
+#include "frames.x"
 #endif
 
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
@@ -443,9 +488,3 @@ scm_init_frames (void)
                             scm_init_frames_builtins,
                             NULL);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/frames.h b/libguile/frames.h
index ef2db3df5..76055f573 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -1,25 +1,26 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
- * * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_FRAMES_H_
 #define _SCM_FRAMES_H_
 
-#include <libguile.h>
+#include <libguile/gc.h>
 #include "programs.h"
 
 
@@ -38,25 +39,28 @@
    Stack frame layout
    ------------------
 
-   | ...              |
-   +==================+ <- fp + 2 = SCM_FRAME_PREVIOUS_SP (fp)
-   | Dynamic link     |
-   +------------------+
-   | Return address   |
-   +==================+ <- fp
-   | Local 0          |
-   +------------------+
-   | Local 1          |
-   +------------------+
-   | ...              |
-   +------------------+
-   | Local N-1        |
-   \------------------/ <- sp
+   | ...                          |
+   +==============================+ <- fp + 3 = SCM_FRAME_PREVIOUS_SP (fp)
+   | Dynamic link                 |
+   +------------------------------+
+   | Virtual return address (vRA) |
+   +------------------------------+
+   | Machine return address (mRA) |
+   +==============================+ <- fp
+   | Local 0                      |
+   +------------------------------+
+   | Local 1                      |
+   +------------------------------+
+   | ...                          |
+   +------------------------------+
+   | Local N-1                    |
+   \------------------------------/ <- sp
 
    The stack grows down.
 
    The calling convention is that a caller prepares a stack frame
-   consisting of the saved FP and the return address, followed by the
+   consisting of the saved FP, the saved virtual return address, and the
+   saved machine return address of the calling function, followed by the
    procedure and then the arguments to the call, in order.  Thus in the
    beginning of a call, the procedure being called is in slot 0, the
    first argument is in slot 1, and the SP points to the last argument.
@@ -69,14 +73,10 @@
    popping the stack pointer during the call's extent.
 
    When a program returns, it returns its values in the slots starting
-   from local 1, as if the values were arguments to a tail call.  We
-   start from 1 instead of 0 for the convenience of the "values" builtin
-   function, which can just leave its arguments in place.
-
-   The callee resets the stack pointer to point to the last value.  In
-   this way the caller knows how many values there are: it's the number
-   of words between the stack pointer and the slot at which the caller
-   placed the procedure.
+   from local 0.  The callee resets the stack pointer to point to the
+   last value.  In this way the caller knows how many values there are:
+   it's the number of words between the stack pointer and the slot at
+   which the caller placed the procedure.
 
    After checking that the number of values returned is appropriate, the
    caller shuffles the values around (if needed), and resets the stack
@@ -88,23 +88,26 @@
 /* Each element on the stack occupies the same amount of space.  */
 union scm_vm_stack_element
 {
-  scm_t_uintptr as_uint;
-  scm_t_uint32 *as_ip;
+  uintptr_t as_uint;
+  uint32_t *as_vcode;
+  uint8_t *as_mcode;
   SCM as_scm;
   double as_f64;
-  scm_t_uint64 as_u64;
-  scm_t_int64 as_s64;
+  uint64_t as_u64;
+  int64_t as_s64;
 
   /* For GC purposes.  */
   void *as_ptr;
   scm_t_bits as_bits;
 };
 
-#define SCM_FRAME_PREVIOUS_SP(fp)	((fp) + 2)
-#define SCM_FRAME_RETURN_ADDRESS(fp)    ((fp)[0].as_ip)
-#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra) ((fp)[0].as_ip = (ra))
-#define SCM_FRAME_DYNAMIC_LINK(fp)      ((fp) + (fp)[1].as_uint)
-#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) ((fp)[1].as_uint = ((dl) - (fp)))
+#define SCM_FRAME_PREVIOUS_SP(fp)	((fp) + 3)
+#define SCM_FRAME_MACHINE_RETURN_ADDRESS(fp)         ((fp)[0].as_mcode)
+#define SCM_FRAME_SET_MACHINE_RETURN_ADDRESS(fp, ra) ((fp)[0].as_mcode = (ra))
+#define SCM_FRAME_VIRTUAL_RETURN_ADDRESS(fp)         ((fp)[1].as_vcode)
+#define SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS(fp, ra) ((fp)[1].as_vcode = (ra))
+#define SCM_FRAME_DYNAMIC_LINK(fp)      ((fp) + (fp)[2].as_uint)
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) ((fp)[2].as_uint = ((dl) - (fp)))
 #define SCM_FRAME_SLOT(fp,i)            ((fp) - (i) - 1)
 #define SCM_FRAME_LOCAL(fp,i)           (SCM_FRAME_SLOT (fp, i)->as_scm)
 #define SCM_FRAME_NUM_LOCALS(fp, sp)    ((fp) - (sp))
@@ -119,9 +122,9 @@ union scm_vm_stack_element
 struct scm_frame 
 {
   void *stack_holder;
-  scm_t_ptrdiff fp_offset;
-  scm_t_ptrdiff sp_offset;
-  scm_t_uint32 *ip;
+  ptrdiff_t fp_offset;
+  ptrdiff_t sp_offset;
+  uint32_t *ip;
 };
 
 enum scm_vm_frame_kind
@@ -172,9 +175,3 @@ SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
 SCM_INTERNAL void scm_init_frames (void);
 
 #endif /* _SCM_FRAMES_H_ */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gc-inline.h b/libguile/gc-inline.h
index fcbe5a54e..a1932d65a 100644
--- a/libguile/gc-inline.h
+++ b/libguile/gc-inline.h
@@ -1,33 +1,31 @@
-/* classes: h_files */
-
 #ifndef SCM_GC_INLINE_H
 #define SCM_GC_INLINE_H
 
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2004,2006-2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Much of this file was copied from gc_inline.h, from the BDW
  * collector.  Its copyright notice is:
  *
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
- * Copyright (c) 2005 Hewlett-Packard Development Company, L.P.
+ * Copyright 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright 2005 Hewlett-Packard Development Company, L.P.
  *
  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
@@ -41,8 +39,6 @@
 
 
 
-#include "libguile/__scm.h"
-
 #include "libguile/gc.h"
 #include "libguile/bdw-gc.h"
 #include "libguile/threads.h"
@@ -51,17 +47,6 @@
 
 
 
-#define SCM_INLINE_GC_GRANULE_WORDS 2
-#define SCM_INLINE_GC_GRANULE_BYTES \
-  (sizeof(void *) * SCM_INLINE_GC_GRANULE_WORDS)
-
-/* A freelist set contains SCM_INLINE_GC_FREELIST_COUNT pointers to
-   singly linked lists of objects of different sizes, the ith one
-   containing objects i + 1 granules in size.  This setting of
-   SCM_INLINE_GC_FREELIST_COUNT will hold freelists for allocations of
-   up to 256 bytes.  */
-#define SCM_INLINE_GC_FREELIST_COUNT (256U / SCM_INLINE_GC_GRANULE_BYTES)
-
 static inline size_t
 scm_inline_gc_bytes_to_freelist_index (size_t bytes)
 {
@@ -103,7 +88,7 @@ scm_inline_gc_alloc (void **freelist, size_t idx, scm_inline_gc_kind kind)
 }
 
 static inline void *
-scm_inline_gc_malloc_pointerless (scm_i_thread *thread, size_t bytes)
+scm_inline_gc_malloc_pointerless (scm_thread *thread, size_t bytes)
 {
   size_t idx = scm_inline_gc_bytes_to_freelist_index (bytes);
 
@@ -115,7 +100,7 @@ scm_inline_gc_malloc_pointerless (scm_i_thread *thread, size_t bytes)
 }
 
 static inline void *
-scm_inline_gc_malloc (scm_i_thread *thread, size_t bytes)
+scm_inline_gc_malloc (scm_thread *thread, size_t bytes)
 {
   size_t idx = scm_inline_gc_bytes_to_freelist_index (bytes);
 
@@ -127,13 +112,13 @@ scm_inline_gc_malloc (scm_i_thread *thread, size_t bytes)
 }
 
 static inline void *
-scm_inline_gc_malloc_words (scm_i_thread *thread, size_t words)
+scm_inline_gc_malloc_words (scm_thread *thread, size_t words)
 {
   return scm_inline_gc_malloc (thread, words * sizeof (void *));
 }
 
 static inline SCM
-scm_inline_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cdr)
+scm_inline_cell (scm_thread *thread, scm_t_bits car, scm_t_bits cdr)
 {
   SCM cell = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, 2));
   
@@ -144,7 +129,7 @@ scm_inline_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cdr)
 }
 
 static inline SCM
-scm_inline_double_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cbr,
+scm_inline_double_cell (scm_thread *thread, scm_t_bits car, scm_t_bits cbr,
                            scm_t_bits ccr, scm_t_bits cdr)
 {
   SCM cell = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, 4));
@@ -158,7 +143,7 @@ scm_inline_double_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cbr,
 }
 
 static inline SCM
-scm_inline_words (scm_i_thread *thread, scm_t_bits car, scm_t_uint32 n_words)
+scm_inline_words (scm_thread *thread, scm_t_bits car, uint32_t n_words)
 {
   SCM obj = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n_words));
   
@@ -168,16 +153,10 @@ scm_inline_words (scm_i_thread *thread, scm_t_bits car, scm_t_uint32 n_words)
 }
 
 static inline SCM
-scm_inline_cons (scm_i_thread *thread, SCM x, SCM y)
+scm_inline_cons (scm_thread *thread, SCM x, SCM y)
 {
   return scm_inline_cell (thread, SCM_UNPACK (x), SCM_UNPACK (y));
 }
 
 
 #endif  /* SCM_GC_INLINE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 586bf173d..0992bb0d3 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -1,22 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013,
- *   2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2004,2006,2008-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -28,35 +27,26 @@
 #include <errno.h>
 #include <string.h>
 #include <stdlib.h>
+#include <unistd.h>
 
-#ifdef __ia64__
-#include <ucontext.h>
-extern unsigned long * __libc_ia64_register_backing_store_base;
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/stime.h"
-#include "libguile/stackchk.h"
-#include "libguile/struct.h"
-#include "libguile/smob.h"
-#include "libguile/arrays.h"
-#include "libguile/async.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/hashtab.h"
-#include "libguile/tags.h"
-
-#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/gc.h"
-
+#include "arrays.h"
+#include "async.h"
 #ifdef GUILE_DEBUG_MALLOC
-#include "libguile/debug-malloc.h"
+#include "debug-malloc.h"
 #endif
+#include "deprecation.h"
+#include "eval.h"
+#include "hashtab.h"
+#include "ports.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "stime.h"
+#include "strings.h"
+#include "struct.h"
+#include "vectors.h"
+
+#include "gc.h"
 
-#include <unistd.h>
 
 /*
   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
diff --git a/libguile/gc.c b/libguile/gc.c
index 4478128c6..5bbe1d968 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006,
- *   2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2003,2006,2008-2014,2016-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* #define DEBUGINFO */
 
@@ -23,55 +23,52 @@
 #  include <config.h>
 #endif
 
-#include "libguile/gen-scmconfig.h"
-
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
 #include <stdlib.h>
 #include <math.h>
+#include <unistd.h>
 
-#ifdef __ia64__
-#include <ucontext.h>
-extern unsigned long * __libc_ia64_register_backing_store_base;
+#include "arrays.h"
+#include "async.h"
+#include "bdw-gc.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "gen-scmconfig.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "hooks.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "simpos.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "stime.h"
+#include "strings.h"
+#include "struct.h"
+#include "symbols.h"
+#include "vectors.h"
+
+#ifdef GUILE_DEBUG_MALLOC
+#include "debug-malloc.h"
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/stime.h"
-#include "libguile/stackchk.h"
-#include "libguile/struct.h"
-#include "libguile/smob.h"
-#include "libguile/arrays.h"
-#include "libguile/async.h"
-#include "libguile/ports.h"
-#include "libguile/simpos.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/hashtab.h"
-#include "libguile/tags.h"
-
-#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/gc.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/bdw-gc.h"
+#include "gc.h"
 
 /* For GC_set_start_callback.  */
 #include <gc/gc_mark.h>
 
-#ifdef GUILE_DEBUG_MALLOC
-#include "libguile/debug-malloc.h"
-#endif
-
-#include <unistd.h>
 
 /* Size in bytes of the initial heap.  This should be about the size of
    result of 'guile -c "(display (assq-ref (gc-stats)
    'heap-total-allocated))"'.  */
 
-#define DEFAULT_INITIAL_HEAP_SIZE (128 * 1024 * SIZEOF_SCM_T_BITS)
+#define DEFAULT_INITIAL_HEAP_SIZE (128 * 1024 * SIZEOF_UINTPTR_T)
 
 /* Set this to != 0 if every cell that is accessed shall be checked:
  */
@@ -480,9 +477,9 @@ scm_storage_prehistory ()
 
   /* We only need to register a displacement for those types for which the
      higher bits of the type tag are used to store a pointer (that is, a
-     pointer to an 8-octet aligned region).  For `scm_tc3_struct', this is
-     handled in `scm_alloc_struct ()'.  */
+     pointer to an 8-octet aligned region).  */
   GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
+  GC_REGISTER_DISPLACEMENT (scm_tc3_struct);
   /* GC_REGISTER_DISPLACEMENT (scm_tc3_unused); */
 
   /* Sanity check.  */
@@ -496,8 +493,6 @@ scm_storage_prehistory ()
   scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
 }
 
-scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
 void
 scm_init_gc_protect_object ()
 {
@@ -548,7 +543,7 @@ queue_after_gc_hook (void * hook_data SCM_UNUSED,
                      void *fn_data SCM_UNUSED,
                      void *data SCM_UNUSED)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   if (scm_is_false (SCM_CDR (after_gc_async_cell)))
     {
@@ -631,7 +626,7 @@ scm_init_gc ()
   GC_set_warn_proc (scm_gc_warn_proc);
   GC_set_start_callback (run_before_gc_c_hook);
 
-#include "libguile/gc.x"
+#include "gc.x"
 }
 
 
@@ -643,9 +638,3 @@ scm_gc_sweep (void)
   fprintf (stderr, "%s: doing nothing\n", FUNC_NAME);
 }
 #undef FUNC_NAME
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gc.h b/libguile/gc.h
index 734469929..387f78a7d 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -1,33 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_GC_H
 #define SCM_GC_H
 
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2004,2006-2014,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-#include "libguile/__scm.h"
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
-#include "libguile/hooks.h"
-#include "libguile/threads.h"
+#include "libguile/inline.h"
+#include "libguile/chooks.h"
 
 
 /* Before Guile 2.0, Guile had a custom garbage collector and memory
@@ -88,16 +84,6 @@ typedef struct scm_t_cell
 #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 ((x), (t))
 
 
-SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
-
-#define scm_gc_running_p  0
-SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex;
-
-#ifdef __ia64__
-void *scm_ia64_register_backing_store_base (void);
-void *scm_ia64_ar_bsp (const void *);
-#endif
-
 
 
 SCM_API unsigned long scm_gc_ports_collected;
@@ -164,8 +150,8 @@ SCM_API char *scm_gc_strndup (const char *str, size_t n, const char *what)
 
 SCM_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
 SCM_INLINE SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
-			     scm_t_bits ccr, scm_t_bits cdr);
-SCM_INLINE SCM scm_words (scm_t_bits car, scm_t_uint32 n_words);
+                                scm_t_bits ccr, scm_t_bits cdr);
+SCM_INLINE SCM scm_words (scm_t_bits car, uint32_t n_words);
 
 #if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
 
@@ -225,7 +211,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 }
 
 SCM_INLINE_IMPLEMENTATION SCM
-scm_words (scm_t_bits car, scm_t_uint32 n_words)
+scm_words (scm_t_bits car, uint32_t n_words)
 {
   SCM z;
 
@@ -302,9 +288,3 @@ SCM_INTERNAL void scm_init_gc_protect_object (void);
 SCM_INTERNAL void scm_init_gc (void);
 
 #endif  /* SCM_GC_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index f825e9b2b..8d77dfaf2 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -1,34 +1,34 @@
-/* Copyright (C) 2003-2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2003-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /**********************************************************************
 
   Description of Guile's public config header mechanics:
   ----------------------------------------------------- 
 
-  Guile has four core headers:
+  Guile has three core headers:
 
     config.h: Guile's private automatically generated configuration
       header -- generated by configure.in and autoheader.  *NOT*
       installed during "make install" and so may not be referred to by
       any public headers.
 
-    libguile/_scm.h: Guile's private core header.  _scm.h is not
       installed.  It's only visible to the libguile sources
       themselves, and it includes config.h, the private config header.
       Among other things this file provides a place to make decisions
@@ -43,7 +43,7 @@
       gen-scmconfig.h.in), and the information provided in this file,
       gen-scmconfig.c.
 
-    libguile/__scm.h: Guile's public core header.  This file is
+    libguile/scm.h: Guile's public core header.  This file is
       installed and publically visible.  It includes
       libguile/scmconfig.h, the public config header and provides a
       place to make decisions based on the information gathered in
@@ -88,7 +88,7 @@
    - make sure that anything that we explicitly typedef publically is
      prefixed with scm_t_.  i.e. we used to typedef long to ptrdiff_t
      if we didn't detect ptrdiff_t, but this has been changed so that
-     we typedef scm_t_ptrdiff instead so that we won't conflict with
+     we typedef ptrdiff_t instead so that we won't conflict with
      any non-guile header definitions of the same type.  For types
      like intptr_t and uintptr_t which we just try to detect and don't
      actually define, it's fine not to have a corresponding scm_t_
@@ -136,11 +136,13 @@
 #  include <config.h>
 #endif
 
-#include <libguile/gen-scmconfig.h>
-
+#include <stdint.h>
+#include <stddef.h>
 #include <stdio.h>
 #include <string.h>
 
+#include "gen-scmconfig.h"
+
 #define pf printf
 
 int
@@ -155,10 +157,8 @@ main (int argc, char *argv[])
   /*** various important headers ***/
   pf ("\n");
   pf ("/* Important headers */\n");
-  if (SCM_I_GSC_NEEDS_STDINT_H)
-    pf ("#include <stdint.h>\n");
-  if (SCM_I_GSC_NEEDS_INTTYPES_H)
-    pf ("#include <inttypes.h>\n");
+  pf ("#include <stdint.h>\n");
+  pf ("#include <stddef.h>\n");
 
 #ifdef HAVE_LIMITS_H
   pf ("#include <limits.h>\n");
@@ -239,65 +239,21 @@ main (int argc, char *argv[])
   pf ("\n");
   pf ("/* Standard types. */\n");
 
-  pf ("/* These are always defined */\n");  
-  pf ("#define SCM_SIZEOF_CHAR %d\n", SIZEOF_CHAR);
-  pf ("#define SCM_SIZEOF_UNSIGNED_CHAR %d\n", SIZEOF_UNSIGNED_CHAR);
-  pf ("#define SCM_SIZEOF_SHORT %d\n", SIZEOF_SHORT);
-  pf ("#define SCM_SIZEOF_UNSIGNED_SHORT %d\n", SIZEOF_UNSIGNED_SHORT);
-  pf ("#define SCM_SIZEOF_LONG %d\n", SIZEOF_LONG);
-  pf ("#define SCM_SIZEOF_UNSIGNED_LONG %d\n", SIZEOF_UNSIGNED_LONG);
-  pf ("#define SCM_SIZEOF_INT %d\n", SIZEOF_INT);
-  pf ("#define SCM_SIZEOF_UNSIGNED_INT %d\n", SIZEOF_UNSIGNED_INT);
-  pf ("#define SCM_SIZEOF_SIZE_T %d\n", SIZEOF_SIZE_T);
-
-  pf ("\n");
-  pf ("/* Size of (unsigned) long long or 0 if not available (scm_t_*64 may\n"
-      "   be more likely to be what you want */\n");
-  pf ("#define SCM_SIZEOF_LONG_LONG %d\n", SIZEOF_LONG_LONG);
-  pf ("#define SCM_SIZEOF_UNSIGNED_LONG_LONG %d\n", SIZEOF_UNSIGNED_LONG_LONG);
-
-  pf ("\n");
-  pf ("/* These are always defined. */\n");
-  pf ("typedef %s scm_t_int8;\n", SCM_I_GSC_T_INT8);
-  pf ("typedef %s scm_t_uint8;\n", SCM_I_GSC_T_UINT8);
-  pf ("typedef %s scm_t_int16;\n", SCM_I_GSC_T_INT16);
-  pf ("typedef %s scm_t_uint16;\n", SCM_I_GSC_T_UINT16);
-  pf ("typedef %s scm_t_int32;\n", SCM_I_GSC_T_INT32);
-  pf ("typedef %s scm_t_uint32;\n", SCM_I_GSC_T_UINT32);
-  pf ("typedef %s scm_t_intmax;\n", SCM_I_GSC_T_INTMAX);
-  pf ("typedef %s scm_t_uintmax;\n", SCM_I_GSC_T_UINTMAX);
-  pf ("typedef %s scm_t_intptr;\n", SCM_I_GSC_T_INTPTR);
-  pf ("typedef %s scm_t_uintptr;\n", SCM_I_GSC_T_UINTPTR);
-
-  if (0 == strcmp ("intmax_t", SCM_I_GSC_T_INTMAX))
-    pf ("#define SCM_SIZEOF_INTMAX %d\n", SIZEOF_INTMAX_T);
-  else if (0 == strcmp ("long long", SCM_I_GSC_T_INTMAX))
-    pf ("#define SCM_SIZEOF_INTMAX %d\n", SIZEOF_LONG_LONG);
-  else if (0 == strcmp ("__int64", SCM_I_GSC_T_INTMAX))
-    pf ("#define SCM_SIZEOF_INTMAX %d\n", SIZEOF___INT64);
-  else
-    return 1;
-
-  pf ("\n");
-  pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
-  pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
-  pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
-  pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
-
-  pf ("\n");
-  pf ("/* scm_t_ptrdiff and size, always defined -- defined to long if\n"
-      "   platform doesn't have ptrdiff_t. */\n");
-  pf ("typedef %s scm_t_ptrdiff;\n", SCM_I_GSC_T_PTRDIFF);
-  if (0 == strcmp ("long", SCM_I_GSC_T_PTRDIFF))
-    pf ("#define SCM_SIZEOF_SCM_T_PTRDIFF %d\n", SIZEOF_LONG);
-  else
-    pf ("#define SCM_SIZEOF_SCM_T_PTRDIFF %d\n", SIZEOF_PTRDIFF_T);
-
-  pf ("\n");
-  pf ("/* Size of intptr_t or 0 if not available */\n");
-  pf ("#define SCM_SIZEOF_INTPTR_T %d\n", SIZEOF_INTPTR_T);
-  pf ("/* Size of uintptr_t or 0 if not available */\n");
-  pf ("#define SCM_SIZEOF_UINTPTR_T %d\n", SIZEOF_UINTPTR_T);
+  pf ("#define SCM_SIZEOF_CHAR %zu\n", sizeof (char));
+  pf ("#define SCM_SIZEOF_UNSIGNED_CHAR %zu\n", sizeof (unsigned char));
+  pf ("#define SCM_SIZEOF_SHORT %zu\n", sizeof (short));
+  pf ("#define SCM_SIZEOF_UNSIGNED_SHORT %zu\n", sizeof (unsigned short));
+  pf ("#define SCM_SIZEOF_LONG %zu\n", sizeof (long));
+  pf ("#define SCM_SIZEOF_UNSIGNED_LONG %zu\n", sizeof (unsigned long));
+  pf ("#define SCM_SIZEOF_INT %zu\n", sizeof (int));
+  pf ("#define SCM_SIZEOF_UNSIGNED_INT %zu\n", sizeof (unsigned int));
+  pf ("#define SCM_SIZEOF_SIZE_T %zu\n", sizeof (size_t));
+  pf ("#define SCM_SIZEOF_LONG_LONG %zu\n", sizeof (long long));
+  pf ("#define SCM_SIZEOF_UNSIGNED_LONG_LONG %zu\n", sizeof (unsigned long long));
+  pf ("#define SCM_SIZEOF_INTMAX %zu\n", sizeof (intmax_t));
+  pf ("#define SCM_SIZEOF_SCM_T_PTRDIFF %zu\n", sizeof (ptrdiff_t));
+  pf ("#define SCM_SIZEOF_INTPTR_T %zu\n", sizeof (intptr_t));
+  pf ("#define SCM_SIZEOF_UINTPTR_T %zu\n", sizeof (uintptr_t));
 
   pf ("\n");
   pf ("/* same as POSIX \"struct timespec\" -- always defined */\n");
@@ -375,9 +331,9 @@ main (int argc, char *argv[])
      how the application that uses Guile is compiled.  */
 
 #if defined GUILE_USE_64_CALLS && defined HAVE_STAT64
-  pf ("typedef scm_t_int64 scm_t_off;\n");
-  pf ("#define SCM_T_OFF_MAX SCM_T_INT64_MAX\n");
-  pf ("#define SCM_T_OFF_MIN SCM_T_INT64_MIN\n");
+  pf ("typedef int64_t scm_t_off;\n");
+  pf ("#define SCM_T_OFF_MAX INT64_MAX\n");
+  pf ("#define SCM_T_OFF_MIN INT64_MIN\n");
 #elif SIZEOF_OFF_T == SIZEOF_INT
   pf ("typedef int scm_t_off;\n");
   pf ("#define SCM_T_OFF_MAX INT_MAX\n");
@@ -405,9 +361,6 @@ main (int argc, char *argv[])
 #endif
 
   pf ("\n");
-  pf ("#define SCM_HAVE_ARRAYS 1 /* always true now */\n");
-
-  pf ("\n");
   pf ("/* Constants from uniconv.h.  */\n");
   pf ("#define SCM_ICONVEH_ERROR %d\n", SCM_I_GSC_ICONVEH_ERROR);
   pf ("#define SCM_ICONVEH_QUESTION_MARK %d\n",
@@ -415,6 +368,10 @@ main (int argc, char *argv[])
   pf ("#define SCM_ICONVEH_ESCAPE_SEQUENCE %d\n",
       SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE);  
 
+  pf ("\n");
+  pf ("/* Define to 1 if there is an auxiliary stack, as in ia64.  */\n");
+  pf ("#define SCM_HAVE_AUXILIARY_STACK %d\n", SCM_I_GSC_HAVE_AUXILIARY_STACK);
+
   printf ("#endif\n");
 
   return 0;
diff --git a/libguile/gen-scmconfig.h.in b/libguile/gen-scmconfig.h.in
index 30f43d7b7..6e5ebdb84 100644
--- a/libguile/gen-scmconfig.h.in
+++ b/libguile/gen-scmconfig.h.in
@@ -10,21 +10,6 @@
 #define SCM_I_GSC_ENABLE_DEPRECATED @SCM_I_GSC_ENABLE_DEPRECATED@
 #define SCM_I_GSC_STACK_GROWS_UP @SCM_I_GSC_STACK_GROWS_UP@
 #define SCM_I_GSC_C_INLINE @SCM_I_GSC_C_INLINE@
-#define SCM_I_GSC_NEEDS_STDINT_H @SCM_I_GSC_NEEDS_STDINT_H@
-#define SCM_I_GSC_NEEDS_INTTYPES_H @SCM_I_GSC_NEEDS_INTTYPES_H@
-#define SCM_I_GSC_T_INT8 @SCM_I_GSC_T_INT8@
-#define SCM_I_GSC_T_UINT8 @SCM_I_GSC_T_UINT8@
-#define SCM_I_GSC_T_INT16 @SCM_I_GSC_T_INT16@
-#define SCM_I_GSC_T_UINT16 @SCM_I_GSC_T_UINT16@
-#define SCM_I_GSC_T_INT32 @SCM_I_GSC_T_INT32@
-#define SCM_I_GSC_T_UINT32 @SCM_I_GSC_T_UINT32@
-#define SCM_I_GSC_T_INT64 @SCM_I_GSC_T_INT64@
-#define SCM_I_GSC_T_UINT64 @SCM_I_GSC_T_UINT64@
-#define SCM_I_GSC_T_INTMAX @SCM_I_GSC_T_INTMAX@
-#define SCM_I_GSC_T_UINTMAX @SCM_I_GSC_T_UINTMAX@
-#define SCM_I_GSC_T_INTPTR @SCM_I_GSC_T_INTPTR@
-#define SCM_I_GSC_T_UINTPTR @SCM_I_GSC_T_UINTPTR@
-#define SCM_I_GSC_T_PTRDIFF @SCM_I_GSC_T_PTRDIFF@
 #define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@
 #define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
 #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
@@ -34,6 +19,7 @@
 #define SCM_I_GSC_ICONVEH_ERROR @SCM_I_GSC_ICONVEH_ERROR@
 #define SCM_I_GSC_ICONVEH_QUESTION_MARK @SCM_I_GSC_ICONVEH_QUESTION_MARK@
 #define SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE @SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE@
+#define SCM_I_GSC_HAVE_AUXILIARY_STACK @SCM_I_GSC_HAVE_AUXILIARY_STACK@
 
 /*
   Local Variables:
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index fdbdb4aff..28ca6b3c7 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,36 +1,40 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009-2010,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
 
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
-#include <stdio.h>
 #include <errno.h>
+#include <stdio.h>
 #include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/array-handle.h"
-#include "libguile/generalized-arrays.h"
+#include "array-handle.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+
+#include "generalized-arrays.h"
 
 
 SCM_INTERNAL SCM scm_i_array_ref (SCM v,
@@ -402,11 +406,5 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
 void
 scm_init_generalized_arrays ()
 {
-#include "libguile/generalized-arrays.x"
+#include "generalized-arrays.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index cfa69051b..130807b29 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -1,30 +1,30 @@
-/* classes: h_files */
-
 #ifndef SCM_GENERALIZED_ARRAYS_H
 #define SCM_GENERALIZED_ARRAYS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/array-handle.h"
+#include "libguile/boolean.h"
+#include <libguile/error.h>
 
 
 
@@ -32,6 +32,14 @@
  */
 
 
+#define SCM_VALIDATE_ARRAY(pos, v) \
+  do { \
+    SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
+                && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
+                v, pos, FUNC_NAME); \
+  } while (0)
+
+
 /** Arrays */
 
 SCM_API int scm_is_array (SCM obj);
@@ -63,9 +71,3 @@ SCM_INTERNAL void scm_init_generalized_arrays (void);
 
 
 #endif  /* SCM_GENERALIZED_ARRAYS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 276b9d865..b7516a345 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- *   2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,12 +24,10 @@
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
+#include "error.h"
+#include "gsubr.h"
 
-#include "libguile/array-handle.h"
-#include "libguile/generalized-arrays.h"
-#include "libguile/generalized-vectors.h"
+#include "generalized-vectors.h"
 
 
 struct scm_t_vector_ctor
@@ -70,24 +68,7 @@ SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
 #undef FUNC_NAME
 
 void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-    {
-      scm_array_handle_release (h);
-      scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-    }
-}
-
-void
 scm_init_generalized_vectors ()
 {
-#include "libguile/generalized-vectors.x"
+#include "generalized-vectors.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
index 77d62726f..7a8da6aec 100644
--- a/libguile/generalized-vectors.h
+++ b/libguile/generalized-vectors.h
@@ -1,38 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_GENERALIZED_VECTORS_H
 #define SCM_GENERALIZED_VECTORS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
-#include "libguile/array-handle.h"
+#include "libguile/snarf.h"
 
 
 
 /* Generalized vectors */
 
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-						scm_t_array_handle *h);
-
 SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
 SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM));
 
@@ -43,9 +38,3 @@ SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM,
 SCM_INTERNAL void scm_init_generalized_vectors (void);
 
 #endif  /* SCM_GENERALIZED_VECTORS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gettext.c b/libguile/gettext.c
index 2ae3ae5e4..b9af4d313 100644
--- a/libguile/gettext.c
+++ b/libguile/gettext.c
@@ -1,34 +1,37 @@
-/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2004,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/dynwind.h"
+#include <locale.h>
 
-#include "libguile/gettext.h"
+#include "dynwind.h"
+#include "feature.h"
+#include "gsubr.h"
 #include "libgettext.h"
-#include <locale.h>
+#include "numbers.h"
+#include "strings.h"
+
+#include "gettext.h"
 
 
 int
@@ -321,12 +324,6 @@ scm_init_gettext ()
      now.  */
   scm_add_feature ("i18n");
 
-#include "libguile/gettext.x"
+#include "gettext.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gettext.h b/libguile/gettext.h
index d4576bd6a..40f5bf43e 100644
--- a/libguile/gettext.h
+++ b/libguile/gettext.h
@@ -1,27 +1,26 @@
-/* classes: h_files */
-
 #ifndef SCM_GETTEXT_H
 #define SCM_GETTEXT_H
 
-/* Copyright (C) 2004, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-#include "libguile/__scm.h"
+/* Copyright 2004,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#include "libguile/scm.h"
 
 SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
 SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
@@ -34,9 +33,3 @@ SCM_INTERNAL int scm_i_to_lc_category (SCM category, int allow_lc_all);
 SCM_INTERNAL void scm_init_gettext (void);
 
 #endif  /* SCM_GETTEXT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/goops.c b/libguile/goops.c
index 77316cfce..fd312a8f1 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1998-2004,2008-2015,2017
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998-2004,2008-2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 /* This software is a derivative work of other copyrighted softwares; the
@@ -29,27 +29,35 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/chars.h"
-#include "libguile/dynwind.h"
-#include "libguile/eval.h"
-#include "libguile/gsubr.h"
-#include "libguile/hashtab.h"
-#include "libguile/keywords.h"
-#include "libguile/macros.h"
-#include "libguile/modules.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/procprop.h"
-#include "libguile/programs.h"
-#include "libguile/smob.h"
-#include "libguile/strings.h"
-#include "libguile/strports.h"
-#include "libguile/vectors.h"
-
-#include "libguile/validate.h"
-#include "libguile/goops.h"
+#include "async.h"
+#include "boolean.h"
+#include "chars.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "extensions.h"
+#include "foreign.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "macros.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "procprop.h"
+#include "programs.h"
+#include "smob.h"
+#include "strings.h"
+#include "strports.h"
+#include "symbols.h"
+#include "variable.h"
+#include "vectors.h"
+#include "version.h"
+#include "weak-table.h"
+
+#include "goops.h"
+
 
 /* Objects have identity, so references to classes and instances are by
    value, not by reference.  Redefinition of a class or modification of
@@ -68,7 +76,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 static int goops_loaded_p = 0;
 
 static SCM var_make_standard_class = SCM_BOOL_F;
-static SCM var_change_class = SCM_BOOL_F;
+static SCM var_class_of_obsolete_indirect_instance = SCM_BOOL_F;
 static SCM var_make = SCM_BOOL_F;
 static SCM var_inherit_applicable = SCM_BOOL_F;
 static SCM var_class_name = SCM_BOOL_F;
@@ -168,8 +176,8 @@ SCM_DEFINE (scm_sys_init_layout_x, "%init-layout!", 2, 0, 0,
   SCM_VALIDATE_STRING (2, layout);
 
   SCM_SET_VTABLE_LAYOUT (class, scm_make_struct_layout (layout));
-  scm_i_struct_inherit_vtable_magic (SCM_CLASS_OF (class), class);
-  SCM_SET_CLASS_FLAGS (class, SCM_CLASSF_GOOPS_OR_VALID);
+  scm_i_struct_inherit_vtable_magic (scm_class_of (class), class);
+  SCM_SET_CLASS_FLAGS (class, SCM_VTABLE_FLAG_GOOPS_CLASS);
 
   return SCM_UNSPECIFIED;
 }
@@ -178,6 +186,17 @@ SCM_DEFINE (scm_sys_init_layout_x, "%init-layout!", 2, 0, 0,
 
 
 
+static SCM
+get_indirect_slots (SCM x)
+{
+  /* Precondition: X is an indirect instance.  The indirect slots are in
+     the last field.  */
+  scm_t_bits nfields =
+    SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (x), scm_vtable_index_size);
+
+  return SCM_STRUCT_SLOT_REF (x, nfields - 1);
+}
+
 /* This function is used for efficient type dispatch.  */
 SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	    (SCM x),
@@ -277,21 +296,34 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
             return ptob->output_class;
           }
 	case scm_tcs_struct:
-	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
-            /* A GOOPS object with a valid class.  */
-	    return SCM_CLASS_OF (x);
-	  else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
-            /* A GOOPS object whose class might have been redefined.  */
-	    {
-              SCM class = SCM_CLASS_OF (x);
-              SCM new_class = scm_slot_ref (class, sym_redefined);
-              if (!scm_is_false (new_class))
-		scm_change_object_class (x, class, new_class);
-              /* Re-load class from instance.  */
-	      return SCM_CLASS_OF (x);
-	    }
-	  else
-            return scm_i_define_class_for_vtable (SCM_CLASS_OF (x));
+          {
+            SCM vtable = SCM_STRUCT_VTABLE (x);
+            scm_t_bits flags = SCM_VTABLE_FLAGS (vtable);
+            scm_t_bits direct = SCM_VTABLE_FLAG_GOOPS_CLASS;
+            scm_t_bits indirect = direct | SCM_VTABLE_FLAG_GOOPS_INDIRECT;
+            scm_t_bits mask = indirect;
+            if ((flags & mask) == direct)
+              /* A direct GOOPS object.  */
+              return vtable;
+            else if ((flags & mask) == indirect)
+              /* An indirect GOOPS object.  If the vtable of the slots
+                 object is flagged to indicate that there's a new class
+                 definition available, migrate the instance before
+                 returning the class.  */
+              {
+                SCM slots = get_indirect_slots (x);
+                scm_t_bits slot_flags = SCM_OBJ_CLASS_FLAGS (slots);
+                if (slot_flags & SCM_VTABLE_FLAG_GOOPS_NEEDS_MIGRATION)
+                  return scm_call_1
+                    (scm_variable_ref (var_class_of_obsolete_indirect_instance),
+                     x);
+                else
+                  return vtable;
+              }
+            else
+              /* A non-GOOPS struct.  */
+              return scm_i_define_class_for_vtable (vtable);
+          }
 	default:
 	  if (scm_is_pair (x))
 	    return class_pair;
@@ -325,13 +357,13 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0,
 int
 scm_is_generic (SCM x)
 {
-  return SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), class_generic);
+  return SCM_INSTANCEP (x) && SCM_SUBCLASSP (scm_class_of (x), class_generic);
 }
 
 int
 scm_is_method (SCM x)
 {
-  return SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), class_method);
+  return SCM_INSTANCEP (x) && SCM_SUBCLASSP (scm_class_of (x), class_method);
 }
 
 
@@ -452,17 +484,13 @@ SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 2, 0, 0,
 #define FUNC_NAME s_scm_sys_clear_fields_x
 {
   scm_t_signed_bits n, i;
-  SCM vtable, layout;
 
   SCM_VALIDATE_STRUCT (1, obj);
-  vtable = SCM_STRUCT_VTABLE (obj);
-
-  n = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
-  layout = SCM_VTABLE_LAYOUT (vtable);
+  n = SCM_STRUCT_SIZE (obj);
 
   /* Set all SCM-holding slots to the GOOPS unbound value.  */
   for (i = 0; i < n; i++)
-    if (scm_i_symbol_ref (layout, i*2) == 'p')
+    if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, i))
       SCM_STRUCT_SLOT_SET (obj, i, unbound);
 
   return SCM_UNSPECIFIED;
@@ -479,122 +507,39 @@ SCM_DEFINE (scm_sys_modify_instance, "%modify-instance", 2, 0, 0,
 	    "Used by change-class to modify objects in place.")
 #define FUNC_NAME s_scm_sys_modify_instance
 {
+  scm_t_bits i, old_nfields, new_nfields;
+
   SCM_VALIDATE_INSTANCE (1, old);
   SCM_VALIDATE_INSTANCE (2, new);
 
-  /* Exchange the data contained in old and new. We exchange rather than
-   * scratch the old value with new to be correct with GC.
-   * See "Class redefinition protocol above".
-   */
-  scm_i_pthread_mutex_lock (&goops_lock);
-  {
-    scm_t_bits word0, word1;
-    word0 = SCM_CELL_WORD_0 (old);
-    word1 = SCM_CELL_WORD_1 (old);
-    SCM_SET_CELL_WORD_0 (old, SCM_CELL_WORD_0 (new));
-    SCM_SET_CELL_WORD_1 (old, SCM_CELL_WORD_1 (new));
-    SCM_SET_CELL_WORD_0 (new, word0);
-    SCM_SET_CELL_WORD_1 (new, word1);
-  }
-  scm_i_pthread_mutex_unlock (&goops_lock);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_sys_modify_class, "%modify-class", 2, 0, 0,
-	    (SCM old, SCM new),
-	    "")
-#define FUNC_NAME s_scm_sys_modify_class
-{
-  SCM_VALIDATE_CLASS (1, old);
-  SCM_VALIDATE_CLASS (2, new);
+  old_nfields = SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (old),
+                                     scm_vtable_index_size);
+  new_nfields = SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (new),
+                                     scm_vtable_index_size);
+  SCM_ASSERT (old_nfields == new_nfields, new, SCM_ARG2, FUNC_NAME);
 
+  /* Exchange the data contained in old and new. We exchange rather than
+     scratch the old value with new to be correct with GC.  See "Class
+     redefinition protocol" in goops.scm.  */
   scm_i_pthread_mutex_lock (&goops_lock);
+  /* Swap vtables.  */
   {
-    scm_t_bits word0, word1;
-    word0 = SCM_CELL_WORD_0 (old);
-    word1 = SCM_CELL_WORD_1 (old);
+    scm_t_bits tmp = SCM_CELL_WORD_0 (old);
     SCM_SET_CELL_WORD_0 (old, SCM_CELL_WORD_0 (new));
-    SCM_SET_CELL_WORD_1 (old, SCM_CELL_WORD_1 (new));
-    SCM_STRUCT_DATA (old)[scm_vtable_index_self] = SCM_UNPACK (old);
-    SCM_SET_CELL_WORD_0 (new, word0);
-    SCM_SET_CELL_WORD_1 (new, word1);
-    SCM_STRUCT_DATA (new)[scm_vtable_index_self] = SCM_UNPACK (new);
+    SCM_SET_CELL_WORD_0 (new, tmp);
   }
+  /* Swap data.  */
+  for (i = 0; i < old_nfields; i++)
+    {
+      scm_t_bits tmp = SCM_STRUCT_DATA_REF (old, i);
+      SCM_STRUCT_DATA_SET (old, i, SCM_STRUCT_DATA_REF (new, i));
+      SCM_STRUCT_DATA_SET (new, i, tmp);
+    }
   scm_i_pthread_mutex_unlock (&goops_lock);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-/* When instances change class, they finally get a new body, but
- * before that, they go through purgatory in hell.  Odd as it may
- * seem, this data structure saves us from eternal suffering in
- * infinite recursions.
- */
-
-static scm_t_bits **hell;
-static long n_hell = 1;		/* one place for the evil one himself */
-static long hell_size = 4;
-static SCM hell_mutex;
-
-static long
-burnin (SCM o)
-{
-  long i;
-  for (i = 1; i < n_hell; ++i)
-    if (SCM_STRUCT_DATA (o) == hell[i])
-      return i;
-  return 0;
-}
-
-static void
-go_to_hell (void *o)
-{
-  SCM obj = *(SCM*)o;
-  scm_lock_mutex (hell_mutex);
-  if (n_hell >= hell_size)
-    {
-      hell_size *= 2;
-      hell = scm_realloc (hell, hell_size * sizeof(*hell));
-    }
-  hell[n_hell++] = SCM_STRUCT_DATA (obj);
-  scm_unlock_mutex (hell_mutex);
-}
-
-static void
-go_to_heaven (void *o)
-{
-  SCM obj = *(SCM*)o;
-  scm_lock_mutex (hell_mutex);
-  hell[burnin (obj)] = hell[--n_hell];
-  scm_unlock_mutex (hell_mutex);
-}
-
-
-static SCM
-purgatory (SCM obj, SCM new_class)
-{
-  return scm_call_2 (SCM_VARIABLE_REF (var_change_class), obj, new_class);
-}
-
-/* This function calls the generic function change-class for all
- * instances which aren't currently undergoing class change.
- */
-
-void
-scm_change_object_class (SCM obj, SCM old_class SCM_UNUSED, SCM new_class)
-{
-  if (!burnin (obj))
-    {
-      scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
-      scm_dynwind_rewind_handler (go_to_hell, &obj, SCM_F_WIND_EXPLICITLY);
-      scm_dynwind_unwind_handler (go_to_heaven, &obj, SCM_F_WIND_EXPLICITLY);
-      purgatory (obj, new_class);
-      scm_dynwind_end ();
-    }
-}
-
-
 
 
 /* Primitive generics: primitives that can dispatch to generics if their
@@ -1031,11 +976,8 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
   var_method_specializers = scm_c_lookup ("method-specializers");
   var_method_procedure = scm_c_lookup ("method-procedure");
 
-  var_change_class = scm_c_lookup ("change-class");
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-  scm_init_deprecated_goops ();
-#endif
+  var_class_of_obsolete_indirect_instance =
+    scm_c_lookup ("class-of-obsolete-indirect-instance");
 
   return SCM_UNSPECIFIED;
 }
@@ -1046,10 +988,7 @@ scm_init_goops_builtins (void *unused)
 {
   scm_module_goops = scm_current_module ();
 
-  hell = scm_calloc (hell_size * sizeof (*hell));
-  hell_mutex = scm_make_mutex ();
-
-#include "libguile/goops.x"
+#include "goops.x"
 
   scm_c_define ("vtable-flag-vtable",
                 scm_from_int (SCM_VTABLE_FLAG_VTABLE));
@@ -1061,12 +1000,14 @@ scm_init_goops_builtins (void *unused)
                 scm_from_int (SCM_VTABLE_FLAG_VALIDATED));
   scm_c_define ("vtable-flag-goops-class",
                 scm_from_int (SCM_VTABLE_FLAG_GOOPS_CLASS));
-  scm_c_define ("vtable-flag-goops-valid",
-                scm_from_int (SCM_VTABLE_FLAG_GOOPS_VALID));
   scm_c_define ("vtable-flag-goops-slot",
                 scm_from_int (SCM_VTABLE_FLAG_GOOPS_SLOT));
-  scm_c_define ("vtable-flag-goops-static",
-                scm_from_int (SCM_VTABLE_FLAG_GOOPS_STATIC));
+  scm_c_define ("vtable-flag-goops-static-slot-allocation",
+                scm_from_int (SCM_VTABLE_FLAG_GOOPS_STATIC_SLOT_ALLOCATION));
+  scm_c_define ("vtable-flag-goops-indirect",
+                scm_from_int (SCM_VTABLE_FLAG_GOOPS_INDIRECT));
+  scm_c_define ("vtable-flag-goops-needs-migration",
+                scm_from_int (SCM_VTABLE_FLAG_GOOPS_NEEDS_MIGRATION));
 }
 
 void
@@ -1076,9 +1017,3 @@ scm_init_goops ()
                             "scm_init_goops_builtins", scm_init_goops_builtins,
                             NULL);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/goops.h b/libguile/goops.h
index 790c0b448..9d44d26c5 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -1,25 +1,24 @@
-/* classes: h_files */
-
 #ifndef SCM_GOOPS_H
 #define SCM_GOOPS_H
 
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2011, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998-2003,2006,2008-2009,2011,2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -30,9 +29,10 @@
  * Erick Gallesio <eg@unice.fr>.
  */
 
-#include "libguile/__scm.h"
+#include "libguile/boolean.h"
+#include "libguile/list.h"
+#include "libguile/ports.h"
 
-#include "libguile/validate.h"
 
 /* {Class flags}
  *
@@ -40,10 +40,22 @@
  * certain class or its subclasses when traversal of the inheritance
  * graph would be too costly.
  */
+/* Set for all GOOPS classes.  */
 #define SCM_VTABLE_FLAG_GOOPS_CLASS SCM_VTABLE_FLAG_GOOPS_0
-#define SCM_VTABLE_FLAG_GOOPS_VALID SCM_VTABLE_FLAG_GOOPS_1
-#define SCM_VTABLE_FLAG_GOOPS_SLOT SCM_VTABLE_FLAG_GOOPS_2
-#define SCM_VTABLE_FLAG_GOOPS_STATIC SCM_VTABLE_FLAG_GOOPS_3
+/* Set for GOOPS classes whose instances are <slot> objects.  */
+#define SCM_VTABLE_FLAG_GOOPS_SLOT SCM_VTABLE_FLAG_GOOPS_1
+/* Set for GOOPS classes whose instance's slots must always be allocated
+   to the same indices, for all concrete subclasses.  */
+#define SCM_VTABLE_FLAG_GOOPS_STATIC_SLOT_ALLOCATION SCM_VTABLE_FLAG_GOOPS_2
+/* Set for GOOPS classes whose instances are "indirect", meaning they
+   just have one slot that indirects to a direct instance with the
+   slots.  For non-class instances, this is at struct slot 0.  For class
+   instances, it's the first slot after the <class> fixed slots.  */
+#define SCM_VTABLE_FLAG_GOOPS_INDIRECT SCM_VTABLE_FLAG_GOOPS_3
+/* For indirect classes, the slots object itself has a direct vtable.
+   This flag will be set on that vtable if the instance needs to migrate
+   to a new class.  */
+#define SCM_VTABLE_FLAG_GOOPS_NEEDS_MIGRATION SCM_VTABLE_FLAG_GOOPS_4
 
 #define SCM_CLASS_OF(x)         SCM_STRUCT_VTABLE (x)
 #define SCM_CLASS_FLAGS(class) (SCM_VTABLE_FLAGS (class))
@@ -52,9 +64,7 @@
 #define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLEAR_VTABLE_FLAGS (c, f))
 
 #define SCM_CLASSF_METACLASS     (SCM_VTABLE_FLAG_GOOPS_CLASS|SCM_VTABLE_FLAG_VTABLE)
-#define SCM_CLASSF_GOOPS_VALID   SCM_VTABLE_FLAG_GOOPS_VALID
 #define SCM_CLASSF_GOOPS         SCM_VTABLE_FLAG_GOOPS_CLASS
-#define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
 
 #define SCM_CLASS_OF(x)        SCM_STRUCT_VTABLE (x)
 
@@ -72,7 +82,7 @@
 #define SCM_SUBCLASSP(c1, c2) \
   (scm_is_true (scm_c_memq (c2, scm_class_precedence_list (c1))))
 #define SCM_IS_A_P(x, c) \
-  (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
+  (SCM_INSTANCEP (x) && SCM_SUBCLASSP (scm_class_of (x), c))
 
 #define SCM_GENERICP(x) (scm_is_generic (x))
 #define SCM_VALIDATE_GENERIC(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, GENERICP, "generic function")
@@ -120,13 +130,11 @@ SCM_API SCM scm_method_procedure (SCM obj);
 SCM_API SCM scm_slot_bound_p (SCM obj, SCM slot_name);
 SCM_API SCM scm_slot_exists_p (SCM obj, SCM slot_name);
 SCM_API SCM scm_sys_modify_instance (SCM old, SCM newinst);
-SCM_API SCM scm_sys_modify_class (SCM old, SCM newcls);
 SCM_API SCM scm_generic_capability_p (SCM proc);
 SCM_API SCM scm_enable_primitive_generic_x (SCM subrs);
 SCM_INTERNAL SCM scm_set_primitive_generic_x (SCM subr, SCM generic);
 SCM_API SCM scm_primitive_generic_generic (SCM subr);
 SCM_API SCM scm_make (SCM args);
-SCM_API void scm_change_object_class (SCM, SCM, SCM);
 
 /* These procedures are for dispatching to a generic when a primitive
    fails to apply.  They raise a wrong-type-arg error if the primitive's
@@ -142,9 +150,3 @@ SCM_INTERNAL SCM scm_i_define_class_for_vtable (SCM vtable);
 SCM_INTERNAL void scm_init_goops (void);
 
 #endif  /* SCM_GOOPS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index e22d16363..644262737 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,38 +1,48 @@
-/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013, 2015
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2006,2008-2011,2013,2015,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
+#include <flexmember.h>
 #include <stdio.h>
 #include <stdarg.h>
+#include <string.h>
+
+#include "foreign.h"
+#include "frames.h"
+#include "instructions.h"
+#include "jit.h"
+#include "modules.h"
+#include "numbers.h"
+#include "private-options.h"
+#include "programs.h"
+#include "srfi-4.h"
+#include "symbols.h"
+#include "threads.h"
+
+#include "gsubr.h"
 
-#include "libguile/_scm.h"
-#include "libguile/gsubr.h"
-#include "libguile/foreign.h"
-#include "libguile/instructions.h"
-#include "libguile/srfi-4.h"
-#include "libguile/programs.h"
 
-#include "libguile/private-options.h"
 
 /*
  * gsubr.c
@@ -40,224 +50,309 @@
  * and rest arguments.
  */
 
+/* In July 2018 there were 1140 subrs defined in stock Guile.  */
+static const size_t expected_subr_count = 1500;
+
+static scm_i_pthread_mutex_t admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+static void **subrs = NULL;
+static uint32_t next_subr_idx = 0;
+static uint32_t subrs_array_size = 0;
+
+static uint32_t
+alloc_subr_idx (void *subr)
+{
+  uint32_t idx;
+
+  scm_i_pthread_mutex_lock (&admin_mutex);
+
+  idx = next_subr_idx++;
+
+  if (idx > 0xffffff) abort ();
+
+  if (idx >= subrs_array_size)
+    {
+      void **new_subrs;
+
+      if (subrs_array_size)
+        subrs_array_size *= 2;
+      else
+        subrs_array_size = expected_subr_count;
+
+      /* Leak this allocation, as code lives as long as the program
+         does.  In the likely case, we only make one malloc for the
+         program; in the general case it's still O(n) in number of subrs
+         because of the geometric factor.  Use malloc instead of GC
+         allocations because it's not traceable and not collectable.  */
+      new_subrs = malloc (subrs_array_size * sizeof (void*));
+      memcpy (new_subrs, subrs, idx * sizeof (void*));
+      subrs = new_subrs;
+    }
+
+  subrs[idx] = subr;
+
+  scm_i_pthread_mutex_unlock (&admin_mutex);
+
+  return idx;
+}
+
 
 
-/* OK here goes nothing: we're going to define VM assembly trampolines for
-   invoking subrs.  Ready?  Right!  */
-
-/* There's a maximum of 10 args, so the number of possible combinations is:
-   (REQ-OPT-REST)
-   for 0 args: 1 (000) (1 + 0)
-   for 1 arg: 3 (100, 010, 001) (2 + 1)
-   for 2 args: 5 (200, 110, 020, 101, 011) (3 + 2)
-   for 3 args: 7 (300, 210, 120, 030, 201, 111, 021) (4 + 3)
-   for N args: 2N+1
-
-   and the index at which N args starts:
-   for 0 args: 0
-   for 1 args: 1
-   for 2 args: 4
-   for 3 args: 9
-   for N args: N^2
-
-   One can prove this:
-
-   (1 + 3 + 5 + ... + (2N+1))
-     = ((2N+1)+1)/2 * (N+1)
-     = 2(N+1)/2 * (N+1)
-     = (N+1)^2
-
-   Thus the total sum is 11^2 = 121. Let's just generate all of them as
-   read-only data.
-*/
-
-/* A: req; B: opt; C: rest */
-#define A(nreq)                                                         \
-  SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1),                           \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0,                                                                    \
-  0
-
-#define B(nopt)                                                         \
-  SCM_PACK_OP_24 (assert_nargs_le, nopt + 1),                           \
-  SCM_PACK_OP_24 (alloc_frame, nopt + 1),                               \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0
-
-#define C()                                                             \
-  SCM_PACK_OP_24 (bind_rest, 1),                                        \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0,                                                                    \
-  0
-
-#define AB(nreq, nopt)                                                  \
-  SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),                           \
-  SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1),                    \
-  SCM_PACK_OP_24 (alloc_frame, nreq + nopt + 1),                        \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0)
-
-#define AC(nreq)                                                        \
-  SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),                           \
-  SCM_PACK_OP_24 (bind_rest, nreq + 1),                                 \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0
-
-#define BC(nopt)                                                        \
-  SCM_PACK_OP_24 (bind_rest, nopt + 1),                                 \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0,                                                                    \
-  0
-
-#define ABC(nreq, nopt)                                                 \
-  SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),                           \
-  SCM_PACK_OP_24 (bind_rest, nreq + nopt + 1),                          \
-  SCM_PACK_OP_24 (subr_call, 0),                                        \
-  SCM_PACK_OP_24 (handle_interrupts, 0),                                \
-  SCM_PACK_OP_24 (return_values, 0),                                    \
-  0
+static SCM *names = NULL;
+static uint32_t names_array_size = 0;
 
+static void
+record_subr_name (uint32_t idx, SCM name)
+{
+  scm_i_pthread_mutex_lock (&admin_mutex);
 
-/*
- (defun generate-bytecode (n)
-   "Generate bytecode for N arguments"
-   (interactive "p")
-   (insert (format "/\* %d arguments *\/\n " n))
-   (let ((nreq n))
-     (while (<= 0 nreq)
-       (let ((nopt (- n nreq)))
-         (insert
-          (if (< 0 nreq)
-              (if (< 0 nopt)
-                  (format " AB(%d,%d)," nreq nopt)
-                  (format " A(%d)," nreq))
-              (if (< 0 nopt)
-                  (format " B(%d)," nopt)
-                  (format " A(0),"))))
-         (setq nreq (1- nreq))))
-     (insert "\n ")
-     (setq nreq (1- n))
-     (while (<= 0 nreq)
-       (let ((nopt (- n nreq 1)))
-         (insert
-          (if (< 0 nreq)
-              (if (< 0 nopt)
-                  (format " ABC(%d,%d)," nreq nopt)
-                  (format " AC(%d)," nreq))
-              (if (< 0 nopt)
-                  (format " BC(%d)," nopt)
-                  (format " C(),"))))
-         (setq nreq (1- nreq))))
-     (insert "\n\n  ")))
-
- (defun generate-bytecodes (n)
-   "Generate bytecodes for up to N arguments"
-   (interactive "p")
-   (let ((i 0))
-     (while (<= i n)
-       (generate-bytecode i)
-       (setq i (1+ i)))))
-*/
-static const scm_t_uint32 subr_stub_code[] = {
-  /* C-u 1 0 M-x generate-bytecodes RET */
-  /* 0 arguments */
-  A(0),
-
-  /* 1 arguments */
-  A(1), B(1),
-  C(),
-
-  /* 2 arguments */
-  A(2), AB(1,1), B(2),
-  AC(1), BC(1),
-
-  /* 3 arguments */
-  A(3), AB(2,1), AB(1,2), B(3),
-  AC(2), ABC(1,1), BC(2),
-
-  /* 4 arguments */
-  A(4), AB(3,1), AB(2,2), AB(1,3), B(4),
-  AC(3), ABC(2,1), ABC(1,2), BC(3),
-
-  /* 5 arguments */
-  A(5), AB(4,1), AB(3,2), AB(2,3), AB(1,4), B(5),
-  AC(4), ABC(3,1), ABC(2,2), ABC(1,3), BC(4),
-
-  /* 6 arguments */
-  A(6), AB(5,1), AB(4,2), AB(3,3), AB(2,4), AB(1,5), B(6),
-  AC(5), ABC(4,1), ABC(3,2), ABC(2,3), ABC(1,4), BC(5),
-
-  /* 7 arguments */
-  A(7), AB(6,1), AB(5,2), AB(4,3), AB(3,4), AB(2,5), AB(1,6), B(7),
-  AC(6), ABC(5,1), ABC(4,2), ABC(3,3), ABC(2,4), ABC(1,5), BC(6),
-
-  /* 8 arguments */
-  A(8), AB(7,1), AB(6,2), AB(5,3), AB(4,4), AB(3,5), AB(2,6), AB(1,7), B(8),
-  AC(7), ABC(6,1), ABC(5,2), ABC(4,3), ABC(3,4), ABC(2,5), ABC(1,6), BC(7),
-
-  /* 9 arguments */
-  A(9), AB(8,1), AB(7,2), AB(6,3), AB(5,4), AB(4,5), AB(3,6), AB(2,7), AB(1,8), B(9),
-  AC(8), ABC(7,1), ABC(6,2), ABC(5,3), ABC(4,4), ABC(3,5), ABC(2,6), ABC(1,7), BC(8),
-
-  /* 10 arguments */
-  A(10), AB(9,1), AB(8,2), AB(7,3), AB(6,4), AB(5,5), AB(4,6), AB(3,7), AB(2,8), AB(1,9), B(10),
-  AC(9), ABC(8,1), ABC(7,2), ABC(6,3), ABC(5,4), ABC(4,5), ABC(3,6), ABC(2,7), ABC(1,8), BC(9),
+  if (idx >= names_array_size)
+    {
+      SCM *new_names;
+      uint32_t new_size;
+
+      if (names_array_size)
+        new_size = names_array_size * 2;
+      else
+        new_size = expected_subr_count;
+
+      new_names = SCM_GC_MALLOC (new_size * sizeof (SCM));
+      memcpy (new_names, names, names_array_size * sizeof (SCM));
+      while (names_array_size < new_size)
+        new_names[names_array_size++] = SCM_BOOL_F;
+      names = new_names;
+      names_array_size = new_size;
+    }
+
+  names[idx] = name;
+
+  scm_i_pthread_mutex_unlock (&admin_mutex);
+}
+
+
+
+struct code_arena {
+  struct code_arena *next;
+  size_t size;
+  size_t used;
+  char data[FLEXIBLE_ARRAY_MEMBER];
+};
+
+static struct code_arena *code_arena = NULL;
+
+static size_t
+round_up_power_of_two (size_t n, size_t m)
+{
+  return (n + (m-1)) & ~(m-1);
+}
+
+static struct code_arena *
+alloc_chunk (size_t size, struct code_arena *next)
+{
+  /* Leak the allocation, as we currently don't allow code to be
+     collected.  */
+  struct code_arena *ret = malloc (FLEXSIZEOF (struct code_arena, data, size));
+  if (!ret) abort ();
+  ret->next = next;
+  ret->size = size;
+  ret->used = 0;
+  return ret;
+}
+
+static char *
+alloc (size_t byte_size)
+{
+  char *ret;
+
+  byte_size = round_up_power_of_two (byte_size, sizeof (void *));
+
+  scm_i_pthread_mutex_lock (&admin_mutex);
+
+  if (code_arena == NULL || code_arena->size - code_arena->used < byte_size)
+    {
+      size_t chunk_size;
+      size_t avg_code_size = 6 * sizeof(uint32_t);
+      avg_code_size += sizeof (struct scm_jit_function_data);
+
+      chunk_size = expected_subr_count * avg_code_size;
+      if (chunk_size < byte_size)
+        chunk_size = byte_size;
+
+      code_arena = alloc_chunk (chunk_size, code_arena);
+    }
+
+  ret = &code_arena->data[code_arena->used];
+  code_arena->used += byte_size;
+
+  scm_i_pthread_mutex_unlock (&admin_mutex);
+
+  memset (ret, 0, byte_size);
+
+  return ret;
+}
+
+uint32_t *
+scm_i_alloc_primitive_code_with_instrumentation (size_t uint32_count,
+                                                 uint32_t **write_ptr)
+{
+  char *ptr;
+  uint32_t *ret;
+  struct scm_jit_function_data *data;
+  size_t byte_size, padded_byte_size;
+
+  /* Reserve space for instrument-entry.  */
+  byte_size = (2 + uint32_count) * sizeof (uint32_t);
+  padded_byte_size = round_up_power_of_two (byte_size, sizeof (void *));
+  /* Reserve space for jit data.  */
+  ptr = alloc (padded_byte_size + sizeof (struct scm_jit_function_data));
+  ret = (uint32_t *) ptr;
+  data = (struct scm_jit_function_data*) (ptr + padded_byte_size);
+
+  ret[0] = SCM_PACK_OP_24 (instrument_entry, 0);
+  ret[1] = padded_byte_size / 4;
+
+  *write_ptr = ret + 2;
+
+  data->mcode = NULL;
+  data->counter = 0;
+  data->start = -padded_byte_size;
+  data->end = -(padded_byte_size - byte_size);
+
+  return ret;
+}
+
+static int
+is_primitive_code (const void *ptr)
+{
+  const char *cptr = ptr;
+  int ret = 0;
+  struct code_arena *arena;
+
+  scm_i_pthread_mutex_lock (&admin_mutex);
+  for (arena = code_arena; arena; arena = arena->next)
+    if (&arena->data[0] <= cptr && cptr < &arena->data[arena->used])
+      {
+        ret = 1;
+        break;
+      }
+  scm_i_pthread_mutex_unlock (&admin_mutex);
+
+  return ret;
+}
+
+static uint32_t *
+alloc_subr_code (uint32_t subr_idx, uint32_t code[], size_t code_size)
+{
+  uint32_t post[3] = { SCM_PACK_OP_24 (subr_call, subr_idx),
+                       SCM_PACK_OP_24 (handle_interrupts, 0),
+                       SCM_PACK_OP_24 (return_values, 0) };
+  uint32_t *ret, *write;
+
+  ret = scm_i_alloc_primitive_code_with_instrumentation (code_size + 3, &write);
+
+  memcpy (write, code, code_size * sizeof (uint32_t));
+  write += code_size;
+  memcpy (write, post, 3 * sizeof (uint32_t));
+
+  return ret;
+}
+
+enum arity_kind {
+  NULLARY = 0,
+  REQ = 1,
+  OPT = 2,
+  REST = 4,
+  REQ_OPT = REQ + OPT,
+  REQ_REST = REQ + REST,
+  OPT_REST = OPT + REST,
+  REQ_OPT_REST = REQ + OPT + REST
 };
 
-#undef A
-#undef B
-#undef C
-#undef AB
-#undef AC
-#undef BC
-#undef ABC
-
-/* (nargs * nargs) + nopt + rest * (nargs + 1) */
-#define SUBR_STUB_CODE(nreq,nopt,rest)                                \
-  &subr_stub_code[((nreq + nopt + rest) * (nreq + nopt + rest)        \
-                   + nopt + rest * (nreq + nopt + rest + 1)) * 6]
-
-static const scm_t_uint32*
-get_subr_stub_code (unsigned int nreq, unsigned int nopt, unsigned int rest)
+static uint32_t*
+get_subr_stub_code (uint32_t subr_idx,
+                    unsigned int nreq, unsigned int nopt, unsigned int rest)
 {
+  enum arity_kind kind = NULLARY;
+
   if (SCM_UNLIKELY (rest > 1 || nreq + nopt + rest > 10))
     scm_out_of_range ("make-subr", scm_from_uint (nreq + nopt + rest));
       
-  return SUBR_STUB_CODE (nreq, nopt, rest);
+  if (nreq) kind += REQ;
+  if (nopt) kind += OPT;
+  if (rest) kind += REST;
+
+  switch (kind)
+    {
+    case NULLARY:
+    case REQ:
+      {
+        uint32_t code[1] = { SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1) };
+        return alloc_subr_code (subr_idx, code, 1);
+      }
+    case OPT:
+      {
+        uint32_t code[2] = { SCM_PACK_OP_24 (assert_nargs_le, nopt + 1),
+                             SCM_PACK_OP_24 (bind_optionals, nopt + 1) };
+        return alloc_subr_code (subr_idx, code, 2);
+      }
+    case REST:
+      {
+        uint32_t code[1] = { SCM_PACK_OP_24 (bind_rest, 1) };
+        return alloc_subr_code (subr_idx, code, 1);
+      }
+    case REQ_OPT:
+      {
+        uint32_t code[3] = { SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),
+                             SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1),
+                             SCM_PACK_OP_24 (bind_optionals, nreq + nopt + 1) };
+        return alloc_subr_code (subr_idx, code, 3);
+      }
+    case REQ_REST:
+      {
+        uint32_t code[2] = { SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),
+                             SCM_PACK_OP_24 (bind_rest, nreq + 1) };
+        return alloc_subr_code (subr_idx, code, 2);
+      }
+    case OPT_REST:
+      {
+        uint32_t code[2] = { SCM_PACK_OP_24 (bind_optionals, nopt + 1),
+                             SCM_PACK_OP_24 (bind_rest, nopt + 1) };
+        return alloc_subr_code (subr_idx, code, 2);
+      }
+    case REQ_OPT_REST:
+      {
+        uint32_t code[3] = { SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1),
+                             SCM_PACK_OP_24 (bind_optionals, nreq + nopt + 1),
+                             SCM_PACK_OP_24 (bind_rest, nreq + nopt + 1) };
+        return alloc_subr_code (subr_idx, code, 3);
+      }
+    default:
+      abort ();
+    }
 }
 
 static SCM
 create_subr (int define, const char *name,
              unsigned int nreq, unsigned int nopt, unsigned int rest,
-             SCM (*fcn) (), SCM *generic_loc)
+             void *fcn, SCM *generic_loc)
 {
   SCM ret, sname;
+  uint32_t idx;
   scm_t_bits flags;
-  scm_t_bits nfree = generic_loc ? 3 : 2;
+  scm_t_bits nfree = generic_loc ? 1 : 0;
 
+  idx = alloc_subr_idx (fcn);
   sname = scm_from_utf8_symbol (name);
 
   flags = SCM_F_PROGRAM_IS_PRIMITIVE;
   flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
 
   ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
-  SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (nreq, nopt, rest));
-  SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
-  SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
+  SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (idx, nreq, nopt, rest));
+  record_subr_name (idx, sname);
   if (generic_loc)
-    SCM_PROGRAM_FREE_VARIABLE_SET (ret, 2,
-                                       scm_from_pointer (generic_loc, NULL));
+    SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0,
+                                   scm_from_pointer (generic_loc, NULL));
 
   if (define)
     scm_define (sname, ret);
@@ -266,35 +361,113 @@ create_subr (int define, const char *name,
 }
 
 int
-scm_i_primitive_code_p (const scm_t_uint32 *code)
+scm_i_primitive_code_p (const uint32_t *code)
 {
-  if (code < subr_stub_code)
-    return 0;
-  if (code > subr_stub_code + (sizeof(subr_stub_code) / sizeof(scm_t_uint32)))
-    return 0;
+  return is_primitive_code (code);
+}
+
+static uintptr_t
+primitive_call_ip (const uint32_t *code)
+{
+  int direction = 0;
+  while (1)
+    {
+      switch (code[0] & 0xff)
+        {
+        case scm_op_instrument_entry:
+          if (direction < 0) abort ();
+          direction = 1;
+          code += 2;
+          break;
+        case scm_op_assert_nargs_ee:
+        case scm_op_assert_nargs_le:
+        case scm_op_assert_nargs_ge:
+        case scm_op_bind_optionals:
+        case scm_op_bind_rest:
+        case scm_op_alloc_frame:
+          if (direction < 0) abort ();
+          direction = 1;
+          code += 1;
+          break;
+        case scm_op_subr_call:
+        case scm_op_foreign_call:
+          return (uintptr_t) code;
+        case scm_op_return_values:
+        case scm_op_handle_interrupts:
+          /* Going back isn't possible for instruction streams where we
+             don't know the length of the preceding instruction, but for
+             the code we emit, these particular opcodes are only ever
+             preceded by 4-byte instructions.  */
+          if (direction > 0) abort ();
+          direction = -1;
+          code -= 1;
+          break;
+        default:
+          return 0;
+        }
+    }
+}
+
+static const uint32_t NOT_A_SUBR_CALL = 0xffffffff;
 
-  return 1;
+static uint32_t
+primitive_subr_idx (const uint32_t *code)
+{
+  uint32_t word;
+  uintptr_t call_ip = primitive_call_ip (code);
+  if (call_ip == 0)
+    return NOT_A_SUBR_CALL;
+  word = ((uint32_t *) call_ip)[0];
+  if ((word & 0xff) == scm_op_subr_call)
+    {
+      uint32_t idx = word >> 8;
+      if (idx >= next_subr_idx) abort();
+      return idx;
+    }
+  else
+    return NOT_A_SUBR_CALL;
 }
 
-scm_t_uintptr
+uintptr_t
 scm_i_primitive_call_ip (SCM subr)
 {
-  size_t i;
-  const scm_t_uint32 *code = SCM_PROGRAM_CODE (subr);
-
-  /* A stub is 6 32-bit words long, or 24 bytes.  The call will be one
-     instruction, in either the fourth, third, or second word.  Return a
-     byte offset from the entry.  */
-  for (i = 1; i < 4; i++)
-    if ((code[i] & 0xff) == scm_op_subr_call)
-      return (scm_t_uintptr) (code + i);
-  abort ();
+  return primitive_call_ip (SCM_PROGRAM_CODE (subr));
 }
 
 SCM
-scm_apply_subr (union scm_vm_stack_element *sp, scm_t_ptrdiff nslots)
+scm_i_primitive_name (const uint32_t *code)
 {
-  SCM (*subr)() = SCM_SUBRF (sp[nslots - 1].as_scm);
+  uint32_t idx = primitive_subr_idx (code);
+  if (idx == NOT_A_SUBR_CALL)
+    return SCM_BOOL_F;
+  return names[idx];
+}
+
+scm_t_subr
+scm_subr_function_by_index (uint32_t idx)
+{
+  if (idx == NOT_A_SUBR_CALL)
+    abort ();
+  return subrs[idx];
+}  
+
+scm_t_subr
+scm_subr_function (SCM subr)
+{
+  uint32_t idx = primitive_subr_idx (SCM_PROGRAM_CODE (subr));
+  return scm_subr_function_by_index (idx);
+}
+
+SCM
+scm_subr_name (SCM subr)
+{
+  return scm_i_primitive_name (SCM_PROGRAM_CODE (subr));
+}
+
+SCM
+scm_apply_subr (union scm_vm_stack_element *sp, uint32_t idx, ptrdiff_t nslots)
+{
+  SCM (*subr)() = subrs[idx];
 
 #define ARG(i) (sp[i].as_scm)
   switch (nslots - 1)
@@ -369,11 +542,5 @@ scm_c_define_gsubr_with_generic (const char *name,
 void
 scm_init_gsubr()
 {
-#include "libguile/gsubr.x"
+#include "gsubr.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 83eebc371..91a1104b6 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_GSUBR_H
 #define SCM_GSUBR_H
 
-/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2006, 2008, 2009,
- *   2010, 2011, 2013, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2006,2008,2009-2011,2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/snarf.h"
 
 
 
@@ -40,26 +38,30 @@
 
 #define SCM_PRIMITIVE_GENERIC_P(x) (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x))
 
-#define SCM_SUBRF(x)							\
-  ((SCM (*) (void))                                                     \
-   SCM_POINTER_VALUE (SCM_PROGRAM_FREE_VARIABLE_REF (x, 0)))
-
-#define SCM_SUBR_NAME(x) (SCM_PROGRAM_FREE_VARIABLE_REF (x, 1))
+#define SCM_SUBRF(x) scm_subr_function (x)
+#define SCM_SUBR_NAME(x) scm_subr_name (x)
 
 #define SCM_SUBR_GENERIC(x)						\
-  ((SCM *) SCM_POINTER_VALUE (SCM_PROGRAM_FREE_VARIABLE_REF (x, 2)))
+  ((SCM *) SCM_POINTER_VALUE (SCM_PROGRAM_FREE_VARIABLE_REF (x, 0)))
 
 #define SCM_SET_SUBR_GENERIC(x, g) \
   (*SCM_SUBR_GENERIC (x) = (g))
 
 
 
-SCM_INTERNAL int scm_i_primitive_code_p (const scm_t_uint32 *code);
-SCM_INTERNAL scm_t_uintptr scm_i_primitive_call_ip (SCM subr);
+SCM_INTERNAL uint32_t *
+scm_i_alloc_primitive_code_with_instrumentation (size_t uint32_count,
+                                                 uint32_t **write_ptr);
+SCM_INTERNAL int scm_i_primitive_code_p (const uint32_t *code);
+SCM_INTERNAL uintptr_t scm_i_primitive_call_ip (SCM subr);
+SCM_INTERNAL SCM scm_i_primitive_name (const uint32_t *code);
+
+SCM_API scm_t_subr scm_subr_function (SCM subr);
+SCM_INTERNAL scm_t_subr scm_subr_function_by_index (uint32_t subr_idx);
+SCM_API SCM scm_subr_name (SCM subr);
 
-union scm_vm_stack_element;
 SCM_INTERNAL SCM scm_apply_subr (union scm_vm_stack_element *sp,
-                                 scm_t_ptrdiff nargs);
+                                 uint32_t subr_idx, ptrdiff_t nargs);
 
 SCM_API SCM scm_c_make_gsubr (const char *name,
 			      int req, int opt, int rst, scm_t_subr fcn);
@@ -72,12 +74,77 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
 					     int req, int opt, int rst,
 					     scm_t_subr fcn, SCM *gf);
 
+
+
+/* Casting to a function that can take any number of arguments.  */
+#define SCM_FUNC_CAST_ARBITRARY_ARGS  scm_t_subr
+
+#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
+SCM_SNARF_HERE(\
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
+SCM FNAME ARGLIST\
+)\
+SCM_SNARF_INIT(\
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
+                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+)\
+SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
+
+/* Always use the generic subr case.  */
+#define SCM_DEFINE SCM_DEFINE_GSUBR
+
+
+#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
+SCM_SNARF_HERE(\
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
+static SCM g_ ## FNAME; \
+SCM FNAME ARGLIST\
+)\
+SCM_SNARF_INIT(\
+g_ ## FNAME = SCM_PACK (0); \
+scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
+                    		 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
+				 &g_ ## FNAME); \
+)\
+SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
+
+#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
+SCM_SNARF_HERE(\
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
+SCM FNAME ARGLIST\
+)\
+SCM_SNARF_INIT(\
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
+                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+scm_c_export (s_ ## FNAME, NULL); \
+)\
+SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
+
+#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
+                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
+
+#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
+                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
+SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
+               "implemented by the C function \"" #CFN "\"")
+
+#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF)  \
+SCM_SNARF_HERE(\
+SCM_UNUSED static const char RANAME[]=STR;\
+static SCM GF \
+)SCM_SNARF_INIT(\
+GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
+scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
+                                 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
+)
+
+
+
+
 SCM_INTERNAL void scm_init_gsubr (void);
 
 #endif  /* SCM_GSUBR_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 2c63b580d..fa8c8b8f7 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1998-2001, 2006, 2008, 2009, 2011-2013, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998-2001,2006,2008-2009,2011-2013,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 /* This is an implementation of guardians as described in
@@ -49,19 +49,22 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/smob.h"
-#include "libguile/validate.h"
-#include "libguile/hashtab.h"
-#include "libguile/deprecation.h"
-#include "libguile/eval.h"
-
-#include "libguile/guardians.h"
-#include "libguile/bdw-gc.h"
-
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "deprecation.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "print.h"
+#include "smob.h"
+#include "threads.h"
+#include "weak-vector.h"
 
+#include "guardians.h"
 
 
 static scm_t_bits tc16_guardian;
@@ -374,11 +377,5 @@ scm_init_guardians ()
   scm_set_smob_print (tc16_guardian, guardian_print);
   scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 1, 0);
 
-#include "libguile/guardians.x"
+#include "guardians.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/guardians.h b/libguile/guardians.h
index a23026d6c..7a081bd5c 100644
--- a/libguile/guardians.h
+++ b/libguile/guardians.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_GUARDIANS_H
 #define SCM_GUARDIANS_H
 
-/* Copyright (C) 1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API SCM scm_make_guardian (void);
 
@@ -34,9 +33,3 @@ SCM_INTERNAL int scm_i_mark_inaccessible_guardeds (void);
 SCM_INTERNAL void scm_init_guardians (void);
 
 #endif  /* SCM_GUARDIANS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/guile.c b/libguile/guile.c
index f827d2642..fa5fef928 100644
--- a/libguile/guile.c
+++ b/libguile/guile.c
@@ -1,24 +1,23 @@
-/* Copyright (C) 1996, 1997, 2000, 2001, 2006, 2008,
- *   2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-1997,2000-2001,2006,2008,2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* This is the 'main' function for the `guile' executable.  It is not
-   included in libguile.a.
 
    Eventually, we hope this file will be automatically generated,
    based on the list of installed, statically linked libraries on the
@@ -28,21 +27,16 @@
 #  include <config.h>
 #endif
 
-#ifdef __MINGW32__
-# define SCM_IMPORT 1
-#endif
-#include <libguile.h>
-
-#ifdef HAVE_CONFIG_H
-#include <libguile/scmconfig.h>
-#endif
 #include <ltdl.h>
 #include <locale.h>
+#include <stdio.h>
 
 #ifdef HAVE_WINSOCK2_H
 #include <winsock2.h>
 #endif
 
+#include <libguile.h>
+
 static void
 inner_main (void *closure SCM_UNUSED, int argc, char **argv)
 {
@@ -101,9 +95,3 @@ main (int argc, char **argv)
   scm_boot_guile (argc, argv, inner_main, 0);
   return 0; /* never reached */
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hash.c b/libguile/hash.c
index 604708438..d6e93dae0 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,24 +1,25 @@
-/* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2014, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
@@ -28,18 +29,24 @@
 #endif
 
 #include <math.h>
+#include <string.h>
 #include <unistr.h>
 
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/symbols.h"
-#include "libguile/syntax.h"
-#include "libguile/vectors.h"
+#include "chars.h"
+#include "foreign.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "strings.h"
+#include "struct.h"
+#include "symbols.h"
+#include "syntax.h"
+#include "vectors.h"
+
+#include "hash.h"
+
 
-#include "libguile/validate.h"
-#include "libguile/hash.h"
 
 
 #ifndef floor
@@ -75,10 +82,10 @@ extern double floor();
 
 #define JENKINS_LOOKUP3_HASHWORD2(k, length, ret)                       \
   do {                                                                  \
-    scm_t_uint32 a, b, c;                                               \
+    uint32_t a, b, c;                                                   \
                                                                         \
     /* Set up the internal state.  */                                   \
-    a = b = c = 0xdeadbeef + ((scm_t_uint32)(length<<2)) + 47;          \
+    a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + 47;              \
                                                                         \
     /* Handle most of the key.  */                                      \
     while (length > 3)                                                  \
@@ -110,7 +117,7 @@ extern double floor();
 
 
 static unsigned long
-narrow_string_hash (const scm_t_uint8 *str, size_t len)
+narrow_string_hash (const uint8_t *str, size_t len)
 {
   unsigned long ret;
   JENKINS_LOOKUP3_HASHWORD2 (str, len, ret);
@@ -133,7 +140,7 @@ scm_i_string_hash (SCM str)
   size_t len = scm_i_string_length (str);
 
   if (scm_i_is_narrow_string (str))
-    return narrow_string_hash ((const scm_t_uint8 *) scm_i_string_chars (str),
+    return narrow_string_hash ((const uint8_t *) scm_i_string_chars (str),
                                len);
   else
     return wide_string_hash (scm_i_string_wide_chars (str), len);
@@ -151,21 +158,21 @@ scm_i_latin1_string_hash (const char *str, size_t len)
   if (len == (size_t) -1)
     len = strlen (str);
 
-  return narrow_string_hash ((const scm_t_uint8 *) str, len);
+  return narrow_string_hash ((const uint8_t *) str, len);
 }
 
 /* A tricky optimization, but probably worth it.  */
 unsigned long 
 scm_i_utf8_string_hash (const char *str, size_t len)
 {
-  const scm_t_uint8 *end, *ustr = (const scm_t_uint8 *) str;
+  const uint8_t *end, *ustr = (const uint8_t *) str;
   unsigned long ret;
 
   /* The length of the string in characters.  This name corresponds to
      Jenkins' original name.  */
   size_t length;
 
-  scm_t_uint32 a, b, c, u32;
+  uint32_t a, b, c, u32;
 
   if (len == (size_t) -1)
     len = strlen (str);
@@ -179,7 +186,7 @@ scm_i_utf8_string_hash (const char *str, size_t len)
   length = u8_strnlen (ustr, len);
 
   /* Set up the internal state.  */
-  a = b = c = 0xdeadbeef + ((scm_t_uint32)(length<<2)) + 47;
+  a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + 47;
 
   /* Handle most of the key.  */
   while (length > 3)
@@ -227,42 +234,21 @@ static unsigned long scm_raw_ihash (SCM obj, size_t depth);
 static unsigned long
 scm_i_struct_hash (SCM obj, size_t depth)
 {
-  SCM layout;
-  scm_t_bits *data;
   size_t struct_size, field_num;
   unsigned long hash;
 
-  layout = SCM_STRUCT_LAYOUT (obj);
-  struct_size = scm_i_symbol_length (layout) / 2;
-  data = SCM_STRUCT_DATA (obj);
+  struct_size = SCM_STRUCT_SIZE (obj);
 
   hash = scm_raw_ihashq (SCM_UNPACK (SCM_STRUCT_VTABLE (obj)));
   if (depth > 0)
-    for (field_num = 0; field_num < struct_size; field_num++)
-      {
-        int protection;
-
-        protection = scm_i_symbol_ref (layout, field_num * 2 + 1);
-        if (protection != 'h' && protection != 'o')
-          {
-            int type;
-            type = scm_i_symbol_ref (layout, field_num * 2);
-            switch (type)
-              {
-              case 'p':
-                hash ^= scm_raw_ihash (SCM_PACK (data[field_num]),
-                                       depth / 2);
-                break;
-              case 'u':
-                hash ^= scm_raw_ihashq (data[field_num]);
-                break;
-              default:
-                /* Ignore 's' fields.  */;
-              }
-          }
-      }
-
-  /* FIXME: Tail elements should be taken into account.  */
+    {
+      for (field_num = 0; field_num < struct_size; field_num++)
+        if (SCM_STRUCT_FIELD_IS_UNBOXED (obj, field_num))
+          hash ^= scm_raw_ihashq (SCM_STRUCT_DATA_REF (obj, field_num));
+        else
+          hash ^= scm_raw_ihash (SCM_STRUCT_SLOT_REF (obj, field_num),
+                                 depth / 2);
+    }
 
   return hash;
 }
@@ -322,7 +308,7 @@ scm_raw_ihash (SCM obj, size_t depth)
     case scm_tc7_symbol:
       return scm_i_symbol_hash (obj);
     case scm_tc7_pointer:
-      return scm_raw_ihashq ((scm_t_uintptr) SCM_POINTER_VALUE (obj));
+      return scm_raw_ihashq ((uintptr_t) SCM_POINTER_VALUE (obj));
     case scm_tc7_wvect:
     case scm_tc7_vector:
       {
@@ -448,12 +434,6 @@ SCM_DEFINE (scm_hash, "hash", 2, 0, 0,
 void
 scm_init_hash ()
 {
-#include "libguile/hash.x"
+#include "hash.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hash.h b/libguile/hash.h
index 9085bc037..0e82b4afc 100644
--- a/libguile/hash.h
+++ b/libguile/hash.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_HASH_H
 #define SCM_HASH_H
 
-/* Copyright (C) 1995, 1996, 2000, 2006, 2008, 2011,
- *   2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008,2011,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -45,9 +43,3 @@ SCM_API SCM scm_hash (SCM obj, SCM n);
 SCM_INTERNAL void scm_init_hash (void);
 
 #endif  /* SCM_HASH_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 8920e08a6..b4f004c1d 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2003-2004,2006,2008-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,19 +24,25 @@
 #endif
 
 #include <alloca.h>
-#include <stdio.h>
 #include <assert.h>
+#include <stdio.h>
 
-#include "libguile/_scm.h"
-#include "libguile/alist.h"
-#include "libguile/hash.h"
-#include "libguile/eval.h"
-#include "libguile/vectors.h"
-#include "libguile/ports.h"
-#include "libguile/bdw-gc.h"
+#include "alist.h"
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "eq.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "procs.h"
+#include "vectors.h"
+#include "weak-table.h"
 
-#include "libguile/validate.h"
-#include "libguile/hashtab.h"
+#include "hashtab.h"
 
 
 
@@ -60,7 +66,7 @@
 static unsigned long hashtable_size[] = {
   31, 61, 113, 223, 443, 883, 1759, 3517, 7027, 14051, 28099, 56197, 112363,
   224717, 449419, 898823, 1797641, 3595271, 7190537, 14381041
-#if SIZEOF_SCM_T_BITS > 4
+#if SIZEOF_UINTPTR_T > 4
   /* vector lengths are stored in the first word of vectors, shifted by
      8 bits for the tc8, so for 32-bit we only get 2^24-1 = 16777215
      elements.  But we allow a few more sizes for 64-bit. */
@@ -1069,11 +1075,5 @@ scm_internal_hash_for_each_handle (scm_t_hash_handle_fn fn, void *closure,
 void
 scm_init_hashtab ()
 {
-#include "libguile/hashtab.x"
+#include "hashtab.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 82ed22e66..61e81b341 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_HASHTAB_H
 #define SCM_HASHTAB_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1999-2001,2003-2004,2006,2008-2009,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/gc.h"
 
 
 
@@ -139,9 +138,3 @@ SCM_INTERNAL void scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pst
 SCM_INTERNAL void scm_init_hashtab (void);
 
 #endif  /* SCM_HASHTAB_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hooks.c b/libguile/hooks.c
index 2a953a9b7..bc1bf93e4 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -1,119 +1,44 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2003,2006,2008-2009,2011,2018
+     Free Software Foundation, Inc.
 
+   This file is part of Guile.
 
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-#include <stdio.h>
-#include "libguile/_scm.h"
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/procprop.h"
-#include "libguile/smob.h"
-#include "libguile/strings.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-#include "libguile/validate.h"
-#include "libguile/hooks.h"
 
 
-/* C level hooks
- *
- * Currently, this implementation is separate from the Scheme level
- * hooks.  The possibility exists to implement the Scheme level hooks
- * using C level hooks.
- */
 
-/* Hint for `scm_gc_malloc ()' and friends.  */
-static const char hook_entry_gc_hint[] = "hook entry";
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
-void
-scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
-{
-  hook->first = 0;
-  hook->type = type;
-  hook->data = hook_data;
-}
+#include <stdio.h>
 
-void
-scm_c_hook_add (scm_t_c_hook *hook,
-		scm_t_c_hook_function func,
-		void *fn_data, 
-		int appendp)
-{
-  scm_t_c_hook_entry *entry;
-  scm_t_c_hook_entry **loc = &hook->first;
-
-  entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
-  if (appendp)
-    while (*loc)
-      loc = &(*loc)->next;
-  entry->next = *loc;
-  entry->func = func;
-  entry->data = fn_data;
-  *loc = entry;
-}
+#include "boolean.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "procprop.h"
+#include "smob.h"
+#include "strings.h"
 
-void
-scm_c_hook_remove (scm_t_c_hook *hook,
-		   scm_t_c_hook_function func,
-		   void *fn_data)
-{
-  scm_t_c_hook_entry **loc = &hook->first;
-  while (*loc)
-    {
-      if ((*loc)->func == func && (*loc)->data == fn_data)
-	{
-	  *loc = (*loc)->next;
-	  return;
-	}
-      loc = &(*loc)->next;
-    }
-  fprintf (stderr, "Attempt to remove non-existent hook function\n");
-  abort ();
-}
+#include "hooks.h"
 
-void *
-scm_c_hook_run (scm_t_c_hook *hook, void *data)
-{
-  scm_t_c_hook_entry *entry = hook->first;
-  scm_t_c_hook_type type = hook->type;
-  void *res = 0;
-  while (entry)
-    {
-      res = (entry->func) (hook->data, entry->data, data);
-      if (res)
-	{
-	  if (type == SCM_C_HOOK_OR)
-	    break;
-	}
-      else
-	{
-	  if (type == SCM_C_HOOK_AND)
-	    break;
-	}
-      entry = entry->next;
-    }
-  return res;
-}
 
 
 /* Scheme level hooks
@@ -305,11 +230,5 @@ scm_init_hooks ()
 {
   scm_tc16_hook = scm_make_smob_type ("hook", 0);
   scm_set_smob_print (scm_tc16_hook, hook_print);
-#include "libguile/hooks.x"
+#include "hooks.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/hooks.h b/libguile/hooks.h
index dc930cb0a..3cc37bf37 100644
--- a/libguile/hooks.h
+++ b/libguile/hooks.h
@@ -1,72 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_HOOKS_H
 #define SCM_HOOKS_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-#include "libguile/__scm.h"
-
-/*
- * C level hooks
- */
+/* Copyright 1995-1996,1999,2000-2001,2006,2008-2009,2018
+     Free Software Foundation, Inc.
 
-/*
- * The interface is designed for and- and or-type hooks which
- * both may want to indicate success/failure and return a result.
- */
+   This file is part of Guile.
 
-typedef enum scm_t_c_hook_type {
-  SCM_C_HOOK_NORMAL,
-  SCM_C_HOOK_OR,
-  SCM_C_HOOK_AND
-} scm_t_c_hook_type;
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-typedef void  *(*scm_t_c_hook_function) (void *hook_data,
-					 void *fn_data,
-					 void *data);
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-typedef struct scm_t_c_hook_entry {
-  struct scm_t_c_hook_entry *next;
-  scm_t_c_hook_function func;
-  void *data;
-} scm_t_c_hook_entry;
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-typedef struct scm_t_c_hook {
-  scm_t_c_hook_entry *first;
-  scm_t_c_hook_type type;
-  void *data;
-} scm_t_c_hook;
+
 
-SCM_API void scm_c_hook_init (scm_t_c_hook *hook,
-			      void *hook_data,
-			      scm_t_c_hook_type type);
-SCM_API void scm_c_hook_add (scm_t_c_hook *hook,
-			     scm_t_c_hook_function func,
-			     void *fn_data, 
-			     int appendp);
-SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
-				scm_t_c_hook_function func,
-				void *fn_data);
-SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
+#include <libguile/error.h>
+#include <libguile/smob.h>
 
 /*
  * Scheme level hooks
@@ -79,6 +36,8 @@ SCM_API scm_t_bits scm_tc16_hook;
 #define SCM_HOOK_PROCEDURES(hook)	SCM_SMOB_OBJECT (hook)
 #define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_SMOB_OBJECT ((hook), (procs))
 
+#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook")
+
 SCM_API SCM scm_make_hook (SCM n_args);
 SCM_API SCM scm_hook_p (SCM x);
 SCM_API SCM scm_hook_empty_p (SCM hook);
@@ -92,9 +51,3 @@ SCM_API SCM scm_hook_to_list (SCM hook);
 SCM_INTERNAL void scm_init_hooks (void);
 
 #endif  /* SCM_HOOKS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 5e6783700..fc47fdfe5 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,38 +1,27 @@
-/* Copyright (C) 2006-2014, 2017, 2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2006-2014,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <alloca.h>
-
-#include "libguile/_scm.h"
-#include "libguile/extensions.h"
-#include "libguile/feature.h"
-#include "libguile/i18n.h"
-#include "libguile/strings.h"
-#include "libguile/chars.h"
-#include "libguile/dynwind.h"
-#include "libguile/validate.h"
-#include "libguile/values.h"
-#include "libguile/threads.h"
-
 #include <locale.h>
 #include <string.h> /* `strcoll ()' */
 #include <ctype.h>  /* `toupper ()' et al. */
@@ -40,6 +29,28 @@
 #include <unicase.h>
 #include <unistr.h>
 
+#include "boolean.h"
+#include "chars.h"
+#include "dynwind.h"
+#include "extensions.h"
+#include "feature.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "posix.h"  /* for `scm_i_locale_mutex' */
+#include "smob.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "threads.h"
+#include "values.h"
+#include "variable.h"
+#include "version.h"
+
+#include "i18n.h"
+
 #ifndef SCM_MAX_ALLOCA
 # define SCM_MAX_ALLOCA 4096 /* Max bytes per string to allocate via alloca */
 #endif
@@ -61,8 +72,6 @@
 # define USE_GNU_LOCALE_API
 #endif
 
-#include "libguile/posix.h"  /* for `scm_i_locale_mutex' */
-
 /* Use Gnulib's header, which also provides `nl_item' & co.  */
 #include <langinfo.h>
 
@@ -797,11 +806,11 @@ compare_u32_strings (SCM s1, SCM s2, SCM locale, const char *func_name)
 
   if (c_locale)
     RUN_IN_LOCALE_SECTION (c_locale, 
-                           result = u32_strcoll ((const scm_t_uint32 *) c_s1, 
-                                                 (const scm_t_uint32 *) c_s2));
+                           result = u32_strcoll ((const uint32_t *) c_s1, 
+                                                 (const uint32_t *) c_s2));
   else
-    result = u32_strcoll ((const scm_t_uint32 *) c_s1,
-			  (const scm_t_uint32 *) c_s2);
+    result = u32_strcoll ((const uint32_t *) c_s1,
+			  (const uint32_t *) c_s2);
 
   SCM_CLEANUP_U32_BUF(c_s1, c_s1_malloc_p);
   SCM_CLEANUP_U32_BUF(c_s2, c_s2_malloc_p);
@@ -824,8 +833,8 @@ locale_language ()
 }
 
 static inline int
-u32_locale_casecoll (const char *func_name, const scm_t_uint32 *c_s1,
-                     const scm_t_uint32 *c_s2,
+u32_locale_casecoll (const char *func_name, const uint32_t *c_s1,
+                     const uint32_t *c_s2,
 		     int *result)
 {
   /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
@@ -858,13 +867,13 @@ compare_u32_strings_ci (SCM s1, SCM s2, SCM locale, const char *func_name)
     RUN_IN_LOCALE_SECTION
       (c_locale,
        ret = u32_locale_casecoll (func_name,
-				  (const scm_t_uint32 *) c_s1,
-				  (const scm_t_uint32 *) c_s2,
+				  (const uint32_t *) c_s1,
+				  (const uint32_t *) c_s2,
 				  &result));
   else
     ret = u32_locale_casecoll (func_name,
-			       (const scm_t_uint32 *) c_s1,
-			       (const scm_t_uint32 *) c_s2,
+			       (const uint32_t *) c_s1,
+			       (const uint32_t *) c_s2,
 			       &result);
 
   SCM_CLEANUP_U32_BUF(c_s1, c_s1_malloc_p);
@@ -1085,16 +1094,16 @@ SCM_DEFINE (scm_char_locale_ci_eq, "char-locale-ci=?", 2, 1, 0,
 /* Locale-dependent alphabetic character mapping.  */
 
 static inline int
-u32_locale_tocase (const scm_t_uint32 *c_s1, size_t len,
-                   scm_t_uint32 **p_c_s2, size_t * p_len2,
-                   scm_t_uint32 *(*func) (const scm_t_uint32 *, size_t,
+u32_locale_tocase (const uint32_t *c_s1, size_t len,
+                   uint32_t **p_c_s2, size_t * p_len2,
+                   uint32_t *(*func) (const uint32_t *, size_t,
                                           const char *, uninorm_t,
-                                          scm_t_uint32 *, size_t *))
+                                          uint32_t *, size_t *))
 {
   /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must not
      make any non-local exit.  */
 
-  scm_t_uint32 *ret;
+  uint32_t *ret;
   const char *loc = locale_language ();
 
   /* The first NULL here indicates that no NFC or NFKC normalization
@@ -1104,7 +1113,7 @@ u32_locale_tocase (const scm_t_uint32 *c_s1, size_t len,
 
   if (ret == NULL)
     {
-      *p_c_s2 = (scm_t_uint32 *) NULL;
+      *p_c_s2 = (uint32_t *) NULL;
       *p_len2 = 0;
       return errno;
     }
@@ -1116,15 +1125,15 @@ u32_locale_tocase (const scm_t_uint32 *c_s1, size_t len,
 
 static SCM
 chr_to_case (SCM chr, scm_t_locale c_locale, 
-	     scm_t_uint32 *(*func) (const scm_t_uint32 *, size_t, const char *,
-				    uninorm_t, scm_t_uint32 *, size_t *),
+	     uint32_t *(*func) (const uint32_t *, size_t, const char *,
+				    uninorm_t, uint32_t *, size_t *),
 	     const char *func_name,
 	     int *err)
 #define FUNC_NAME func_name
 {
   int ret;
-  scm_t_uint32 c;
-  scm_t_uint32 *convbuf;
+  uint32_t c;
+  uint32_t *convbuf;
   size_t convlen;
   SCM convchar;
 
@@ -1227,14 +1236,14 @@ SCM_DEFINE (scm_char_locale_titlecase, "char-locale-titlecase", 1, 1, 0,
 
 static SCM
 str_to_case (SCM str, scm_t_locale c_locale,
-	     scm_t_uint32 *(*func) (const scm_t_uint32 *, size_t, const char *,
-				    uninorm_t, scm_t_uint32 *, size_t *),
+	     uint32_t *(*func) (const uint32_t *, size_t, const char *,
+				    uninorm_t, uint32_t *, size_t *),
 	     const char *func_name,
 	     int *err)
 #define FUNC_NAME func_name
 {
   scm_t_wchar *c_str, *c_buf;
-  scm_t_uint32 *c_convstr;
+  uint32_t *c_convstr;
   size_t len, convlen;
   int ret, c_str_malloc_p;
   SCM convstr;
@@ -1246,12 +1255,12 @@ str_to_case (SCM str, scm_t_locale c_locale,
 
   if (c_locale)
     RUN_IN_LOCALE_SECTION (c_locale, ret =
-                           u32_locale_tocase ((scm_t_uint32 *) c_str, len,
+                           u32_locale_tocase ((uint32_t *) c_str, len,
                                               &c_convstr,
                                               &convlen, func));
   else
     ret =
-      u32_locale_tocase ((scm_t_uint32 *) c_str, len,
+      u32_locale_tocase ((uint32_t *) c_str, len,
                          &c_convstr, &convlen, func);
 
   SCM_CLEANUP_U32_BUF(c_str, c_str_malloc_p);
@@ -1403,7 +1412,7 @@ SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer",
   else
     result = scm_from_long (c_result);
 
-  return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str))));
+  return scm_values_2 (result, scm_from_long (c_endptr - c_str));
 }
 #undef FUNC_NAME
 
@@ -1447,7 +1456,7 @@ SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact",
   else
     result = scm_from_double (c_result);
 
-  return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str))));
+  return scm_values_2 (result, scm_from_long (c_endptr - c_str));
 }
 #undef FUNC_NAME
 
@@ -1878,7 +1887,7 @@ scm_init_i18n ()
   scm_add_feature ("nl-langinfo");
   define_langinfo_items ();
 
-#include "libguile/i18n.x"
+#include "i18n.x"
 
   /* Initialize the global locale object with a special `locale' SMOB.  */
   /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
@@ -1898,9 +1907,3 @@ scm_bootstrap_i18n ()
 
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/i18n.h b/libguile/i18n.h
index c2792aca0..8ce1ce8e6 100644
--- a/libguile/i18n.h
+++ b/libguile/i18n.h
@@ -1,27 +1,26 @@
-/* classes: h_files */
-
 #ifndef SCM_I18N_H
 #define SCM_I18N_H
 
-/* Copyright (C) 2006, 2008, 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-#include "libguile/__scm.h"
+/* Copyright 2006,2008-2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#include "libguile/scm.h"
 
 SCM_API SCM scm_global_locale;
 SCM_API SCM scm_make_locale (SCM category_mask, SCM locale_name, SCM base_locale);
@@ -52,9 +51,3 @@ SCM_INTERNAL void scm_bootstrap_i18n (void);
 
 
 #endif  /* SCM_I18N_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/init.c b/libguile/init.c
index 00d2e806a..e33a60324 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,153 +1,155 @@
-/* Copyright (C) 1995-2004, 2006, 2009-2014, 2016-2018
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2004,2006,2009-2014,2016-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-/* Include the headers for just about everything.
-   We call all their initialization functions.  */
 
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
-#include <stdlib.h>
+#include <fcntl.h>
 #include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
 #include <sys/stat.h>
-#include <fcntl.h>
-#include <gmp.h>
+#include <unistd.h>
 
-#include "libguile/_scm.h"
+#include <gmp.h>
 
 /* Everybody has an init function.  */
-#include "libguile/alist.h"
-#include "libguile/async.h"
-#include "libguile/atomic.h"
-#include "libguile/backtrace.h"
-#include "libguile/bitvectors.h"
-#include "libguile/boolean.h"
-#include "libguile/bytevectors.h"
-#include "libguile/chars.h"
-#include "libguile/control.h"
-#include "libguile/continuations.h"
-#include "libguile/debug.h"
+#include "alist.h"
+#include "array-map.h"
+#include "arrays.h"
+#include "async.h"
+#include "atomic.h"
+#include "backtrace.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "chars.h"
+#include "continuations.h"
+#include "control.h"
+#include "debug.h"
 #ifdef GUILE_DEBUG_MALLOC
-#include "libguile/debug-malloc.h"
+#include "debug-malloc.h"
 #endif
-#include "libguile/deprecation.h"
-#include "libguile/dynl.h"
-#include "libguile/dynwind.h"
-#include "libguile/eq.h"
-#include "libguile/error.h"
-#include "libguile/eval.h"
-#include "libguile/evalext.h"
-#include "libguile/expand.h"
-#include "libguile/fdes-finalizers.h"
-#include "libguile/feature.h"
-#include "libguile/filesys.h"
-#include "libguile/finalizers.h"
-#include "libguile/fluids.h"
-#include "libguile/fports.h"
-#include "libguile/frames.h"
-#include "libguile/gc.h"
-#include "libguile/generalized-arrays.h"
-#include "libguile/generalized-vectors.h"
-#include "libguile/goops.h"
-#include "libguile/gsubr.h"
-#include "libguile/hash.h"
-#include "libguile/hashtab.h"
-#include "libguile/hooks.h"
-#include "libguile/gettext.h"
-#include "libguile/i18n.h"
-#include "libguile/instructions.h"
-#include "libguile/ioext.h"
-#include "libguile/keywords.h"
-#include "libguile/list.h"
-#include "libguile/load.h"
-#include "libguile/macros.h"
-#include "libguile/mallocs.h"
-#include "libguile/memoize.h"
-#include "libguile/modules.h"
-#include "libguile/net_db.h"
-#include "libguile/numbers.h"
-#include "libguile/loader.h"
-#include "libguile/objprop.h"
-#include "libguile/options.h"
-#include "libguile/pairs.h"
-#include "libguile/poll.h"
-#include "libguile/ports.h"
-#include "libguile/posix.h"
+#include "deprecated.h"
+#include "deprecation.h"
+#include "dynl.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "error.h"
+#include "eval.h"
+#include "evalext.h"
+#include "expand.h"
+#include "extensions.h"
+#include "fdes-finalizers.h"
+#include "feature.h"
+#include "filesys.h"
+#include "finalizers.h"
+#include "fluids.h"
+#include "foreign-object.h"
+#include "foreign.h"
+#include "fports.h"
+#include "frames.h"
+#include "gc.h"
+#include "generalized-arrays.h"
+#include "generalized-vectors.h"
+#include "gettext.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "guardians.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "hooks.h"
+#include "i18n.h"
+#include "instructions.h"
+#include "intrinsics.h"
+#include "ioext.h"
+#include "jit.h"
+#include "keywords.h"
+#include "list.h"
+#include "load.h"
+#include "loader.h"
+#include "macros.h"
+#include "mallocs.h"
+#include "memoize.h"
+#include "modules.h"
+#include "net_db.h"
+#include "numbers.h"
+#include "objprop.h"
+#include "options.h"
+#include "pairs.h"
+#include "poll.h"
+#include "ports.h"
+#include "posix.h"
+#include "print.h"
+#include "private-options.h"
+#include "procprop.h"
+#include "procs.h"
+#include "programs.h"
+#include "promises.h"
 #ifdef ENABLE_REGEX
-#include "libguile/regex-posix.h"
+#include "regex-posix.h"
 #endif
-#include "libguile/print.h"
-#include "libguile/procprop.h"
-#include "libguile/procs.h"
-#include "libguile/programs.h"
-#include "libguile/promises.h"
-#include "libguile/array-map.h"
-#include "libguile/random.h"
-#include "libguile/rdelim.h"
-#include "libguile/read.h"
-#include "libguile/rw.h"
-#include "libguile/scmsigs.h"
-#include "libguile/script.h"
-#include "libguile/simpos.h"
-#include "libguile/smob.h"
-#include "libguile/socket.h"
-#include "libguile/sort.h"
-#include "libguile/srcprop.h"
-#include "libguile/stackchk.h"
-#include "libguile/stacks.h"
-#include "libguile/stime.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-1.h"
-#include "libguile/srfi-4.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
-#include "libguile/srfi-60.h"
-#include "libguile/strorder.h"
-#include "libguile/strports.h"
-#include "libguile/struct.h"
-#include "libguile/symbols.h"
-#include "libguile/syntax.h"
-#include "libguile/throw.h"
-#include "libguile/arrays.h"
-#include "libguile/trees.h"
-#include "libguile/unicode.h"
-#include "libguile/values.h"
-#include "libguile/variable.h"
-#include "libguile/vectors.h"
-#include "libguile/version.h"
-#include "libguile/vm.h"
-#include "libguile/vports.h"
-#include "libguile/guardians.h"
-#include "libguile/extensions.h"
-#include "libguile/uniform.h"
-#include "libguile/deprecated.h"
-
-#include "libguile/init.h"
-#include "libguile/private-options.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-#include <unistd.h>
+#include "r6rs-ports.h"
+#include "random.h"
+#include "rdelim.h"
+#include "read.h"
+#include "rw.h"
+#include "scmsigs.h"
+#include "script.h"
+#include "simpos.h"
+#include "smob.h"
+#include "socket.h"
+#include "sort.h"
+#include "srcprop.h"
+#include "srfi-1.h"
+#include "srfi-13.h"
+#include "srfi-14.h"
+#include "srfi-4.h"
+#include "srfi-60.h"
+#include "stackchk.h"
+#include "stacks.h"
+#include "stime.h"
+#include "strings.h"
+#include "strorder.h"
+#include "strports.h"
+#include "struct.h"
+#include "symbols.h"
+#include "syntax.h"
+#include "throw.h"
+#include "trees.h"
+#include "unicode.h"
+#include "uniform.h"
+#include "values.h"
+#include "variable.h"
+#include "vectors.h"
+#include "version.h"
+#include "vm.h"
+#include "vports.h"
+#include "weak-set.h"
+#include "weak-table.h"
+#include "weak-vector.h"
+
+#include "init.h"
 
 
 
@@ -258,12 +260,6 @@ scm_load_startup_files ()
 
 /* The main init code.  */
 
-#ifdef _UNICOS
-typedef int setjmp_type;
-#else
-typedef long setjmp_type;
-#endif
-
 /* All the data needed to invoke the main function.  */
 struct main_func_closure
 {
@@ -397,6 +393,7 @@ scm_i_init_guile (void *base)
   scm_init_array_handle ();
   scm_bootstrap_bytevectors ();   /* Requires array-handle */
   scm_bootstrap_instructions ();
+  scm_bootstrap_intrinsics ();
   scm_bootstrap_loader ();
   scm_bootstrap_programs ();
   scm_bootstrap_vm ();
@@ -516,6 +513,9 @@ scm_i_init_guile (void *base)
   scm_bootstrap_i18n ();
   scm_init_script ();
   scm_init_unicode ();
+#if ENABLE_JIT
+  scm_init_jit ();
+#endif
 
   scm_init_goops ();
 
@@ -542,9 +542,3 @@ scm_i_init_guile (void *base)
   /* Finally, cause finalizers to run in a separate thread.  */
   scm_init_finalizer_thread ();
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/init.h b/libguile/init.h
index bc6cddf93..4d597ec24 100644
--- a/libguile/init.h
+++ b/libguile/init.h
@@ -1,29 +1,27 @@
-/* classes: h_files */
-
 #ifndef SCM_INIT_H
 #define SCM_INIT_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/threads.h"
 
 
@@ -43,9 +41,3 @@ SCM_INTERNAL void scm_i_init_guile (void *base);
 SCM_API void scm_load_startup_files (void);
 
 #endif  /* SCM_INIT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/inline.c b/libguile/inline.c
index 3ad55269e..900b3253e 100644
--- a/libguile/inline.c
+++ b/libguile/inline.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 2001, 2006, 2008, 2011-2013, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2008,2011-2013,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -23,10 +23,11 @@
 
 #define SCM_IMPLEMENT_INLINES 1
 #define SCM_INLINE_C_IMPLEMENTING_INLINES 1
-#include "libguile/inline.h"
-#include "libguile/array-handle.h"
-#include "libguile/chars.h"
-#include "libguile/gc.h"
-#include "libguile/smob.h"
-#include "libguile/pairs.h"
-#include "libguile/ports.h"
+
+#include "array-handle.h"
+#include "chars.h"
+#include "gc.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "strings.h"
diff --git a/libguile/inline.h b/libguile/inline.h
index 3c9b09b6a..1a3b8bb64 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -1,57 +1,96 @@
-/* classes: h_files */
-
 #ifndef SCM_INLINE_H
 #define SCM_INLINE_H
 
-/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010,
- *   2011, 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001-2004,2006,2008-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* This file is for inline functions.  On platforms that don't support
    inlining functions, they are turned into ordinary functions.  On
    platforms that do support inline functions, the definitions are still
    compiled into the library, once, in inline.c.  */
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
-#include "libguile/gc.h"
-#include "libguile/threads.h"
-#include "libguile/array-handle.h"
-#include "libguile/ports.h"
-#include "libguile/numbers.h"
-#include "libguile/error.h"
+/* Define SCM_C_INLINE_KEYWORD so that it can be used as a replacement
+   for the "inline" keyword, expanding to nothing when "inline" is not
+   available.
+*/
 
+#ifdef SCM_C_INLINE
+#define SCM_C_INLINE_KEYWORD SCM_C_INLINE
+#else
+#define SCM_C_INLINE_KEYWORD
+#endif
 
-SCM_INLINE int scm_is_string (SCM x);
+/* We would like gnu89 extern inline semantics, not C99 extern inline
+   semantics, so that we can be sure to avoid reifying definitions of
+   inline functions in all compilation units, which is a possibility at
+   low optimization levels, or if a user takes the address of an inline
+   function.
 
-SCM_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
-SCM_INLINE SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
-			     scm_t_bits ccr, scm_t_bits cdr);
-SCM_INLINE SCM scm_words (scm_t_bits car, scm_t_uint32 n_words);
+   Hence the `__gnu_inline__' attribute, in accordance with:
+   http://gcc.gnu.org/gcc-4.3/porting_to.html .
 
-#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
-/* Either inlining, or being included from inline.c.  */
+   With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline
+   semantics are not supported), but a warning is issued in C99 mode if
+   `__gnu_inline__' is not used.
 
-SCM_INLINE_IMPLEMENTATION int
-scm_is_string (SCM x)
-{
-  return SCM_HAS_TYP7 (x, scm_tc7_string);
-}
+   Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in
+   C99 mode and doesn't define `__GNUC_STDC_INLINE__'.  Fall back to "static
+   inline" in that case.  */
 
+# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L))
+#  if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2)
+#   define SCM_C_EXTERN_INLINE					\
+           extern __inline__ __attribute__ ((__gnu_inline__))
+#  else
+#   define SCM_C_EXTERN_INLINE extern __inline__
+#  endif
+# endif
+
+/* SCM_INLINE is a macro prepended to all public inline function
+   declarations.  Implementations of those functions should also be in
+   the header file, prefixed by SCM_INLINE_IMPLEMENTATION, and protected
+   by SCM_CAN_INLINE.  Non-inline definitions will be reified into
+   inline.c.  See strings.h for an example usage, for scm_is_string.  */
+
+#if defined SCM_IMPLEMENT_INLINES
+/* Reifying functions to a file, whether or not inlining is available.  */
+# define SCM_CAN_INLINE 0
+# define SCM_INLINE SCM_API
+# define SCM_INLINE_IMPLEMENTATION
+#elif defined SCM_C_INLINE
+/* Declarations when inlining is available.  */
+# define SCM_CAN_INLINE 1
+# ifdef SCM_C_EXTERN_INLINE
+#  define SCM_INLINE SCM_C_EXTERN_INLINE
+# else
+/* Fall back to static inline if GNU "extern inline" is unavailable.  */
+#  define SCM_INLINE static SCM_C_INLINE
+# endif
+# define SCM_INLINE_IMPLEMENTATION SCM_INLINE
+#else
+/* Declarations when inlining is not available.  */
+# define SCM_CAN_INLINE 0
+# define SCM_INLINE SCM_API
+/* Don't define SCM_INLINE_IMPLEMENTATION; it should never be seen in
+   this case.  */
 #endif
-#endif
+
+#endif /* SCM_INLINE_H */
diff --git a/libguile/instructions.c b/libguile/instructions.c
index 29e60983b..ddd88b311 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -1,29 +1,35 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2013,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include <string.h>
-
-#include "_scm.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "symbols.h"
 #include "threads.h"
+#include "version.h"
+
 #include "instructions.h"
 
 
@@ -40,12 +46,14 @@ SCM_SYMBOL (sym_bang, "!");
     M(X8_S8_I16)                                \
     M(X8_S12_S12)                               \
     M(X8_S12_C12)                               \
+    M(X8_S12_Z12)                               \
     M(X8_C12_C12)                               \
     M(X8_F12_F12)                               \
     M(X8_S8_S8_S8)                              \
     M(X8_S8_C8_S8)                              \
     M(X8_S8_S8_C8)                              \
     M(C8_C24)                                   \
+    M(C8_S24)                                   \
     M(C32) /* Unsigned. */                      \
     M(I32) /* Immediate. */                     \
     M(A32) /* Immediate, high bits. */          \
@@ -65,7 +73,8 @@ SCM_SYMBOL (sym_bang, "!");
     M(B1_X7_C24)                                \
     M(B1_X7_S24)                                \
     M(B1_X7_F24)                                \
-    M(B1_X31)
+    M(B1_X31)                                   \
+    M(C16_C16)
 
 #define TYPE_WIDTH 6
 
@@ -95,7 +104,7 @@ static SCM word_type_symbols[] =
    by Scheme to generate assemblers and disassemblers for the
    instructions.  */
 
-#define NOP SCM_T_UINT64_MAX
+#define NOP UINT64_MAX
 #define OP1(type0) \
   (OP (0, type0))
 #define OP2(type0, type1) \
@@ -109,6 +118,12 @@ static SCM word_type_symbols[] =
 
 #define OP_DST (1 << (TYPE_WIDTH * 5))
 
+#define DOP1(t0)                 (OP1(t0) | OP_DST)
+#define DOP2(t0, t1)             (OP2(t0, t1) | OP_DST)
+#define DOP3(t0, t1, t2)         (OP3(t0, t1, t2) | OP_DST)
+#define DOP4(t0, t1, t2, t3)     (OP4(t0, t1, t2, t3) | OP_DST)
+#define DOP5(t0, t1, t2, t3, t4) (OP5(t0, t1, t2, t3, t4) | OP_DST)
+
 #define WORD_TYPE_AND_FLAG(n, word) \
   (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
 #define WORD_TYPE(n, word) \
@@ -119,7 +134,7 @@ static SCM word_type_symbols[] =
 /* Scheme interface */
 
 static SCM
-parse_instruction (scm_t_uint8 opcode, const char *name, scm_t_uint64 meta)
+parse_instruction (uint8_t opcode, const char *name, uint64_t meta)
 {
   SCM tail = SCM_EOL;
   int len;
@@ -193,12 +208,6 @@ scm_init_instructions (void)
 #undef INIT
 
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/instructions.x"
+#include "instructions.x"
 #endif
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/instructions.h b/libguile/instructions.h
index ad058cd9d..e36bdc2bc 100644
--- a/libguile/instructions.h
+++ b/libguile/instructions.h
@@ -1,25 +1,26 @@
-/* Copyright (C) 2001, 2009, 2012, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009,2012-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_INSTRUCTIONS_H_
 #define _SCM_INSTRUCTIONS_H_
 
-#include <libguile.h>
+#include <libguile/scm.h>
 #include <libguile/vm-operations.h>
 
 #ifdef BUILDING_LIBGUILE
@@ -49,9 +50,3 @@ SCM_INTERNAL void scm_bootstrap_instructions (void);
 SCM_INTERNAL void scm_init_instructions (void);
 
 #endif /* _SCM_INSTRUCTIONS_H_ */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
new file mode 100644
index 000000000..ced371161
--- /dev/null
+++ b/libguile/intrinsics.c
@@ -0,0 +1,532 @@
+/* Copyright 2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "alist.h"
+#include "atomics-internal.h"
+#include "boolean.h"
+#include "cache-internal.h"
+#include "extensions.h"
+#include "fluids.h"
+#include "frames.h"
+#include "gc-inline.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "modules.h"
+#include "numbers.h"
+#include "symbols.h"
+#include "threads.h"
+#include "version.h"
+
+#include "intrinsics.h"
+
+
+struct scm_vm_intrinsics scm_vm_intrinsics;
+
+SCM_DEFINE (scm_intrinsic_list, "intrinsic-list", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_intrinsic_list
+{
+  SCM list = SCM_EOL;
+
+#define ADD_INTRINSIC(type, id, name, ID)                   \
+  if (name)                                                 \
+    list = scm_acons (scm_from_latin1_symbol (name),        \
+                      scm_from_int (SCM_VM_INTRINSIC_##ID), \
+                      list);
+  SCM_FOR_ALL_VM_INTRINSICS (ADD_INTRINSIC);
+#undef ADD_INTRINSIC
+
+  return list;
+}
+#undef FUNC_NAME
+
+static SCM
+add_immediate (SCM a, uint8_t b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a)))
+    {
+      scm_t_signed_bits sum = SCM_I_INUM (a) + b;
+
+      if (SCM_LIKELY (SCM_POSFIXABLE (sum)))
+        return SCM_I_MAKINUM (sum);
+    }
+
+  return scm_sum (a, scm_from_uint8 (b));
+}
+
+static SCM
+sub_immediate (SCM a, uint8_t b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a)))
+    {
+      scm_t_signed_bits diff = SCM_I_INUM (a) - b;
+
+      if (SCM_LIKELY (SCM_NEGFIXABLE (diff)))
+        return SCM_I_MAKINUM (diff);
+    }
+
+  return scm_difference (a, scm_from_uint8 (b));
+}
+
+static void
+string_set_x (SCM str, size_t idx, uint32_t ch)
+{
+  str = scm_i_string_start_writing (str);
+  scm_i_string_set_x (str, idx, ch);
+  scm_i_string_stop_writing ();
+}
+
+static SCM
+string_to_number (SCM str)
+{
+  return scm_string_to_number (str, SCM_UNDEFINED /* radix = 10 */);
+}
+
+static uint64_t
+scm_to_uint64_truncate (SCM x)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (x)))
+    return (uint64_t) SCM_I_INUM (x);
+  else
+    return scm_to_uint64 (scm_logand (x, scm_from_uint64 ((uint64_t) -1)));
+}
+
+#if INDIRECT_INT64_INTRINSICS
+static void
+indirect_scm_to_int64 (int64_t *dst, SCM x)
+{
+  *dst = scm_to_int64 (x);
+}
+static void
+indirect_scm_to_uint64 (uint64_t *dst, SCM x)
+{
+  *dst = scm_to_uint64 (x);
+}
+static void
+indirect_scm_to_uint64_truncate (uint64_t *dst, SCM x)
+{
+  *dst = scm_to_uint64_truncate (x);
+}
+static SCM
+indirect_scm_from_int64 (int64_t *src)
+{
+  return scm_from_int64 (*src);
+}
+static SCM
+indirect_scm_from_uint64 (uint64_t *src)
+{
+  return scm_from_uint64 (*src);
+}
+#endif
+
+static SCM
+logsub (SCM x, SCM y)
+{
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
+    {
+      scm_t_signed_bits a, b;
+
+      a = SCM_I_INUM (x);
+      b = SCM_I_INUM (y);
+
+      return SCM_I_MAKINUM (a & ~b);
+    }
+
+  return scm_logand (x, scm_lognot (y));
+}
+
+static void
+wind (scm_thread *thread, SCM winder, SCM unwinder)
+{
+  scm_dynstack_push_dynwind (&thread->dynstack, winder, unwinder);
+}
+
+static void
+unwind (scm_thread *thread)
+{
+  scm_dynstack_pop (&thread->dynstack);
+}
+
+static void
+push_fluid (scm_thread *thread, SCM fluid, SCM value)
+{
+  scm_dynstack_push_fluid (&thread->dynstack, fluid, value,
+                           thread->dynamic_state);
+}
+
+static void
+pop_fluid (scm_thread *thread)
+{
+  scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
+}
+
+static SCM
+fluid_ref (scm_thread *thread, SCM fluid)
+{
+  struct scm_cache_entry *entry;
+
+  /* If we find FLUID in the cache, then it is indeed a fluid.  */
+  entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
+  if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)
+                  && !SCM_UNBNDP (SCM_PACK (entry->value))))
+    return SCM_PACK (entry->value);
+
+  return scm_fluid_ref (fluid);
+}
+
+static void
+fluid_set_x (scm_thread *thread, SCM fluid, SCM value)
+{
+  struct scm_cache_entry *entry;
+
+  /* If we find FLUID in the cache, then it is indeed a fluid.  */
+  entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
+  if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)))
+    entry->value = SCM_UNPACK (value);
+  else
+    scm_fluid_set_x (fluid, value);
+}
+
+static void
+push_dynamic_state (scm_thread *thread, SCM state)
+{
+  scm_dynstack_push_dynamic_state (&thread->dynstack, state,
+                                   thread->dynamic_state);
+}
+
+static void
+pop_dynamic_state (scm_thread *thread)
+{
+  scm_dynstack_unwind_dynamic_state (&thread->dynstack,
+                                     thread->dynamic_state);
+}
+
+static SCM
+lsh (SCM a, uint64_t b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a))
+      && b < (uint64_t) (SCM_I_FIXNUM_BIT - 1)
+      && ((scm_t_bits)
+          (SCM_SRS (SCM_I_INUM (a), (SCM_I_FIXNUM_BIT-1 - b)) + 1)
+          <= 1))
+    {
+      scm_t_signed_bits nn = SCM_I_INUM (a);
+      return SCM_I_MAKINUM (nn < 0 ? -(-nn << b) : (nn << b));
+    }
+  else
+    return scm_ash (a, scm_from_uint64 (b));
+}
+
+static SCM
+rsh (SCM a, uint64_t b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a)))
+    {
+      if (b > (uint64_t) (SCM_I_FIXNUM_BIT - 1))
+        b = SCM_I_FIXNUM_BIT - 1;
+      return SCM_I_MAKINUM (SCM_SRS (SCM_I_INUM (a), b));
+    }
+  else
+    return scm_ash (a, scm_difference (SCM_INUM0, scm_from_uint64 (b)));
+}
+
+#if INDIRECT_INT64_INTRINSICS
+static SCM
+indirect_lsh (SCM a, uint64_t *b)
+{
+  return lsh (a, *b);
+}
+static SCM
+indirect_rsh (SCM a, uint64_t *b)
+{
+  return rsh (a, *b);
+}
+#endif
+
+static SCM
+lsh_immediate (SCM a, uint8_t b)
+{
+  return lsh (a, b);
+}
+
+static SCM
+rsh_immediate (SCM a, uint8_t b)
+{
+  return rsh (a, b);
+}
+
+static enum scm_compare
+less_p (SCM a, SCM b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a) && SCM_I_INUMP (b)))
+    {
+      scm_t_signed_bits a_bits = SCM_UNPACK (a);
+      scm_t_signed_bits b_bits = SCM_UNPACK (b);
+      return a_bits < b_bits ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
+    }
+
+  if (scm_is_true (scm_nan_p (a)) || scm_is_true (scm_nan_p (b)))
+    return SCM_F_COMPARE_INVALID;
+  else if (scm_is_true (scm_less_p (a, b)))
+    return SCM_F_COMPARE_LESS_THAN;
+  else
+    return SCM_F_COMPARE_NONE;
+}
+
+static int
+numerically_equal_p (SCM a, SCM b)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (a) && SCM_I_INUMP (b)))
+    return scm_is_eq (a, b);
+
+  return scm_is_true (scm_num_eq_p (a, b));
+}
+
+static SCM
+resolve_module (SCM name, uint8_t public_p)
+{
+  SCM mod;
+
+  if (!scm_module_system_booted_p)
+    return SCM_BOOL_F;
+
+  mod = scm_maybe_resolve_module (name);
+  if (scm_is_false (mod))
+    scm_misc_error (NULL, "Module named ~s does not exist",
+                    scm_list_1 (name));
+
+  if (public_p)
+    {
+      mod = scm_module_public_interface (mod);
+
+      if (scm_is_false (mod))
+        scm_misc_error (NULL, "Module named ~s has no public interface",
+                        scm_list_1 (name));
+    }
+
+  return mod;
+}
+
+static SCM
+lookup (SCM module, SCM name)
+{
+  /* If MODULE was captured before modules were booted, use the root
+     module.  Not so nice, but hey...  */
+  if (scm_is_false (module))
+    module = scm_the_root_module ();
+
+  return scm_module_variable (module, name);
+}
+
+static void throw_ (SCM key, SCM args) SCM_NORETURN;
+static void throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN;
+static void throw_with_value_and_data (SCM val, SCM key_subr_and_message) SCM_NORETURN;
+
+static void
+throw_ (SCM key, SCM args)
+{
+  scm_throw (key, args);
+  abort(); /* not reached */
+}
+
+static void
+throw_with_value (SCM val, SCM key_subr_and_message)
+{
+  SCM key, subr, message, args, data;
+
+  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
+  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
+  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
+  args = scm_list_1 (val);
+  data = SCM_BOOL_F;
+
+  throw_ (key, scm_list_4 (subr, message, args, data));
+}
+
+static void
+throw_with_value_and_data (SCM val, SCM key_subr_and_message)
+{
+  SCM key, subr, message, args, data;
+
+  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
+  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
+  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
+  args = scm_list_1 (val);
+  data = args;
+
+  throw_ (key, scm_list_4 (subr, message, args, data));
+}
+
+static void error_wrong_num_args (scm_thread *) SCM_NORETURN;
+static void error_no_values (void) SCM_NORETURN;
+static void error_not_enough_values (void) SCM_NORETURN;
+static void error_wrong_number_of_values (uint32_t expected) SCM_NORETURN;
+
+static void
+error_wrong_num_args (scm_thread *thread)
+{
+  SCM callee = SCM_FRAME_LOCAL (thread->vm.fp, 0);
+  scm_wrong_num_args (callee);
+}
+
+static void
+error_no_values (void)
+{
+  scm_misc_error (NULL, "Zero values returned to single-valued continuation",
+                  SCM_EOL);
+}
+
+static void
+error_not_enough_values (void)
+{
+  scm_misc_error (NULL, "Too few values returned to continuation", SCM_EOL);
+}
+
+static void
+error_wrong_number_of_values (uint32_t expected)
+{
+  scm_misc_error (NULL,
+                  "Wrong number of values returned to continuation (expected ~a)",
+                  scm_list_1 (scm_from_uint32 (expected)));
+}
+
+static SCM
+allocate_words (scm_thread *thread, size_t n)
+{
+  return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
+}
+
+static SCM
+allocate_words_with_freelist (scm_thread *thread, size_t freelist_idx)
+{
+  return SCM_PACK_POINTER
+    (scm_inline_gc_alloc (&thread->freelists[freelist_idx],
+                          freelist_idx,
+                          SCM_INLINE_GC_KIND_NORMAL));
+}
+
+static SCM
+current_module (scm_thread *thread)
+{
+  return scm_i_current_module (thread);
+}
+
+static void
+push_prompt (scm_thread *thread, uint8_t escape_only_p,
+             SCM tag, const union scm_vm_stack_element *sp, uint32_t *vra,
+             uint8_t *mra)
+{
+  struct scm_vm *vp = &thread->vm;
+  scm_t_dynstack_prompt_flags flags;
+
+  flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
+  scm_dynstack_push_prompt (&thread->dynstack, flags, tag,
+                            vp->stack_top - vp->fp, vp->stack_top - sp,
+                            vra, mra, thread->vm.registers);
+}
+
+void
+scm_bootstrap_intrinsics (void)
+{
+  scm_vm_intrinsics.add = scm_sum;
+  scm_vm_intrinsics.add_immediate = add_immediate;
+  scm_vm_intrinsics.sub = scm_difference;
+  scm_vm_intrinsics.sub_immediate = sub_immediate;
+  scm_vm_intrinsics.mul = scm_product;
+  scm_vm_intrinsics.div = scm_divide;
+  scm_vm_intrinsics.quo = scm_quotient;
+  scm_vm_intrinsics.rem = scm_remainder;
+  scm_vm_intrinsics.mod = scm_modulo;
+  scm_vm_intrinsics.logand = scm_logand;
+  scm_vm_intrinsics.logior = scm_logior;
+  scm_vm_intrinsics.logxor = scm_logxor;
+  scm_vm_intrinsics.string_set_x = string_set_x;
+  scm_vm_intrinsics.string_to_number = string_to_number;
+  scm_vm_intrinsics.string_to_symbol = scm_string_to_symbol;
+  scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
+  scm_vm_intrinsics.class_of = scm_class_of;
+  scm_vm_intrinsics.scm_to_f64 = scm_to_double;
+#if INDIRECT_INT64_INTRINSICS
+  scm_vm_intrinsics.scm_to_u64 = indirect_scm_to_uint64;
+  scm_vm_intrinsics.scm_to_u64_truncate = indirect_scm_to_uint64_truncate;
+  scm_vm_intrinsics.scm_to_s64 = indirect_scm_to_int64;
+  scm_vm_intrinsics.u64_to_scm = indirect_scm_from_uint64;
+  scm_vm_intrinsics.s64_to_scm = indirect_scm_from_int64;
+#else
+  scm_vm_intrinsics.scm_to_u64 = scm_to_uint64;
+  scm_vm_intrinsics.scm_to_u64_truncate = scm_to_uint64_truncate;
+  scm_vm_intrinsics.scm_to_s64 = scm_to_int64;
+  scm_vm_intrinsics.u64_to_scm = scm_from_uint64;
+  scm_vm_intrinsics.s64_to_scm = scm_from_int64;
+#endif
+  scm_vm_intrinsics.logsub = logsub;
+  scm_vm_intrinsics.wind = wind;
+  scm_vm_intrinsics.unwind = unwind;
+  scm_vm_intrinsics.push_fluid = push_fluid;
+  scm_vm_intrinsics.pop_fluid = pop_fluid;
+  scm_vm_intrinsics.fluid_ref = fluid_ref;
+  scm_vm_intrinsics.fluid_set_x = fluid_set_x;
+  scm_vm_intrinsics.push_dynamic_state = push_dynamic_state;
+  scm_vm_intrinsics.pop_dynamic_state = pop_dynamic_state;
+#if INDIRECT_INT64_INTRINSICS
+  scm_vm_intrinsics.lsh = indirect_lsh;
+  scm_vm_intrinsics.rsh = indirect_rsh;
+#else
+  scm_vm_intrinsics.lsh = lsh;
+  scm_vm_intrinsics.rsh = rsh;
+#endif
+  scm_vm_intrinsics.lsh_immediate = lsh_immediate;
+  scm_vm_intrinsics.rsh_immediate = rsh_immediate;
+  scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p;
+  scm_vm_intrinsics.less_p = less_p;
+  scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
+  scm_vm_intrinsics.resolve_module = resolve_module;
+  scm_vm_intrinsics.lookup = lookup;
+  scm_vm_intrinsics.define_x = scm_module_ensure_local_variable;
+  scm_vm_intrinsics.throw_ = throw_;
+  scm_vm_intrinsics.throw_with_value = throw_with_value;
+  scm_vm_intrinsics.throw_with_value_and_data = throw_with_value_and_data;
+  scm_vm_intrinsics.error_wrong_num_args = error_wrong_num_args;
+  scm_vm_intrinsics.error_no_values = error_no_values;
+  scm_vm_intrinsics.error_not_enough_values = error_not_enough_values;
+  scm_vm_intrinsics.error_wrong_number_of_values = error_wrong_number_of_values;
+  scm_vm_intrinsics.allocate_words = allocate_words;
+  scm_vm_intrinsics.current_module = current_module;
+  scm_vm_intrinsics.push_prompt = push_prompt;
+  scm_vm_intrinsics.allocate_words_with_freelist = allocate_words_with_freelist;
+
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_intrinsics",
+                            (scm_t_extension_init_func)scm_init_intrinsics,
+                            NULL);
+}
+
+void
+scm_init_intrinsics (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "intrinsics.x"
+#endif
+}
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
new file mode 100644
index 000000000..de4f0e2d2
--- /dev/null
+++ b/libguile/intrinsics.h
@@ -0,0 +1,187 @@
+/* Copyright 2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#ifndef _SCM_INTRINSICS_H_
+#define _SCM_INTRINSICS_H_
+
+#ifndef BUILDING_LIBGUILE
+#error intrinsics.h is private and uninstalled
+#endif
+
+#include <setjmp.h>
+
+#include <libguile/scm.h>
+
+
+typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
+typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t);
+typedef void (*scm_t_scm_sz_u32_intrinsic) (SCM, size_t, uint32_t);
+typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
+typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
+
+/* If we don't have 64-bit registers, the intrinsics will take and
+   return 64-bit values by reference.  */
+#if SIZEOF_UINTPTR_T >= 8
+#define INDIRECT_INT64_INTRINSICS 0
+#else
+#define INDIRECT_INT64_INTRINSICS 1
+#endif
+
+#if INDIRECT_INT64_INTRINSICS
+typedef void (*scm_t_u64_from_scm_intrinsic) (uint64_t*, SCM);
+typedef void (*scm_t_s64_from_scm_intrinsic) (int64_t*, SCM);
+typedef SCM (*scm_t_scm_from_u64_intrinsic) (uint64_t*);
+typedef SCM (*scm_t_scm_from_s64_intrinsic) (int64_t*);
+typedef SCM (*scm_t_scm_from_scm_u64_intrinsic) (SCM, uint64_t*);
+#else
+typedef uint64_t (*scm_t_u64_from_scm_intrinsic) (SCM);
+typedef int64_t (*scm_t_s64_from_scm_intrinsic) (SCM);
+typedef SCM (*scm_t_scm_from_u64_intrinsic) (uint64_t);
+typedef SCM (*scm_t_scm_from_s64_intrinsic) (int64_t);
+typedef SCM (*scm_t_scm_from_scm_u64_intrinsic) (SCM, uint64_t);
+#endif
+
+typedef void (*scm_t_thread_intrinsic) (scm_thread*);
+typedef void (*scm_t_thread_scm_intrinsic) (scm_thread*, SCM);
+typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_thread*, SCM, SCM);
+typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_thread*, SCM);
+typedef int (*scm_t_bool_from_scm_scm_intrinsic) (SCM, SCM);
+typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
+typedef void (*scm_t_thread_sp_intrinsic) (scm_thread*, union scm_vm_stack_element*);
+typedef SCM (*scm_t_scm_from_thread_u32_intrinsic) (scm_thread*, uint32_t);
+typedef uint32_t (*scm_t_u32_from_thread_u32_u32_intrinsic) (scm_thread*, uint32_t, uint32_t);
+typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_thread*, uint32_t,
+                                                          uint32_t, SCM, uint8_t,
+                                                          uint8_t);
+typedef SCM (*scm_t_scm_from_scm_scm_scmp_sp_intrinsic) (SCM, SCM, SCM*,
+                                                         const union scm_vm_stack_element*);
+typedef void (*scm_t_thread_noreturn_intrinsic) (scm_thread*) SCM_NORETURN;
+typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORETURN;
+typedef int (*scm_t_int_from_scm_intrinsic) (SCM);
+typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN;
+typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN;
+typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
+typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
+typedef SCM (*scm_t_scm_from_thread_sz_intrinsic) (scm_thread*, size_t);
+typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
+typedef void (*scm_t_thread_u8_scm_sp_vra_mra_intrinsic) (scm_thread*,
+                                                          uint8_t, SCM,
+                                                          const union scm_vm_stack_element*,
+                                                          uint32_t*, uint8_t*);
+typedef void (*scm_t_thread_mra_intrinsic) (scm_thread*, uint8_t*);
+typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*);
+typedef uint8_t* (*scm_t_mra_from_thread_scm_intrinsic) (scm_thread*, SCM);
+typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*);
+typedef SCM (*scm_t_scm_from_ptr_intrinsic) (SCM*);
+typedef void (*scm_t_ptr_scm_intrinsic) (SCM*, SCM);
+typedef SCM (*scm_t_scm_from_ptr_scm_intrinsic) (SCM*, SCM);
+typedef SCM (*scm_t_scm_from_ptr_scm_scm_intrinsic) (SCM*, SCM, SCM);
+typedef uint32_t* scm_t_vcode_intrinsic;
+
+#define SCM_FOR_ALL_VM_INTRINSICS(M) \
+  M(scm_from_scm_scm, add, "add", ADD) \
+  M(scm_from_scm_uimm, add_immediate, "add/immediate", ADD_IMMEDIATE) \
+  M(scm_from_scm_scm, sub, "sub", SUB) \
+  M(scm_from_scm_uimm, sub_immediate, "sub/immediate", SUB_IMMEDIATE) \
+  M(scm_from_scm_scm, mul, "mul", MUL) \
+  M(scm_from_scm_scm, div, "div", DIV) \
+  M(scm_from_scm_scm, quo, "quo", QUO) \
+  M(scm_from_scm_scm, rem, "rem", REM) \
+  M(scm_from_scm_scm, mod, "mod", MOD) \
+  M(scm_from_scm_scm, logand, "logand", LOGAND) \
+  M(scm_from_scm_scm, logior, "logior", LOGIOR) \
+  M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \
+  M(scm_sz_u32, string_set_x, "string-set!", STRING_SET_X) \
+  M(scm_from_scm, string_to_number, "string->number", STRING_TO_NUMBER) \
+  M(scm_from_scm, string_to_symbol, "string->symbol", STRING_TO_SYMBOL) \
+  M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \
+  M(scm_from_scm, class_of, "class-of", CLASS_OF) \
+  M(f64_from_scm, scm_to_f64, "scm->f64", SCM_TO_F64) \
+  M(u64_from_scm, scm_to_u64, "scm->u64", SCM_TO_U64) \
+  M(u64_from_scm, scm_to_u64_truncate, "scm->u64/truncate", SCM_TO_U64_TRUNCATE) \
+  M(s64_from_scm, scm_to_s64, "scm->s64", SCM_TO_S64) \
+  M(scm_from_u64, u64_to_scm, "u64->scm", U64_TO_SCM) \
+  M(scm_from_s64, s64_to_scm, "s64->scm", S64_TO_SCM) \
+  M(scm_from_scm_scm, logsub, "logsub", LOGSUB) \
+  M(thread_scm_scm, wind, "wind", WIND) \
+  M(thread, unwind, "unwind", UNWIND) \
+  M(thread_scm_scm, push_fluid, "push-fluid", PUSH_FLUID) \
+  M(thread, pop_fluid, "pop-fluid", POP_FLUID) \
+  M(scm_from_thread_scm, fluid_ref, "fluid-ref", FLUID_REF) \
+  M(thread_scm_scm, fluid_set_x, "fluid-set!", FLUID_SET_X) \
+  M(thread_scm, push_dynamic_state, "push-dynamic-state", PUSH_DYNAMIC_STATE) \
+  M(thread, pop_dynamic_state, "pop-dynamic-state", POP_DYNAMIC_STATE) \
+  M(scm_from_scm_u64, lsh, "lsh", LSH) \
+  M(scm_from_scm_u64, rsh, "rsh", RSH) \
+  M(scm_from_scm_uimm, lsh_immediate, "lsh/immediate", LSH_IMMEDIATE) \
+  M(scm_from_scm_uimm, rsh_immediate, "rsh/immediate", RSH_IMMEDIATE) \
+  M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \
+  M(compare_from_scm_scm, less_p, "<?", LESS_P) \
+  M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
+  M(scm_from_scm_uimm, resolve_module, "resolve-module", RESOLVE_MODULE) \
+  M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
+  M(scm_from_scm_scm, define_x, "define!", DEFINE_X) \
+  M(thread_sp, expand_stack, "expand-stack", EXPAND_STACK) \
+  M(scm_from_thread_u32, cons_rest, "cons-rest", CONS_REST) \
+  M(u32_from_thread_u32_u32, compute_kwargs_npositional, "compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \
+  M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \
+  M(thread_mra, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \
+  M(thread_scm_scm, foreign_call, "foreign-call", FOREIGN_CALL) \
+  M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \
+  M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \
+  M(mra_from_thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \
+  M(thread, expand_apply_argument, "expand-apply-argument", EXPAND_APPLY_ARGUMENT) \
+  M(mra_from_thread_mra, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \
+  M(scm_scm_noreturn, throw_, "throw", THROW) \
+  M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \
+  M(scm_scm_noreturn, throw_with_value_and_data, "throw/value+data", THROW_WITH_VALUE_AND_DATA) \
+  M(thread_noreturn, error_wrong_num_args, "wrong-num-args", ERROR_WRONG_NUM_ARGS) \
+  M(noreturn, error_no_values, "no-values", ERROR_NO_VALUES) \
+  M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \
+  M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \
+  M(vra_from_thread, get_callee_vcode, "get-callee-vcode", GET_CALLEE_VCODE) \
+  M(scm_from_thread_sz, allocate_words, "allocate-words", ALLOCATE_WORDS) \
+  M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
+  M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT)     \
+  M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \
+  M(vcode, handle_interrupt_code, "%handle-interrupt-code", HANDLE_INTERRUPT_CODE) \
+  M(scm_from_thread_sz, allocate_words_with_freelist, "allocate-words/freelist", ALLOCATE_WORDS_WITH_FREELIST) \
+  /* Add new intrinsics here; also update scm_bootstrap_intrinsics.  */
+
+enum scm_vm_intrinsic
+  {
+#define DEFINE_ENUM(type, id, name, ID) SCM_VM_INTRINSIC_##ID,
+    SCM_FOR_ALL_VM_INTRINSICS(DEFINE_ENUM)
+#undef DEFINE_ENUM
+    SCM_VM_INTRINSIC_COUNT
+  };
+
+SCM_INTERNAL struct scm_vm_intrinsics
+{
+#define DEFINE_MEMBER(type, id, name, ID) scm_t_##type##_intrinsic id;
+    SCM_FOR_ALL_VM_INTRINSICS(DEFINE_MEMBER)
+#undef DEFINE_MEMBER
+} scm_vm_intrinsics;
+
+SCM_INTERNAL SCM scm_intrinsic_list (void);
+
+SCM_INTERNAL void scm_bootstrap_intrinsics (void);
+SCM_INTERNAL void scm_init_intrinsics (void);
+
+#endif /* _SCM_INTRINSICS_H_ */
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 4038fd54f..d08b68df3 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006,
- *   2011, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2003,2006,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,27 +24,35 @@
 #  include <config.h>
 #endif
 
-#include <stdio.h>
 #include <errno.h>
-
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/fdes-finalizers.h"
-#include "libguile/feature.h"
-#include "libguile/fports.h"
-#include "libguile/hashtab.h"
-#include "libguile/ioext.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-
 #include <fcntl.h>
+#include <stdio.h>
+#include <unistd.h>
 
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
-#include <unistd.h>
+
+#include "async.h"
+#include "dynwind.h"
+#include "extensions.h"
+#include "fdes-finalizers.h"
+#include "feature.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "strings.h"
+#include "syscalls.h"
+#include "weak-set.h"
+#include "version.h"
+
+#include "ioext.h"
+
+
 
 
 SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, 
@@ -307,7 +315,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
 static void
 scm_init_ice_9_ioext (void)
 {
-#include "libguile/ioext.x"
+#include "ioext.x"
 }
 
 void 
@@ -321,9 +329,3 @@ scm_init_ioext ()
 			    NULL);
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/ioext.h b/libguile/ioext.h
index 1b7b93aaf..807773a11 100644
--- a/libguile/ioext.h
+++ b/libguile/ioext.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_IOEXT_H
 #define SCM_IOEXT_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -39,9 +38,3 @@ SCM_API SCM scm_fdes_to_ports (SCM fd);
 SCM_INTERNAL void scm_init_ioext (void);
 
 #endif  /* SCM_IOEXT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/iselect.h b/libguile/iselect.h
index 945ad14af..3b66c0fc5 100644
--- a/libguile/iselect.h
+++ b/libguile/iselect.h
@@ -1,36 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_ISELECT_H
 #define SCM_ISELECT_H
 
-/* Copyright (C) 1997,1998,2000,2001, 2002, 2006,
- *   2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1997-1998,2000-2002,2006,2013,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
-/* Needed for FD_SET on some systems.  */
-#include <sys/types.h>
+
 
+#include <sys/types.h> /* Needed for FD_SET on some systems.  */
 #include <sys/select.h>
 
+#include "libguile/scm.h"
+
+
 SCM_API int scm_std_select (int fds,
 			    fd_set *rfds,
 			    fd_set *wfds,
@@ -40,9 +37,3 @@ SCM_API int scm_std_select (int fds,
 #define SELECT_TYPE fd_set
 
 #endif  /* SCM_ISELECT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/jit.c b/libguile/jit.c
new file mode 100644
index 000000000..700b1a468
--- /dev/null
+++ b/libguile/jit.c
@@ -0,0 +1,4896 @@
+/* Copyright 2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+/* All of this whole file is within an ENABLE_JIT flag.  */
+#if ENABLE_JIT
+
+#include <stdio.h>
+#include <sys/mman.h>
+
+#include <lightening.h>
+
+#include "frames.h"
+#include "gsubr.h"
+#include "gc-inline.h"
+#include "instructions.h"
+#include "intrinsics.h"
+#include "simpos.h" /* scm_getenv_int */
+#include "threads.h"
+#include "vm-builtins.h"
+#include "vm-operations.h"
+
+#include "jit.h"
+
+
+
+
+/* Guile's just-in-time (JIT) compiler is a simple "template JIT".  It
+   produces machine code corresponding to each VM instruction,
+   substituting in the arguments from the bytecode.  The generated code
+   performs the same operations on the Guile program state the VM
+   interpreter would: the same stack reads and writes, the same calls,
+   the same control flow: the same thing.  It's a very simple JIT.
+
+   This JIT uses GNU Lightning, a library for generating assembly code.
+   It has backends for every architecture you can think of.  Lightning
+   exposes a minimum of 3 "volatile" or "scratch" registers, those that
+   may be overwritten by called functions, and 3 "non-volatile" or
+   "preserved" registers, those whose values will persist over calls.
+   Guile's JIT uses two preserved registers for itself, to store the
+   current thread and the current stack pointer.  The other four
+   registers are available for the JIT.  However as Guile's JIT is
+   really simple and doesn't do register allocation, no other register
+   is live between bytecodes; the other four registers are just scratch
+   space.
+
+   Machine code emitted by the JIT (mcode) should only ever be entered
+   from the interpreter (the VM).  To enter bytecode, the interpreter
+   calls an "entry trampoline" that saves the needed non-volatile
+   registers, reserves some stack space, loads the thread and stack
+   pointer into the reserved registers, then jumps into the mcode.  The
+   mcode then does its thing.
+
+   When mcode needs to call out to another function, e.g. via the "call"
+   instruction, it makes a new frame in just the same way the VM would,
+   with the difference that it also sets the machine return address
+   (mRA) in the stack frame, in addition to the virtual (bytecode)
+   return address (vRA).  If the callee has mcode, then the caller jumps
+   to the callee's mcode.  It's a jump, not a call, as the stack is
+   maintained on the side: it's not the stack used by the e.g. x86
+   "call" instruction.
+
+   When mcode calls a function that doesn't have vcode, or returns to a
+   continuation that doesn't have vcode, the mcode simply returns to the
+   VM interpreter, allowing the interpreter to pick up from there.  The
+   return actually happens via an exit trampoline, which restores the
+   saved register values.
+
+   Every function in Guile's VM begins with an "instrument-entry"
+   instruction.  The instruction links to a statically allocated "struct
+   scm_jit_function_data" corresponding to that function.  When the
+   interpreter sees instrument-entry, first it checks that if the
+   function has mcode, by looking in the scm_jit_function_data.  If it
+   has mcode, the interpreter enters mcode directly, as described above.
+
+   If a function doesn't have mcode, "instrument-entry" will increment a
+   counter in the scm_jit_function_data.  If the counter exceeds a
+   threshold, the interpreter will ask the JIT compiler to produce
+   mcode.  If the JIT compiler was able to do so (always possible except
+   in case of resource exhaustion), then it sets the mcode pointer in
+   the scm_jit_function_data, and returns the mcode pointer to the
+   interpreter.  At that point the interpreter will enter mcode.
+
+   If the counter value does not exceed the threshold, then the VM
+   will interpret the function instead of running compiled code.
+
+   Additionally, Guile puts an "instrument-loop" instruction into the
+   body of each loop iteration.  It works similarly, except that the
+   returned mcode pointer starts in the middle of the function, at the
+   point that corresponds to the program point of the "instrument-loop"
+   instruction.  The idea is that some functions have long-running loops
+   in them, and it would be a shame to have to wait until the next time
+   they're called to enter mcode.  Being able to "tier up" from inside a
+   loop reduces overall program latency.
+
+   Think of the JIT as microarchitecture.  The interpreter specifies the
+   architecture of the VM, in terms of the stack, stack and frame
+   pointers, and a virtual instruction pointer.  Sometimes this
+   architectural state is manipulated by the interpreter.  Sometimes
+   it's compiled down to native code.  But the existence of native code
+   is a detail that's fully encapsulated; systems-oriented Guile Scheme
+   can walk stacks, throw errors, reinstate partial continuations, and
+   so on without being aware of the existence of the JIT.  */
+
+
+
+
+static const uint32_t default_jit_threshold = 1000;
+
+/* Threshold for when to JIT-compile a function.  Set from the
+   GUILE_JIT_THRESHOLD environment variable.  */
+uint32_t scm_jit_counter_threshold = -1;
+
+/* If positive, stop JIT compilation after the Nth compilation.  Useful
+   for hunting down bugs.  */
+static int jit_stop_after = -1;
+
+/* If nonzero, pause when stopping JIT compilation after the Nth
+   compilation.  For debugging.  */
+static int jit_pause_when_stopping = 0;
+
+/* Log level for JIT events.  0 means off.  */
+static int jit_log_level = 0;
+
+/* Entry trampoline: saves registers, initializes THREAD and SP
+   registers, and jumps into mcode. */
+static void (*enter_mcode) (scm_thread *thread, const uint8_t *mcode);
+
+/* Exit trampoline: restores registers and returns to interpreter.  */
+static void *exit_mcode;
+
+/* Handle interrupts trampoline: the slow path of the handle-interrupts
+   instruction, compiled as a stub on the side to reduce code size.  */
+static void *handle_interrupts_trampoline;
+
+/* Return to interpreter trampoline: trampoline to load IP from the VRA
+   and tier down.  */
+void *scm_jit_return_to_interpreter_trampoline;
+
+/* Thread-local buffer into which to write code.  */
+struct code_arena
+{
+  uint8_t *base;
+  size_t used;
+  size_t size;
+  struct code_arena *prev;
+};
+
+/* Branches between instructions.  */
+struct pending_reloc
+{
+  jit_reloc_t reloc;
+  ptrdiff_t target_vcode_offset;
+};
+
+/* State of the JIT compiler for the current thread.  */
+struct scm_jit_state {
+  jit_state_t *jit;
+  scm_thread *thread;
+  const uint32_t *start;
+  uint32_t *ip;
+  uint32_t *next_ip;
+  const uint32_t *end;
+  uint32_t *entry;
+  uint8_t *op_attrs;
+  struct pending_reloc *relocs;
+  size_t reloc_idx;
+  size_t reloc_count;
+  void **labels;
+  int32_t frame_size_min;
+  int32_t frame_size_max;
+  uint32_t register_state;
+  jit_gpr_t sp_cache_gpr;
+  jit_fpr_t sp_cache_fpr;
+  uint32_t sp_cache_gpr_idx;
+  uint32_t sp_cache_fpr_idx;
+  struct code_arena *code_arena;
+};
+
+typedef struct scm_jit_state scm_jit_state;
+
+static const uint32_t program_word_offset_free_variable = 2;
+
+static const uint32_t frame_offset_mra = 0 * sizeof(union scm_vm_stack_element);
+static const uint32_t frame_offset_vra = 1 * sizeof(union scm_vm_stack_element);
+static const uint32_t frame_offset_prev = 2 * sizeof(union scm_vm_stack_element);
+static const uint32_t frame_overhead_slots = 3;
+
+#define DEFINE_THREAD_OFFSET(f)                                         \
+  static const uint32_t thread_offset_##f =                             \
+    offsetof (struct scm_thread, f)
+
+DEFINE_THREAD_OFFSET (handle);
+DEFINE_THREAD_OFFSET (pending_asyncs);
+DEFINE_THREAD_OFFSET (block_asyncs);
+
+#define DEFINE_THREAD_VP_OFFSET(f)                                      \
+  static const uint32_t thread_offset_##f =                             \
+    offsetof (struct scm_thread, vm) + offsetof (struct scm_vm, f)
+
+DEFINE_THREAD_VP_OFFSET (fp);
+DEFINE_THREAD_VP_OFFSET (sp);
+DEFINE_THREAD_VP_OFFSET (ip);
+DEFINE_THREAD_VP_OFFSET (sp_min_since_gc);
+DEFINE_THREAD_VP_OFFSET (stack_limit);
+
+/* The current scm_thread*.  Preserved across callouts.  */
+static const jit_gpr_t THREAD = JIT_V0;
+
+/* The current stack pointer.  Clobbered across callouts.  Can be
+   reloaded from the thread.  Note that any callout that might
+   recursively enter the VM may move the stack pointer.  */
+static const jit_gpr_t SP = JIT_R0;
+
+/* During calls and returns -- the parts of the code that manipulate the
+   frame pointer -- the current frame pointer is stored in FP.
+   Otherwise this is a temp register.  It can always be reloaded from
+   THREAD.  Like SP, it can move.  */
+static const jit_gpr_t FP = JIT_R1;
+
+/* When we return to a function that doesn't have mcode, the just-popped
+   FP is stored in this register.  The return-to-the-interpreter
+   trampoline reads the vRA from the just-popped frame.  */
+static const jit_gpr_t OLD_FP_FOR_RETURN_TRAMPOLINE = JIT_V1; /* T0 */
+
+/* Scratch registers.  */
+static const jit_gpr_t T0 = JIT_V1;
+static const jit_gpr_t T1 = JIT_V2;
+static const jit_gpr_t T2 = JIT_R2;
+SCM_UNUSED static const jit_gpr_t T3_OR_FP = JIT_R1;
+SCM_UNUSED static const jit_gpr_t T4_OR_SP = JIT_R0;
+
+/* Sometimes you want to call out the fact that T0 and T1 are preserved
+   across calls.  In that case, use these.  */
+static const jit_gpr_t T0_PRESERVED = JIT_V1;
+static const jit_gpr_t T1_PRESERVED = JIT_V2;
+
+static const uint32_t SP_IN_REGISTER = 0x1;
+static const uint32_t FP_IN_REGISTER = 0x2;
+static const uint32_t SP_CACHE_GPR = 0x4;
+static const uint32_t SP_CACHE_FPR = 0x8;
+
+static const uint8_t OP_ATTR_BLOCK = 0x1;
+static const uint8_t OP_ATTR_ENTRY = 0x2;
+
+#ifdef WORDS_BIGENDIAN
+#define BIGENDIAN 1
+#else
+#define BIGENDIAN 0
+#endif
+
+#if BIGENDIAN
+static const uint32_t uint32_offset_low_byte = 3;
+#else
+static const uint32_t uint32_offset_low_byte = 0;
+#endif
+
+#if SCM_SIZEOF_UINTPTR_T == 4
+static const uint32_t log2_sizeof_uintptr_t = 2;
+#elif SCM_SIZEOF_UINTPTR_T == 8
+static const uint32_t log2_sizeof_uintptr_t = 3;
+#else
+#error unhandled uintptr_t size
+#endif
+
+#define LENGTH_NOP 0
+#define LENGTH_OP1(a) 1
+#define LENGTH_OP2(a,b) 2
+#define LENGTH_OP3(a,b,c) 3
+#define LENGTH_OP4(a,b,c,d) 4
+#define LENGTH_DOP1(a) 1
+#define LENGTH_DOP2(a,b) 2
+#define LENGTH_DOP3(a,b,c) 3
+#define LENGTH_DOP4(a,b,c,d) 4
+
+static const uint8_t op_lengths[256] = {
+#define OP_LENGTH(code, cname, name, arity) LENGTH_##arity,
+FOR_EACH_VM_OPERATION(OP_LENGTH)
+#undef OP_LENGTH
+};
+
+static void die (int line, const char *msg) SCM_NORETURN;
+static void
+die (int line, const char *msg)
+{
+  fprintf (stderr, "jit.c:%d: fatal: %s\n", line, msg);
+  abort ();
+}
+
+#define DIE(msg) die(__LINE__, msg)
+
+#define ASSERT(x)                                                       \
+  do { if (SCM_UNLIKELY (!(x))) DIE ("assertion failed"); } while (0)
+
+#define UNREACHABLE()                                                   \
+  DIE ("unreachable")
+
+#define _LOG(level, ...)                                                \
+  do {                                                                  \
+    if (SCM_UNLIKELY (jit_log_level >= level))                          \
+      fprintf (stderr, "jit: " __VA_ARGS__);                            \
+  } while (0)
+
+enum {
+  LOG_LEVEL_NONE,
+  LOG_LEVEL_INFO,
+  LOG_LEVEL_DEBUG,
+  LOG_LEVEL_LOG
+};
+
+#define INFO(...)  _LOG(LOG_LEVEL_INFO, __VA_ARGS__)
+#define DEBUG(...) _LOG(LOG_LEVEL_DEBUG, __VA_ARGS__)
+#define LOG(...)   _LOG(LOG_LEVEL_LOG, __VA_ARGS__)
+
+static void
+reset_register_state (scm_jit_state *j, uint32_t state)
+{
+  j->register_state = state;
+}
+
+static void
+clear_register_state (scm_jit_state *j, uint32_t state)
+{
+  j->register_state &= ~state;
+}
+
+static void
+clear_scratch_register_state (scm_jit_state *j)
+{
+  reset_register_state (j, 0);
+}
+
+static void
+set_register_state (scm_jit_state *j, uint32_t state)
+{
+  j->register_state |= state;
+}
+
+static uint32_t
+has_register_state (scm_jit_state *j, uint32_t state)
+{
+  return (j->register_state & state) == state;
+}
+
+#define ASSERT_HAS_REGISTER_STATE(state) ASSERT (has_register_state (j, state))
+
+static void
+record_gpr_clobber (scm_jit_state *j, jit_gpr_t r)
+{
+  if (jit_same_gprs (j->sp_cache_gpr, r))
+    clear_register_state (j, SP_CACHE_GPR);
+
+  if (jit_same_gprs (r, SP))
+    clear_register_state (j, SP_IN_REGISTER);
+  else if (jit_same_gprs (r, FP))
+    clear_register_state (j, FP_IN_REGISTER);
+}
+
+static void
+record_fpr_clobber (scm_jit_state *j, jit_fpr_t r)
+{
+  if (jit_same_fprs (j->sp_cache_fpr, r))
+    clear_register_state (j, SP_CACHE_FPR);
+}
+
+static void
+set_sp_cache_gpr (scm_jit_state *j, uint32_t idx, jit_gpr_t r)
+{
+  set_register_state (j, SP_CACHE_GPR);
+  j->sp_cache_gpr_idx = idx;
+  if (j->sp_cache_fpr_idx == idx)
+    clear_register_state (j, SP_CACHE_FPR);
+}
+
+static void
+set_sp_cache_fpr (scm_jit_state *j, uint32_t idx, jit_fpr_t r)
+{
+  set_register_state (j, SP_CACHE_FPR);
+  j->sp_cache_fpr_idx = idx;
+  if (j->sp_cache_gpr_idx == idx)
+    clear_register_state (j, SP_CACHE_GPR);
+}
+
+/* Q: When should I use emit_retval instead of jit_retval?  When to use
+   emit_movi, emit_ldxi?
+
+   A: Generally you should use the emit_ variants instead of the jit_
+   variants.  Guile's JIT compiler has a primitive form of local
+   (intrablock) register allocation that records recent stores.  A
+   subsequent load might be able to replace a register read instead of a
+   memory load.  This simple allocator works for straight-line code, and
+   it works as long as register writes are recorded.  The JIT itself
+   will clear the register allocator state at control-flow joins, but
+   control flow within an instruction needs to be careful.
+
+   It's OK to use the jit_emit, jit_retval etc primitives if you
+   manually make corresponding changes to the register_state, perhaps by
+   inserting record_gpr_clobber calls.  If the register is later
+   clobbered by e.g. emit_sp_set_scm, sometimes those can be omitted
+   though.  Also, if your instruction includes a call, that code will
+   invalidate any cached register-stack-index associations, so if
+   there's a call, maybe you can avoid calling emit_*.
+
+   Note of course that an association between registers and
+   stack-indexed locals is also invalidated if the stack frame expands
+   via alloc-frame or push, or shrinks via reset-frame, pop, drop,
+   etc.  */
+static void
+emit_retval (scm_jit_state *j, jit_gpr_t r)
+{
+  jit_retval (j->jit, r);
+  record_gpr_clobber (j, r);
+}
+
+static void
+emit_retval_d (scm_jit_state *j, jit_fpr_t r)
+{
+  jit_retval_d (j->jit, r);
+  record_fpr_clobber (j, r);
+}
+
+static void
+emit_movi (scm_jit_state *j, jit_gpr_t r, jit_word_t i)
+{
+  jit_movi (j->jit, r, i);
+  record_gpr_clobber (j, r);
+}
+
+static jit_reloc_t
+emit_mov_addr (scm_jit_state *j, jit_gpr_t r)
+{
+  record_gpr_clobber (j, r);
+  return jit_mov_addr (j->jit, r);
+}
+
+static void
+emit_ldxi (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t src, jit_word_t offset)
+{
+  if (offset == 0)
+    jit_ldr (j->jit, dst, src);
+  else
+    jit_ldxi (j->jit, dst, src, offset);
+  record_gpr_clobber (j, dst);
+}
+
+#define DEFINE_CLOBBER_RECORDING_EMITTER_R(stem, typ)                   \
+static void                                                             \
+emit_##stem (scm_jit_state *j, jit_##typ##_t dst, jit_##typ##_t a)      \
+{                                                                       \
+  jit_##stem (j->jit, dst, a);                                          \
+  record_##typ##_clobber (j, dst);                                      \
+}
+
+#define DEFINE_CLOBBER_RECORDING_EMITTER_P(stem, typ)                   \
+static void                                                             \
+emit_##stem (scm_jit_state *j, jit_##typ##_t dst, jit_pointer_t a)      \
+{                                                                       \
+  jit_##stem (j->jit, dst, a);                                          \
+  record_##typ##_clobber (j, dst);                                      \
+}
+
+#define DEFINE_CLOBBER_RECORDING_EMITTER_R_I(stem, typ)                 \
+static void                                                             \
+emit_##stem (scm_jit_state *j, jit_##typ##_t dst,                       \
+            jit_##typ##_t a, jit_word_t b)                              \
+{                                                                       \
+  jit_##stem (j->jit, dst, a, b);                                       \
+  record_##typ##_clobber (j, dst);                                      \
+}
+
+#define DEFINE_CLOBBER_RECORDING_EMITTER_R_R(stem, typ)                 \
+static void                                                             \
+emit_##stem (scm_jit_state *j, jit_##typ##_t dst,                       \
+            jit_##typ##_t a, jit_##typ##_t b)                           \
+{                                                                       \
+  jit_##stem (j->jit, dst, a, b);                                       \
+  record_##typ##_clobber (j, dst);                                      \
+}
+
+#define DEFINE_CLOBBER_RECORDING_EMITTER_R_R_2(stem, typ)               \
+static void                                                             \
+emit_##stem (scm_jit_state *j,                                          \
+             jit_##typ##_t dst1, jit_##typ##_t dst2,                    \
+             jit_##typ##_t a, jit_##typ##_t b)                          \
+{                                                                       \
+  jit_##stem (j->jit, dst1, dst2, a, b);                                \
+  record_##typ##_clobber (j, dst1);                                     \
+  record_##typ##_clobber (j, dst2);                                     \
+}
+
+DEFINE_CLOBBER_RECORDING_EMITTER_R(ldr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_P(ldi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R(movr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R(comr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(ldxr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(addi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(addr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(addr_d, fpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(subi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(subr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(subr_d, fpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(muli, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(mulr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(mulr_d, fpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(divr_d, fpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(andi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(andr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(orr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(xorr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(rshi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(rshi_u, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(rshr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(rshr_u, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(lshi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(lshr, gpr)
+
+#if SIZEOF_UINTPTR_T < 8
+DEFINE_CLOBBER_RECORDING_EMITTER_R(negr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(addci, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(addcr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(addxi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(addxr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(subci, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(subcr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_I(subxi, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R(subxr, gpr)
+DEFINE_CLOBBER_RECORDING_EMITTER_R_R_2(qmulr_u, gpr)
+#endif
+
+static void
+emit_reload_sp (scm_jit_state *j)
+{
+  emit_ldxi (j, SP, THREAD, thread_offset_sp);
+  set_register_state (j, SP_IN_REGISTER);
+}
+
+static void
+emit_store_sp (scm_jit_state *j)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+  jit_stxi (j->jit, thread_offset_sp, THREAD, SP);
+}
+
+static void
+emit_reload_fp (scm_jit_state *j)
+{
+  emit_ldxi (j, FP, THREAD, thread_offset_fp);
+  set_register_state (j, FP_IN_REGISTER);
+}
+
+static void
+emit_store_fp (scm_jit_state *j)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+  jit_stxi (j->jit, thread_offset_fp, THREAD, FP);
+}
+
+static uint32_t
+save_reloadable_register_state (scm_jit_state *j)
+{
+  return j->register_state & (SP_IN_REGISTER | FP_IN_REGISTER);
+}
+
+static void
+restore_reloadable_register_state (scm_jit_state *j, uint32_t state)
+{
+  if ((state & SP_IN_REGISTER) && !has_register_state (j, SP_IN_REGISTER))
+    emit_reload_sp (j);
+  if ((state & FP_IN_REGISTER) && !has_register_state (j, FP_IN_REGISTER))
+    emit_reload_fp (j);
+}
+
+static void
+emit_subtract_stack_slots (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t src,
+                           uint32_t n)
+{
+  emit_subi (j, dst, src, n * sizeof (union scm_vm_stack_element));
+}
+
+static void
+emit_load_mra (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t fp)
+{
+  emit_ldxi (j, dst, fp, frame_offset_mra);
+}
+
+static void
+emit_store_mra (scm_jit_state *j, jit_gpr_t fp, jit_gpr_t mra)
+{
+  ASSERT (frame_offset_mra == 0);
+  jit_str (j->jit, fp, mra);
+}
+
+static void
+emit_load_vra (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t fp)
+{
+  emit_ldxi (j, dst, fp, frame_offset_vra);
+}
+
+static void
+emit_store_vra (scm_jit_state *j, jit_gpr_t fp, jit_gpr_t t, const uint32_t *vra)
+{
+  emit_movi (j, t, (intptr_t) vra);
+  jit_stxi (j->jit, frame_offset_vra, fp, t);
+}
+
+static void
+emit_load_prev_fp_offset (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t fp)
+{
+  emit_ldxi (j, dst, fp, frame_offset_prev);
+}
+
+static void
+emit_store_prev_fp_offset (scm_jit_state *j, jit_gpr_t fp, jit_gpr_t t,
+                           uint32_t n)
+{
+  emit_movi (j, t, n);
+  jit_stxi (j->jit, frame_offset_prev, fp, t);
+}
+
+static void
+emit_store_ip (scm_jit_state *j, jit_gpr_t ip)
+{
+  jit_stxi (j->jit, thread_offset_ip, THREAD, ip);
+}
+
+static void
+emit_store_current_ip (scm_jit_state *j, jit_gpr_t t)
+{
+  emit_movi (j, t, (intptr_t) j->ip);
+  emit_store_ip (j, t);
+}
+
+static void
+emit_pop_fp (scm_jit_state *j, jit_gpr_t old_fp)
+{
+  emit_ldxi (j, old_fp, THREAD, thread_offset_fp);
+  emit_load_prev_fp_offset (j, FP, old_fp);
+  emit_lshi (j, FP, FP, 3); /* Multiply by sizeof (scm_vm_stack_element) */
+  emit_addr (j, FP, old_fp, FP);
+  set_register_state (j, FP_IN_REGISTER);
+  emit_store_fp (j);
+}
+
+static void
+emit_reset_frame (scm_jit_state *j, uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+  emit_subtract_stack_slots (j, SP, FP, nlocals);
+  set_register_state (j, SP_IN_REGISTER);
+  emit_store_sp (j);
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+}
+
+static jit_operand_t
+thread_operand (void)
+{
+  return jit_operand_gpr (JIT_OPERAND_ABI_POINTER, THREAD);
+}
+
+static void
+emit_call_0 (scm_jit_state *j, void *f)
+{
+  jit_calli_0 (j->jit, f);
+  clear_scratch_register_state (j);
+}
+
+static void
+emit_call_1 (scm_jit_state *j, void *f, jit_operand_t a)
+{
+  jit_calli_1 (j->jit, f, a);
+  clear_scratch_register_state (j);
+}
+
+static void
+emit_call_2 (scm_jit_state *j, void *f, jit_operand_t a, jit_operand_t b)
+{
+  jit_calli_2 (j->jit, f, a, b);
+  clear_scratch_register_state (j);
+}
+
+static void
+emit_call_3 (scm_jit_state *j, void *f, jit_operand_t a, jit_operand_t b,
+             jit_operand_t c)
+{
+  jit_calli_3 (j->jit, f, a, b, c);
+  clear_scratch_register_state (j);
+}
+
+static void
+emit_alloc_frame_for_sp (scm_jit_state *j, jit_gpr_t t)
+{
+  jit_reloc_t k, fast, watermark;
+  uint32_t saved_state = save_reloadable_register_state (j);
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  emit_ldxi (j, t, THREAD, thread_offset_sp_min_since_gc);
+  fast = jit_bger (j->jit, SP, t);
+  emit_ldxi (j, t, THREAD, thread_offset_stack_limit);
+  watermark = jit_bger (j->jit, SP, t);
+
+  /* Slow case: call out to expand stack.  */
+  emit_store_current_ip (j, t);
+  emit_call_2 (j, scm_vm_intrinsics.expand_stack, thread_operand (),
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, SP));
+  restore_reloadable_register_state (j, saved_state);
+  k = jit_jmp (j->jit);
+
+  /* Past sp_min_since_gc, but within stack_limit: update watermark and
+     fall through.  */
+  jit_patch_here (j->jit, watermark);
+  jit_stxi (j->jit, thread_offset_sp_min_since_gc, THREAD, SP);
+  jit_patch_here (j->jit, fast);
+  /* Fast case: Just update sp.  */
+  emit_store_sp (j);
+  jit_patch_here (j->jit, k);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+}
+
+static void
+emit_alloc_frame (scm_jit_state *j, jit_gpr_t t, uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+  emit_subtract_stack_slots (j, SP, FP, nlocals);
+  set_register_state (j, SP_IN_REGISTER);
+  emit_alloc_frame_for_sp (j, t);
+}
+
+static void
+emit_get_callee_vcode (scm_jit_state *j, jit_gpr_t dst)
+{
+  emit_call_1 (j, scm_vm_intrinsics.get_callee_vcode, thread_operand ());
+  emit_retval (j, dst);
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+}
+
+static void
+emit_get_vcode_low_byte (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t addr)
+{
+  if (uint32_offset_low_byte == 0)
+    jit_ldr_uc (j->jit, dst, addr);
+  else
+    jit_ldxi_uc (j->jit, dst, addr, uint32_offset_low_byte);
+  record_gpr_clobber (j, dst);
+}
+
+static void
+emit_get_ip_relative_addr (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t ip,
+                           uint32_t offset)
+{
+  uint32_t byte_offset = offset * sizeof (uint32_t);
+  jit_ldxi_i (j->jit, dst, ip, byte_offset);
+  record_gpr_clobber (j, dst);
+  emit_lshi (j, dst, dst, 2); /* Multiply by sizeof (uint32_t) */
+  emit_addr (j, dst, dst, ip);
+}
+
+static void
+emit_exit (scm_jit_state *j)
+{
+  jit_jmpi (j->jit, exit_mcode);
+}
+
+static void
+emit_push_frame (scm_jit_state *j, uint32_t proc_slot, uint32_t nlocals,
+                 const uint32_t *vra)
+{
+  jit_gpr_t t = T0;
+
+  emit_reload_fp (j);
+  emit_subtract_stack_slots (j, FP, FP, proc_slot);
+  set_register_state (j, FP_IN_REGISTER);
+  emit_store_vra (j, FP, t, vra);
+  emit_store_prev_fp_offset (j, FP, t, proc_slot);
+  emit_store_fp (j);
+  emit_reset_frame (j, nlocals);
+}
+
+static void
+emit_indirect_tail_call (scm_jit_state *j)
+{
+  emit_get_callee_vcode (j, T0);
+  emit_get_ip_relative_addr (j, T1, T0, 1);
+  emit_ldxi (j, T1, T1, 0);
+  jit_reloc_t no_mcode = jit_beqi (j->jit, T1, 0);
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER);
+  jit_jmpr (j->jit, T1);
+
+  jit_patch_here (j->jit, no_mcode);
+
+  emit_store_ip (j, T0);
+  emit_exit (j);
+}
+
+static void
+emit_direct_tail_call (scm_jit_state *j, const uint32_t *vcode)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER);
+
+  ASSERT ((vcode[0] & 0xff) == scm_op_instrument_entry);
+
+  if (vcode == j->start)
+    {
+      jit_jmpi (j->jit, j->labels[0]);
+    }
+  else
+    {
+      struct scm_jit_function_data *data;
+      data = (struct scm_jit_function_data *) (vcode + (int32_t)(vcode[1]));
+
+      if (data->mcode)
+        {
+          /* FIXME: Jump indirectly, to allow mcode to be changed
+             (e.g. to add/remove breakpoints or hooks).  */
+          jit_jmpi (j->jit, data->mcode);
+        }
+      else
+        {
+          jit_reloc_t no_mcode;
+
+          /* No need to track clobbers.  */
+          jit_ldi (j->jit, T0, &data->mcode);
+          no_mcode = jit_beqi (j->jit, T0, 0);
+          jit_jmpr (j->jit, T0);
+          jit_patch_here (j->jit, no_mcode);
+          jit_movi (j->jit, T0, (intptr_t) vcode);
+          emit_store_ip (j, T0);
+          emit_exit (j);
+        }
+    }
+}
+
+static jit_operand_t
+fp_scm_operand (scm_jit_state *j, uint32_t slot) SCM_UNUSED;
+static jit_operand_t
+fp_scm_operand (scm_jit_state *j, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+
+  return jit_operand_mem (JIT_OPERAND_ABI_POINTER, FP,
+                          -8 * ((ptrdiff_t) slot + 1));
+}
+
+static void
+emit_fp_ref_scm (scm_jit_state *j, jit_gpr_t dst, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+
+  emit_ldxi (j, dst, FP, -8 * ((ptrdiff_t) slot + 1));
+}
+
+static void
+emit_fp_set_scm (scm_jit_state *j, uint32_t slot, jit_gpr_t val)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+
+  jit_stxi (j->jit, -8 * ((ptrdiff_t) slot + 1), FP, val);
+  clear_register_state (j, SP_CACHE_GPR);
+}
+
+static jit_operand_t
+sp_slot_operand (scm_jit_state *j, uint32_t slot) SCM_UNUSED;
+static jit_operand_t
+sp_slot_operand (scm_jit_state *j, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  return jit_operand_addi (jit_operand_gpr (JIT_OPERAND_ABI_POINTER, SP),
+                           8 * slot);
+}
+
+static jit_operand_t
+sp_scm_operand (scm_jit_state *j, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  return jit_operand_mem (JIT_OPERAND_ABI_POINTER, SP, 8 * slot);
+}
+
+static void
+emit_sp_ref_scm (scm_jit_state *j, jit_gpr_t dst, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  emit_ldxi (j, dst, SP, 8 * slot);
+}
+
+static void
+emit_sp_set_scm (scm_jit_state *j, uint32_t slot, jit_gpr_t val)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (slot == 0)
+    jit_str (j->jit, SP, val);
+  else
+    jit_stxi (j->jit, 8 * slot, SP, val);
+
+  set_sp_cache_gpr (j, slot, val);
+}
+
+/* Use when you know that the u64 value will be within the size_t range,
+   for example when it's ensured by the compiler.  */
+static jit_operand_t
+sp_sz_operand (scm_jit_state *j, uint32_t src)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  enum jit_operand_abi abi =
+    sizeof (size_t) == 4 ? JIT_OPERAND_ABI_UINT32 : JIT_OPERAND_ABI_UINT64;
+
+  if (BIGENDIAN && sizeof (size_t) == 4)
+    return jit_operand_mem (abi, SP, src * 8 + 4);
+  else
+    return jit_operand_mem (abi, SP, src * 8);
+}
+
+static void
+emit_sp_ref_sz (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (BIGENDIAN && sizeof (size_t) == 4)
+    emit_ldxi (j, dst, SP, src * 8 + 4);
+  else
+    emit_ldxi (j, dst, SP, src * 8);
+}
+
+static void
+emit_sp_set_sz (scm_jit_state *j, uint32_t dst, jit_gpr_t src)
+{
+  size_t offset = dst * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (sizeof (size_t) == 4)
+    {
+      size_t lo, hi;
+      if (BIGENDIAN)
+        lo = offset + 4, hi = offset;
+      else
+        lo = offset, hi = offset + 4;
+      
+      jit_stxi (j->jit, lo, SP, src);
+      /* Set high word to 0.  Clobber src.  */
+      emit_xorr (j, src, src, src);
+      jit_stxi (j->jit, hi, SP, src);
+    }
+  else
+    {
+      jit_stxi (j->jit, offset, SP, src);
+      set_sp_cache_gpr (j, dst, src);
+    }
+}
+
+static jit_operand_t
+sp_u64_operand (scm_jit_state *j, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  return jit_operand_mem (JIT_OPERAND_ABI_UINT64, SP, 8 * slot);
+}
+
+#if SIZEOF_UINTPTR_T >= 8
+static void
+emit_sp_ref_u64 (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  size_t offset = src * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  emit_ldxi (j, dst, SP, offset);
+}
+
+static void
+emit_sp_set_u64 (scm_jit_state *j, uint32_t dst, jit_gpr_t src)
+{
+  size_t offset = dst * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (dst == 0)
+    jit_str (j->jit, SP, src);
+  else
+    jit_stxi (j->jit, offset, SP, src);
+
+  set_sp_cache_gpr (j, dst, src);
+}
+
+static void
+emit_sp_ref_s64 (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  emit_sp_ref_u64 (j, dst, src);
+}
+
+static void
+emit_sp_set_s64 (scm_jit_state *j, uint32_t dst, jit_gpr_t src)
+{
+  emit_sp_set_u64 (j, dst, src);
+}
+
+static void
+emit_sp_ref_ptr (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  emit_sp_ref_u64 (j, dst, src);
+}
+
+#else /* SCM_SIZEOF_UINTPTR_T >= 8 */
+
+static jit_operand_t
+sp_s32_operand (scm_jit_state *j, uint32_t src)
+{
+  return sp_sz_operand (j, src);
+}
+
+static void
+emit_sp_ref_s32 (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  emit_sp_ref_sz (j, dst, src);
+}
+
+static void
+emit_sp_ref_u64 (scm_jit_state *j, jit_gpr_t dst_lo, jit_gpr_t dst_hi,
+                 uint32_t src)
+{
+  size_t offset = src * 8;
+  jit_gpr_t first, second;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+#if BIGENDIAN
+  first = dst_hi, second = dst_lo;
+#else
+  first = dst_lo, second = dst_hi;
+#endif
+
+  emit_ldxi (j, first, SP, offset);
+  emit_ldxi (j, second, SP, offset + 4);
+}
+
+static void
+emit_sp_set_u64 (scm_jit_state *j, uint32_t dst, jit_gpr_t lo, jit_gpr_t hi)
+{
+  size_t offset = dst * 8;
+  jit_gpr_t first, second;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+#if BIGENDIAN
+  first = hi, second = lo;
+#else
+  first = lo, second = hi;
+#endif
+
+  if (offset == 0)
+    jit_str (j->jit, SP, first);
+  else
+    jit_stxi (j->jit, offset, SP, first);
+  jit_stxi (j->jit, offset + 4, SP, second);
+
+  clear_register_state (j, SP_CACHE_GPR);
+}
+
+static void
+emit_sp_ref_s64 (scm_jit_state *j, jit_gpr_t dst_lo, jit_gpr_t dst_hi,
+                 uint32_t src)
+{
+  emit_sp_ref_u64 (j, dst_lo, dst_hi, src);
+}
+
+static void
+emit_sp_set_s64 (scm_jit_state *j, uint32_t dst, jit_gpr_t lo, jit_gpr_t hi)
+{
+  emit_sp_set_u64 (j, dst, lo, hi);
+}
+
+static void
+emit_sp_ref_u64_lower_half (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  size_t offset = src * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  emit_ldxi (j, dst, SP, offset);
+}
+
+static void
+emit_sp_ref_ptr (scm_jit_state *j, jit_gpr_t dst, uint32_t src)
+{
+  emit_sp_ref_u64_lower_half (j, dst, src);
+}
+#endif /* SCM_SIZEOF_UINTPTR_T >= 8 */
+
+static void
+emit_sp_ref_f64 (scm_jit_state *j, jit_fpr_t dst, uint32_t src)
+{
+  size_t offset = src * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (offset == 0)
+    jit_ldr_d (j->jit, dst, SP);
+  else
+    jit_ldxi_d (j->jit, dst, SP, offset);
+
+  record_fpr_clobber (j, dst);
+}
+
+static void
+emit_sp_set_f64 (scm_jit_state *j, uint32_t dst, jit_fpr_t src)
+{
+  size_t offset = dst * 8;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+
+  if (offset == 0)
+    jit_str_d (j->jit, SP, src);
+  else
+    jit_stxi_d (j->jit, offset, SP, src);
+
+  set_sp_cache_fpr (j, dst, src);
+}
+
+static void
+emit_mov (scm_jit_state *j, uint32_t dst, uint32_t src, jit_gpr_t t)
+{
+  emit_sp_ref_scm (j, t, src);
+  emit_sp_set_scm (j, dst, t);
+
+  /* FIXME: The compiler currently emits "push", "mov", etc for SCM,
+     F64, U64, and S64 variables.  However SCM values are the usual
+     case, and on a 32-bit machine it might be cheaper to move a SCM
+     than to move a 64-bit number.  */
+  if (sizeof (void*) < sizeof (union scm_vm_stack_element))
+    {
+      /* Copy the high word as well.  */
+      uintptr_t src_offset = src * sizeof (union scm_vm_stack_element);
+      uintptr_t dst_offset = dst * sizeof (union scm_vm_stack_element);
+
+      jit_ldxi (j->jit, t, SP, src_offset + sizeof (void*));
+      jit_stxi (j->jit, dst_offset + sizeof (void*), SP, t);
+
+      clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+    }
+  else
+    /* In any case since we move the register using GPRs, it won't be in
+       a cached FPR.  */
+    clear_register_state (j, SP_CACHE_FPR);
+}
+
+static jit_reloc_t
+emit_branch_if_frame_locals_count_less_than (scm_jit_state *j, jit_gpr_t t,
+                                             uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_subr (j, t, FP, SP);
+  return jit_blti (j->jit, t, nlocals * sizeof (union scm_vm_stack_element));
+}
+
+static jit_reloc_t
+emit_branch_if_frame_locals_count_eq (scm_jit_state *j, jit_gpr_t t,
+                                      uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_subr (j, t, FP, SP);
+  return jit_beqi (j->jit, t, nlocals * sizeof (union scm_vm_stack_element));
+}
+
+static jit_reloc_t
+emit_branch_if_frame_locals_count_not_eq (scm_jit_state *j, jit_gpr_t t,
+                                          uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_subr (j, t, FP, SP);
+  return jit_bnei (j->jit, t, nlocals * sizeof (union scm_vm_stack_element));
+}
+
+static jit_reloc_t
+emit_branch_if_frame_locals_count_greater_than (scm_jit_state *j, jit_gpr_t t,
+                                                uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_subr (j, t, FP, SP);
+  return jit_bgti (j->jit, t, nlocals * sizeof (union scm_vm_stack_element));
+}
+
+static void
+emit_load_fp_slot (scm_jit_state *j, jit_gpr_t dst, uint32_t slot)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER);
+
+  emit_subi (j, dst, FP, (slot + 1) * sizeof (union scm_vm_stack_element));
+}
+
+static jit_reloc_t
+emit_branch_if_immediate (scm_jit_state *j, jit_gpr_t r)
+{
+  return jit_bmsi (j->jit, r, 6);
+}
+
+static void
+emit_load_heap_object_word (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t r,
+                            uint32_t word)
+{
+  emit_ldxi (j, dst, r, word * sizeof(SCM));
+}
+
+static void
+emit_load_heap_object_tc (scm_jit_state *j, jit_gpr_t dst, jit_gpr_t r,
+                          scm_t_bits mask)
+{
+  emit_load_heap_object_word (j, dst, r, 0);
+  emit_andi (j, dst, dst, mask);
+}
+
+static jit_reloc_t
+emit_branch_if_heap_object_has_tc (scm_jit_state *j, jit_gpr_t r, jit_gpr_t t,
+                                   scm_t_bits mask, scm_t_bits tc)
+{
+  emit_load_heap_object_tc (j, t, r, mask);
+  return jit_beqi (j->jit, t, tc);
+}
+
+static jit_reloc_t
+emit_branch_if_heap_object_not_tc (scm_jit_state *j, jit_gpr_t r, jit_gpr_t t,
+                                   scm_t_bits mask, scm_t_bits tc)
+{
+  emit_load_heap_object_tc (j, t, r, mask);
+  return jit_bnei (j->jit, t, tc);
+}
+
+static jit_reloc_t
+emit_branch_if_heap_object_not_tc7 (scm_jit_state *j, jit_gpr_t r, jit_gpr_t t,
+                                    scm_t_bits tc7)
+{
+  return emit_branch_if_heap_object_not_tc (j, r, t, 0x7f, tc7);
+}
+
+static void
+emit_entry_trampoline (scm_jit_state *j)
+{
+  size_t align = jit_enter_jit_abi(j->jit, 3, 0, 0);
+
+  /* Load our reserved registers: THREAD and SP.  Also load IP for the
+     mcode jump.  */
+  jit_load_args_2 (j->jit, thread_operand (),
+                   jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0));
+  emit_reload_sp (j);
+
+  /* Load FP, set during call sequences.  */
+  emit_reload_fp (j);
+
+  /* Jump to the mcode!  */
+  jit_jmpr (j->jit, T0);
+
+  /* Initialize global exit_mcode to point here.  */
+  exit_mcode = jit_address (j->jit);
+
+  jit_leave_jit_abi(j->jit, 3, 0, align);
+
+  /* When mcode finishes, interpreter will continue with vp->ip.  */
+  jit_ret (j->jit);
+}
+
+static void
+emit_handle_interrupts_trampoline (scm_jit_state *j)
+{
+  /* Precondition: IP synced.  */
+  jit_pop_link_register (j->jit);
+  emit_call_2 (j, scm_vm_intrinsics.push_interrupt_frame,
+               thread_operand (),
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_LR));
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+  emit_direct_tail_call (j, scm_vm_intrinsics.handle_interrupt_code);
+}
+
+/* To limit the number of mmap calls and re-emission of JIT code, use
+   256 kB code arenas.  Unused pages won't be resident.  Assume pages
+   are power-of-two-sized and this size is a multiple of the page size
+   on all architectures.  */
+static const size_t default_code_arena_size = 0x40000;
+
+static struct code_arena *
+allocate_code_arena (size_t size, struct code_arena *prev)
+{
+  struct code_arena *ret = malloc (sizeof (struct code_arena));
+
+  if (!ret) return NULL;
+
+  memset (ret, 0, sizeof (*ret));
+  ret->used = 0;
+  ret->size = size;
+  ret->prev = prev;
+  ret->base = mmap (NULL, ret->size,
+                    PROT_EXEC | PROT_READ | PROT_WRITE,
+                    MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+
+  if (ret->base == MAP_FAILED)
+    {
+      perror ("allocating JIT code buffer failed");
+      free (ret);
+      return NULL;
+    }
+
+  INFO ("allocated code arena, %p-%p\n", ret->base, ret->base + ret->size);
+
+  return ret;
+}
+
+static void *
+emit_code (scm_jit_state *j, void (*emit) (scm_jit_state *))
+{
+  if (!j->code_arena)
+    j->code_arena = allocate_code_arena (default_code_arena_size, NULL);
+
+  if (!j->code_arena)
+    /* Resource exhaustion; turn off JIT.  */
+    return NULL;
+
+  while (1)
+    {
+      struct code_arena *arena = j->code_arena;
+
+      jit_begin(j->jit, arena->base + arena->used, arena->size - arena->used);
+
+      uint8_t *ret = jit_address (j->jit);
+
+      emit (j);
+
+      size_t size;
+      if (!jit_has_overflow (j->jit) && jit_end (j->jit, &size))
+        {
+          ASSERT (size <= (arena->size - arena->used));
+          DEBUG ("mcode: %p,+%zu\n", ret, size);
+          arena->used += size;
+          /* Align next JIT to 16-byte boundaries to optimize initial
+             icache fetch.  */
+          arena->used = (arena->used + 15) & ~15;
+          /* Assertion should not be invalidated as arena size is a
+             multiple of 16.  */
+          ASSERT (arena->used <= arena->size);
+          return ret;
+        }
+      else
+        {
+          jit_reset (j->jit);
+          if (arena->used == 0)
+            {
+              /* Code too big to fit into empty arena; allocate a larger
+                 one.  */
+              INFO ("code didn't fit in empty arena of size %zu\n", arena->size);
+              arena = allocate_code_arena (arena->size * 2, arena->prev);
+              if (!arena)
+                return NULL;
+              munmap (j->code_arena->base, j->code_arena->size);
+              free (j->code_arena);
+              j->code_arena = arena;
+            }
+          else
+            {
+              /* Arena full; allocate another.  */
+              /* FIXME: If partial code that we wrote crosses a page
+                 boundary, we could tell the OS to forget about the tail
+                 pages.  */
+              INFO ("code didn't fit in arena tail %zu\n",
+                    arena->size - arena->used);
+              arena = allocate_code_arena (arena->size, arena);
+              if (!arena)
+                return NULL;
+              j->code_arena = arena;
+            }
+        }
+    }
+}
+
+static jit_operand_t
+free_variable_operand (scm_jit_state *j, jit_gpr_t src, size_t n)
+{
+  ptrdiff_t offset = (n + program_word_offset_free_variable) * sizeof(SCM);
+  return jit_operand_mem (JIT_OPERAND_ABI_POINTER, src, offset);
+}
+
+static void
+add_inter_instruction_patch (scm_jit_state *j, jit_reloc_t reloc,
+                             const uint32_t *target)
+{
+  ASSERT (j->start <= target && target < j->end);
+  ptrdiff_t offset = target - j->start;
+
+  if (j->labels[offset])
+    {
+      jit_patch_there (j->jit, reloc, j->labels[offset]);
+      return;
+    }
+
+  if (j->reloc_idx >= j->reloc_count)
+    {
+      size_t count = j->reloc_count * 2;
+      if (!count) count = 10;
+      size_t size = sizeof(*j->relocs) * count;
+      ASSERT(size / sizeof(*j->relocs) == count);
+      struct pending_reloc *relocs = realloc (j->relocs, size);
+      if (relocs)
+        {
+          j->reloc_count = count;
+          j->relocs = relocs;
+        }
+    }
+
+  ASSERT (j->reloc_idx < j->reloc_count);
+  j->relocs[j->reloc_idx].reloc = reloc;
+  j->relocs[j->reloc_idx].target_vcode_offset = offset;
+  j->reloc_idx++;
+}
+
+
+
+static void
+bad_instruction (scm_jit_state *j)
+{
+  ASSERT (0);
+}
+
+static void
+compile_halt (scm_jit_state *j)
+{
+  bad_instruction (j);
+}
+
+static void
+compile_call (scm_jit_state *j, uint32_t proc, uint32_t nlocals)
+{
+  jit_reloc_t push_frame = jit_jmp (j->jit);
+
+  void *trampoline = jit_address (j->jit);
+  reset_register_state (j, FP_IN_REGISTER | SP_IN_REGISTER);
+  jit_pop_link_register (j->jit);
+  emit_store_mra (j, FP, JIT_LR);
+  emit_indirect_tail_call (j);
+
+  jit_patch_here (j->jit, push_frame);
+  /* 2 = size of call inst */
+  emit_push_frame (j, proc, nlocals, j->ip + 2);
+  jit_jmpi_with_link (j->jit, trampoline);
+
+  reset_register_state (j, FP_IN_REGISTER | SP_IN_REGISTER);
+  j->frame_size_min = proc;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_call_label (scm_jit_state *j, uint32_t proc, uint32_t nlocals, const uint32_t *vcode)
+{
+  jit_reloc_t push_frame = jit_jmp (j->jit);
+
+  void *trampoline = jit_address (j->jit);
+  reset_register_state (j, FP_IN_REGISTER | SP_IN_REGISTER);
+  jit_pop_link_register (j->jit);
+  emit_store_mra (j, FP, JIT_LR);
+  emit_direct_tail_call (j, vcode);
+
+  jit_patch_here (j->jit, push_frame);
+  /* 3 = size of call-label inst */
+  emit_push_frame (j, proc, nlocals, j->ip + 3);
+  jit_jmpi_with_link (j->jit, trampoline);
+
+  reset_register_state (j, FP_IN_REGISTER | SP_IN_REGISTER);
+  j->frame_size_min = proc;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_tail_call (scm_jit_state *j)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+  restore_reloadable_register_state (j, FP_IN_REGISTER);
+
+  emit_indirect_tail_call (j);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_tail_call_label (scm_jit_state *j, const uint32_t *vcode)
+{
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
+  restore_reloadable_register_state (j, FP_IN_REGISTER);
+
+  emit_direct_tail_call (j, vcode);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_instrument_entry (scm_jit_state *j, void *data)
+{
+}
+
+static void
+compile_instrument_loop (scm_jit_state *j, void *data)
+{
+  /* Nothing to do.  */
+}
+
+static void
+compile_receive (scm_jit_state *j, uint16_t dst, uint16_t proc, uint32_t nlocals)
+{
+  jit_gpr_t t = T0;
+  jit_reloc_t k;
+  uint32_t saved_state = j->register_state;
+
+  k = emit_branch_if_frame_locals_count_greater_than (j, t, proc);
+  emit_store_current_ip (j, T0);
+  emit_call_0 (j, scm_vm_intrinsics.error_no_values);
+  j->register_state = saved_state;
+  jit_patch_here (j->jit, k);
+  emit_fp_ref_scm (j, t, proc);
+  emit_fp_set_scm (j, dst, t);
+  emit_reset_frame (j, nlocals);
+
+  j->frame_size_min = j->frame_size_max = nlocals;
+}
+
+static void
+compile_receive_values (scm_jit_state *j, uint32_t proc, uint8_t allow_extra,
+                        uint32_t nvalues)
+{
+  jit_gpr_t t = T0;
+  uint32_t saved_state = j->register_state;
+
+  if (allow_extra)
+    {
+      jit_reloc_t k;
+      k = emit_branch_if_frame_locals_count_greater_than (j, t, proc+nvalues-1);
+      emit_store_current_ip (j, T0);
+      emit_call_0 (j, scm_vm_intrinsics.error_not_enough_values);
+      j->register_state = saved_state;
+      jit_patch_here (j->jit, k);
+    }
+  else
+    {
+      jit_reloc_t k;
+      k = emit_branch_if_frame_locals_count_eq (j, t, proc + nvalues);
+      emit_store_current_ip (j, T0);
+      emit_call_1 (j, scm_vm_intrinsics.error_wrong_number_of_values,
+                   jit_operand_imm (JIT_OPERAND_ABI_UINT32, nvalues));
+      j->register_state = saved_state;
+      jit_patch_here (j->jit, k);
+    }
+
+  j->frame_size_min = proc + nvalues;
+  j->frame_size_max = allow_extra ? INT32_MAX : j->frame_size_min;
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+}
+
+static void
+compile_shuffle_down (scm_jit_state *j, uint16_t from, uint16_t to)
+{
+  jit_gpr_t walk = T0, t = T1;
+  size_t offset = (from - to) * sizeof (union scm_vm_stack_element);
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_load_fp_slot (j, walk, from);
+  jit_reloc_t done = jit_bltr (j->jit, walk, SP);
+  void *head = jit_address (j->jit);
+  jit_ldr (j->jit, t, walk);
+  jit_stxi (j->jit, offset, walk, t);
+  jit_subi (j->jit, walk, walk, sizeof (union scm_vm_stack_element));
+  jit_patch_there (j->jit, jit_bger (j->jit, walk, SP), head);
+  jit_patch_here (j->jit, done);
+  jit_addi (j->jit, SP, SP, offset);
+  emit_store_sp (j);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+
+  j->frame_size_min -= (from - to);
+  if (j->frame_size_max != INT32_MAX)
+    j->frame_size_max -= (from - to);
+}
+
+static void
+compile_return_values (scm_jit_state *j)
+{
+  emit_pop_fp (j, OLD_FP_FOR_RETURN_TRAMPOLINE);
+  emit_load_mra (j, JIT_LR, OLD_FP_FOR_RETURN_TRAMPOLINE);
+  jit_push_link_register (j->jit);
+  jit_ret (j->jit);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+emit_return_to_interpreter_trampoline (scm_jit_state *j)
+{
+  jit_gpr_t ra = T1;
+
+  emit_load_vra (j, ra, OLD_FP_FOR_RETURN_TRAMPOLINE);
+  emit_store_ip (j, ra);
+  emit_exit (j);
+}
+
+static void
+compile_subr_call (scm_jit_state *j, uint32_t idx)
+{
+  jit_gpr_t t = T0, ret = T1;
+  void *subr;
+  jit_reloc_t immediate, not_values, k;
+  jit_operand_t args[10];
+
+  ASSERT (j->frame_size_min == j->frame_size_max);
+  size_t argc = j->frame_size_max - 1;
+  ASSERT (argc <= 10);
+
+  subr = scm_subr_function_by_index (idx);
+  emit_store_current_ip (j, t);
+  for (size_t i = 2; i <= j->frame_size_max; i++)
+    args[i - 2] = sp_scm_operand (j, (j->frame_size_max - i));
+  jit_calli (j->jit, subr, argc, args);
+  clear_scratch_register_state (j);
+  jit_retval (j->jit, ret);
+
+  immediate = emit_branch_if_immediate (j, ret);
+  not_values = emit_branch_if_heap_object_not_tc7 (j, ret, t, scm_tc7_values);
+  emit_call_2 (j, scm_vm_intrinsics.unpack_values_object, thread_operand (),
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, ret));
+  emit_reload_fp (j);
+  emit_reload_sp (j);
+  k = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, immediate);
+  jit_patch_here (j->jit, not_values);
+  emit_reload_fp (j);
+  emit_subtract_stack_slots (j, SP, FP, 1);
+  set_register_state (j, SP_IN_REGISTER);
+  emit_store_sp (j);
+  jit_str (j->jit, SP, ret);
+  jit_patch_here (j->jit, k);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_foreign_call (scm_jit_state *j, uint16_t cif_idx, uint16_t ptr_idx)
+{
+  uint32_t saved_state;
+
+  ASSERT (j->frame_size_min == j->frame_size_max);
+
+  emit_store_current_ip (j, T0);
+  emit_sp_ref_scm (j, T0, j->frame_size_min - 1);
+
+  /* FIXME: Inline the foreign call.  */
+  saved_state = save_reloadable_register_state (j);
+  emit_call_3 (j, scm_vm_intrinsics.foreign_call, thread_operand (),
+               free_variable_operand (j, T0, cif_idx),
+               free_variable_operand (j, T0, ptr_idx));
+  restore_reloadable_register_state (j, saved_state);
+
+  j->frame_size_min = j->frame_size_max = 2; /* Return value and errno.  */
+}
+
+static void
+compile_continuation_call (scm_jit_state *j, uint32_t contregs_idx)
+{
+  emit_reload_fp (j);
+  emit_store_current_ip (j, T0);
+  emit_fp_ref_scm (j, T0, 0);
+  emit_call_2 (j, scm_vm_intrinsics.reinstate_continuation_x,
+               thread_operand (), free_variable_operand (j, T0, contregs_idx));
+  /* Does not fall through.  */
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_compose_continuation (scm_jit_state *j, uint32_t cont_idx)
+{
+  jit_reloc_t interp;
+
+  ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER | FP_IN_REGISTER);
+
+  emit_store_current_ip (j, T0);
+  emit_fp_ref_scm (j, T0, 0);
+  emit_call_2 (j, scm_vm_intrinsics.compose_continuation,
+               thread_operand (), free_variable_operand (j, T0, cont_idx));
+  jit_retval (j->jit, T0);
+  interp = jit_beqi (j->jit, T0, 0);
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+  jit_jmpr (j->jit, T0);
+
+  jit_patch_here (j->jit, interp);
+  emit_exit (j);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_capture_continuation (scm_jit_state *j, uint32_t dst)
+{
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, scm_vm_intrinsics.capture_continuation, thread_operand ());
+  jit_retval (j->jit, T0);
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_abort (scm_jit_state *j)
+{
+  jit_reloc_t k, interp;
+
+  jit_movi (j->jit, T0, (intptr_t) (j->ip + 1));
+  emit_store_ip (j, T0);
+  k = jit_mov_addr (j->jit, T0);
+  emit_call_2 (j, scm_vm_intrinsics.abort_to_prompt, thread_operand (),
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0));
+  jit_retval (j->jit, T1_PRESERVED);
+  
+  interp = jit_beqi (j->jit, T1_PRESERVED, 0);
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+  jit_jmpr (j->jit, T1_PRESERVED);
+
+  jit_patch_here (j->jit, interp);
+  emit_exit (j);
+
+  jit_patch_here (j->jit, k);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_builtin_ref (scm_jit_state *j, uint16_t dst, uint16_t idx)
+{
+  SCM builtin = scm_vm_builtin_ref (idx);
+
+  emit_movi (j, T0, SCM_UNPACK (builtin));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_throw (scm_jit_state *j, uint16_t key, uint16_t args)
+{
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, scm_vm_intrinsics.throw_, sp_scm_operand (j, key),
+               sp_scm_operand (j, args));
+  /* throw_ does not return.  */
+}
+
+static void
+compile_throw_value (scm_jit_state *j, uint32_t val,
+                     const void *key_subr_and_message)
+{
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, scm_vm_intrinsics.throw_with_value, sp_scm_operand (j, val),
+               jit_operand_imm (JIT_OPERAND_ABI_POINTER,
+                                (intptr_t) key_subr_and_message));
+  /* throw_with_value does not return.  */
+}
+
+static void
+compile_throw_value_and_data (scm_jit_state *j, uint32_t val,
+                              const void *key_subr_and_message)
+{
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, scm_vm_intrinsics.throw_with_value_and_data,
+               sp_scm_operand (j, val),
+               jit_operand_imm (JIT_OPERAND_ABI_POINTER,
+                                (intptr_t) key_subr_and_message));
+  /* throw_with_value_and_data does not return.  */
+}
+
+static void
+compile_assert_nargs_ee (scm_jit_state *j, uint32_t nlocals)
+{
+  jit_reloc_t k;
+  jit_gpr_t t = T0;
+  uint32_t saved_state = j->register_state;
+
+  k = emit_branch_if_frame_locals_count_eq (j, t, nlocals);
+  emit_store_current_ip (j, t);
+  emit_call_1 (j, scm_vm_intrinsics.error_wrong_num_args,
+               thread_operand ());
+  jit_patch_here (j->jit, k);
+
+  j->register_state = saved_state;
+  j->frame_size_min = j->frame_size_max = nlocals;
+}
+
+static void
+compile_assert_nargs_ge (scm_jit_state *j, uint32_t nlocals)
+{
+  if (nlocals > 0)
+    {
+      jit_gpr_t t = T0;
+      jit_reloc_t k;
+      uint32_t saved_state = j->register_state;
+
+      k = emit_branch_if_frame_locals_count_greater_than (j, t, nlocals-1);
+      emit_store_current_ip (j, t);
+      emit_call_1 (j, scm_vm_intrinsics.error_wrong_num_args,
+                   thread_operand ());
+      jit_patch_here (j->jit, k);
+      j->register_state = saved_state;
+    }
+
+  j->frame_size_min = nlocals;
+}
+
+static void
+compile_assert_nargs_le (scm_jit_state *j, uint32_t nlocals)
+{
+  jit_reloc_t k;
+  jit_gpr_t t = T0;
+  uint32_t saved_state = j->register_state;
+
+  k = emit_branch_if_frame_locals_count_less_than (j, t, nlocals + 1);
+  emit_store_current_ip (j, t);
+  emit_call_1 (j, scm_vm_intrinsics.error_wrong_num_args,
+               thread_operand ());
+  jit_patch_here (j->jit, k);
+
+  j->register_state = saved_state;
+  j->frame_size_max = nlocals;
+}
+
+static void
+compile_alloc_frame (scm_jit_state *j, uint32_t nlocals)
+{
+  /* This will clear the regalloc, so no need to track clobbers.  */
+  emit_alloc_frame (j, T0, nlocals);
+
+  j->frame_size_min = j->frame_size_max = nlocals;
+}
+
+static void
+compile_reset_frame (scm_jit_state *j, uint32_t nlocals)
+{
+  restore_reloadable_register_state (j, FP_IN_REGISTER);
+  emit_reset_frame (j, nlocals);
+
+  j->frame_size_min = j->frame_size_max = nlocals;
+}
+
+static void
+compile_push (scm_jit_state *j, uint32_t src)
+{
+  jit_gpr_t t = T0;
+  jit_subi (j->jit, SP, SP, sizeof (union scm_vm_stack_element));
+  emit_alloc_frame_for_sp (j, t);
+  emit_mov (j, 0, src + 1, t);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+
+  j->frame_size_min++;
+  if (j->frame_size_max != INT32_MAX)
+    j->frame_size_max++;
+}
+
+static void
+compile_pop (scm_jit_state *j, uint32_t dst)
+{
+  emit_mov (j, dst + 1, 0, T0);
+  jit_addi (j->jit, SP, SP, sizeof (union scm_vm_stack_element));
+  emit_store_sp (j);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+
+  j->frame_size_min--;
+  if (j->frame_size_max != INT32_MAX)
+    j->frame_size_max--;
+}
+
+static void
+compile_drop (scm_jit_state *j, uint32_t nvalues)
+{
+  jit_addi (j->jit, SP, SP, nvalues * sizeof (union scm_vm_stack_element));
+  emit_store_sp (j);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+
+  j->frame_size_min -= nvalues;
+  if (j->frame_size_max != INT32_MAX)
+    j->frame_size_max -= nvalues;
+}
+
+static void
+compile_assert_nargs_ee_locals (scm_jit_state *j, uint16_t expected,
+                                uint16_t nlocals)
+{
+  compile_assert_nargs_ee (j, expected);
+  if (nlocals)
+    compile_alloc_frame (j, expected + nlocals);
+}
+
+static void
+compile_expand_apply_argument (scm_jit_state *j)
+{
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, scm_vm_intrinsics.expand_apply_argument, thread_operand ());
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+
+  j->frame_size_min--;
+  j->frame_size_max = INT32_MAX;
+}
+
+static void
+compile_bind_kwargs (scm_jit_state *j, uint32_t nreq, uint8_t flags,
+                     uint32_t nreq_and_opt, uint32_t ntotal, const void *kw)
+{
+  uint8_t allow_other_keys = flags & 0x1, has_rest = flags & 0x2;
+  jit_gpr_t t = T0, npositional = T1;
+
+  emit_store_current_ip (j, t);
+
+  emit_call_3 (j, scm_vm_intrinsics.compute_kwargs_npositional,
+               thread_operand (),
+               jit_operand_imm (JIT_OPERAND_ABI_UINT32, nreq),
+               jit_operand_imm (JIT_OPERAND_ABI_UINT32, nreq_and_opt - nreq));
+  jit_retval_i (j->jit, npositional);
+
+  jit_operand_t args[] =
+    { jit_operand_gpr (JIT_OPERAND_ABI_POINTER, THREAD),
+      jit_operand_gpr (JIT_OPERAND_ABI_UINT32, npositional),
+      jit_operand_imm (JIT_OPERAND_ABI_UINT32, ntotal),
+      jit_operand_imm (JIT_OPERAND_ABI_POINTER, (intptr_t)kw),
+      jit_operand_imm (JIT_OPERAND_ABI_UINT8, !has_rest),
+      jit_operand_imm (JIT_OPERAND_ABI_UINT8, allow_other_keys) };
+  jit_calli (j->jit, scm_vm_intrinsics.bind_kwargs, 6, args);
+  clear_scratch_register_state (j);
+  
+  if (has_rest)
+    {
+      emit_call_2 (j, scm_vm_intrinsics.cons_rest, thread_operand (),
+                   jit_operand_imm (JIT_OPERAND_ABI_UINT32, ntotal));
+      jit_retval (j->jit, t);
+      emit_reload_fp (j);
+      emit_fp_set_scm (j, nreq_and_opt, t);
+    }
+  else
+    emit_reload_fp (j);
+
+  emit_reset_frame (j, ntotal);
+  j->frame_size_min = j->frame_size_max = ntotal;
+}
+
+static void
+compile_bind_rest (scm_jit_state *j, uint32_t dst)
+{
+  jit_reloc_t k, cons;
+  jit_gpr_t t = T1;
+  
+  cons = emit_branch_if_frame_locals_count_greater_than (j, t, dst);
+
+  emit_alloc_frame (j, t, dst + 1);
+  emit_movi (j, t, SCM_UNPACK (SCM_EOL));
+  emit_sp_set_scm (j, 0, t);
+  k = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, cons);
+  emit_store_current_ip (j, t);
+  emit_call_2 (j, scm_vm_intrinsics.cons_rest, thread_operand (),
+               jit_operand_imm (JIT_OPERAND_ABI_UINT32, dst));
+  emit_retval (j, t);
+  compile_reset_frame (j, dst + 1);
+  emit_sp_set_scm (j, 0, t);
+  
+  jit_patch_here (j->jit, k);
+
+  j->frame_size_min = dst + 1;
+}
+
+static void
+compile_bind_optionals (scm_jit_state *j, uint32_t nlocals)
+{
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER);
+  ASSERT(j->frame_size_min < nlocals);
+  ASSERT(j->frame_size_min < j->frame_size_max);
+
+  jit_gpr_t saved_frame_size = T1_PRESERVED;
+  jit_subr (j->jit, saved_frame_size, FP, SP);
+
+  jit_reloc_t no_optionals = jit_bgei
+    (j->jit, saved_frame_size, nlocals * sizeof (union scm_vm_stack_element));
+
+  emit_alloc_frame (j, T0, nlocals);
+  j->frame_size_min = nlocals;
+
+  jit_gpr_t walk = saved_frame_size;
+  jit_subr (j->jit, walk, FP, saved_frame_size);
+
+  jit_reloc_t done = jit_bler (j->jit, walk, SP);
+  jit_movi (j->jit, T0, SCM_UNPACK (SCM_UNDEFINED));
+
+  void *head = jit_address (j->jit);
+  jit_subi (j->jit, walk, walk, sizeof (union scm_vm_stack_element));
+  jit_str (j->jit, walk, T0);
+  jit_patch_there (j->jit, jit_bner (j->jit, walk, SP), head);
+
+  jit_patch_here (j->jit, done);
+  jit_patch_here (j->jit, no_optionals);
+}
+
+static void
+compile_allocate_words (scm_jit_state *j, uint16_t dst, uint16_t nwords)
+{
+  jit_gpr_t t = T0;
+
+  emit_store_current_ip (j, t);
+  emit_call_2 (j, scm_vm_intrinsics.allocate_words, thread_operand (),
+               sp_sz_operand (j, nwords));
+  emit_retval (j, t);
+  record_gpr_clobber (j, t);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, t);
+}
+
+static void
+compile_allocate_words_immediate (scm_jit_state *j, uint16_t dst, uint16_t nwords)
+{
+  size_t bytes = nwords * sizeof(SCM);
+  size_t idx = scm_inline_gc_bytes_to_freelist_index (bytes);
+
+  if (SCM_UNLIKELY (idx >= SCM_INLINE_GC_FREELIST_COUNT))
+    {
+      jit_gpr_t t = T0;
+      emit_store_current_ip (j, t);
+      emit_call_1 (j, GC_malloc, jit_operand_imm (JIT_OPERAND_ABI_WORD, bytes));
+      emit_retval (j, t);
+      emit_reload_sp (j);
+      emit_sp_set_scm (j, dst, t);
+    }
+  else
+    {
+      jit_gpr_t res = T0;
+      ptrdiff_t offset = offsetof(struct scm_thread, freelists);
+      offset += idx * sizeof(void*);
+      emit_ldxi (j, res, THREAD, offset);
+      jit_reloc_t fast = jit_bnei (j->jit, res, 0);
+      emit_store_current_ip (j, res);
+      emit_call_2 (j, scm_vm_intrinsics.allocate_words_with_freelist,
+                   thread_operand (),
+                   jit_operand_imm (JIT_OPERAND_ABI_WORD, idx));
+      emit_retval (j, res);
+      emit_reload_sp (j);
+      jit_reloc_t done = jit_jmp (j->jit);
+
+      jit_patch_here (j->jit, fast);
+      jit_gpr_t new_freelist = T1;
+      emit_ldr (j, new_freelist, res);
+      jit_stxi (j->jit, offset, THREAD, new_freelist);
+
+      jit_patch_here (j->jit, done);
+      emit_sp_set_scm (j, dst, res);
+    }
+}
+
+static void
+compile_scm_ref (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_lshi (j, T1, T1, log2_sizeof_uintptr_t);
+  emit_ldxr (j, T0, T0, T1);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_scm_set (scm_jit_state *j, uint8_t obj, uint8_t idx, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_sp_ref_scm (j, T2, val);
+  emit_lshi (j, T1, T1, log2_sizeof_uintptr_t);
+  jit_stxr (j->jit, T0, T1, T2);
+}
+
+static void
+compile_scm_ref_tag (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t tag)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_ldr (j, T0, T0);
+  emit_subi (j, T0, T0, tag);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_scm_set_tag (scm_jit_state *j, uint8_t obj, uint8_t tag, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, val);
+  emit_addi (j, T1, T1, tag);
+  jit_str (j->jit, T0, T1);
+}
+
+static void
+compile_scm_ref_immediate (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_ldxi (j, T0, T0, idx * sizeof (SCM));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_scm_set_immediate (scm_jit_state *j, uint8_t obj, uint8_t idx, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, val);
+  jit_stxi (j->jit, idx * sizeof (SCM), T0, T1);
+}
+
+static void
+compile_word_ref (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_lshi (j, T1, T1, log2_sizeof_uintptr_t);
+  emit_ldxr (j, T0, T0, T1);
+  emit_sp_set_sz (j, dst, T0);
+}
+
+static void
+compile_word_set (scm_jit_state *j, uint8_t obj, uint8_t idx, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_sp_ref_sz (j, T2, val);
+  emit_lshi (j, T1, T1, log2_sizeof_uintptr_t);
+  jit_stxr (j->jit, T0, T1, T2);
+}
+
+static void
+compile_word_ref_immediate (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_ldxi (j, T0, T0, idx * sizeof (SCM));
+  emit_sp_set_sz (j, dst, T0);
+}
+
+static void
+compile_word_set_immediate (scm_jit_state *j, uint8_t obj, uint8_t idx, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_sz (j, T1, val);
+  jit_stxi (j->jit, idx * sizeof (SCM), T0, T1);
+}
+
+static void
+compile_pointer_ref_immediate (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_ldxi (j, T0, T0, idx * sizeof (SCM));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_pointer_set_immediate (scm_jit_state *j, uint8_t obj, uint8_t idx, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, val);
+  jit_stxi (j->jit, idx * sizeof (SCM), T0, T1);
+}
+
+static void
+compile_tail_pointer_ref_immediate (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t idx)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_addi (j, T0, T0, idx * sizeof (SCM));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_mov (scm_jit_state *j, uint16_t dst, uint16_t src)
+{
+  emit_mov (j, dst, src, T0);
+}
+
+static void
+compile_long_mov (scm_jit_state *j, uint32_t dst, uint32_t src)
+{
+  emit_mov (j, dst, src, T0);
+}
+
+static void
+compile_long_fmov (scm_jit_state *j, uint32_t dst, uint32_t src)
+{
+  jit_gpr_t t = T0;
+  restore_reloadable_register_state (j, FP_IN_REGISTER);
+  emit_fp_ref_scm (j, t, src);
+  emit_fp_set_scm (j, dst, t);
+}
+
+static void
+compile_call_scm_from_scm_scm (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+  int has_fast = 0;
+  jit_reloc_t fast;
+
+  jit_operand_t op_a = sp_scm_operand (j, a);
+  jit_operand_t op_b = sp_scm_operand (j, b);
+
+  switch ((enum scm_vm_intrinsic) idx)
+    {
+    case SCM_VM_INTRINSIC_ADD:
+      {
+        emit_sp_ref_scm (j, T0, a);
+        emit_sp_ref_scm (j, T1, b);
+        op_a = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0);
+        op_b = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T1);
+        jit_reloc_t a_not_inum = jit_bmci (j->jit, T0, scm_tc2_int);
+        jit_reloc_t b_not_inum = jit_bmci (j->jit, T1, scm_tc2_int);
+        jit_subi (j->jit, T0, T0, scm_tc2_int);
+        fast = jit_bxaddr (j->jit, T0, T1);
+        has_fast = 1;
+        /* Restore previous value before slow path.  */
+        jit_subr (j->jit, T0, T0, T1);
+        jit_addi (j->jit, T0, T0, scm_tc2_int);
+        jit_patch_here (j->jit, a_not_inum);
+        jit_patch_here (j->jit, b_not_inum);
+        break;
+      }
+    case SCM_VM_INTRINSIC_SUB:
+      {
+        emit_sp_ref_scm (j, T0, a);
+        emit_sp_ref_scm (j, T1, b);
+        op_a = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0);
+        op_b = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T1);
+        jit_reloc_t a_not_inum = jit_bmci (j->jit, T0, scm_tc2_int);
+        jit_reloc_t b_not_inum = jit_bmci (j->jit, T1, scm_tc2_int);
+        jit_subi (j->jit, T1, T1, scm_tc2_int);
+        fast = jit_bxsubr (j->jit, T0, T1);
+        has_fast = 1;
+        /* Restore previous values before slow path.  */
+        jit_addr (j->jit, T0, T0, T1);
+        jit_addi (j->jit, T1, T1, scm_tc2_int);
+        jit_patch_here (j->jit, a_not_inum);
+        jit_patch_here (j->jit, b_not_inum);
+        break;
+      }
+    default:
+      break;
+    }
+
+  emit_store_current_ip (j, T2);
+  emit_call_2 (j, intrinsic, op_a, op_b);
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+
+  if (has_fast)
+    jit_patch_here (j->jit, fast);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_scm_from_scm_uimm (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+  int has_fast = 0;
+  jit_reloc_t fast;
+
+  jit_operand_t op_a = sp_scm_operand (j, a);
+  jit_operand_t op_b = jit_operand_imm (JIT_OPERAND_ABI_UINT8, b);
+
+  switch ((enum scm_vm_intrinsic) idx)
+    {
+    case SCM_VM_INTRINSIC_ADD_IMMEDIATE:
+      {
+        emit_sp_ref_scm (j, T0, a);
+        op_a = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0);
+        scm_t_bits addend = b << 2;
+        jit_reloc_t not_inum = jit_bmci (j->jit, T0, 2);
+        fast = jit_bxaddi (j->jit, T0, addend);
+        has_fast = 1;
+        /* Restore previous value before slow path.  */
+        jit_subi (j->jit, T0, T0, addend);
+        jit_patch_here (j->jit, not_inum);
+        break;
+      }
+    case SCM_VM_INTRINSIC_SUB_IMMEDIATE:
+      {
+        emit_sp_ref_scm (j, T0, a);
+        op_a = jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0);
+        scm_t_bits subtrahend = b << 2;
+        jit_reloc_t not_inum = jit_bmci (j->jit, T0, 2);
+        fast = jit_bxsubi (j->jit, T0, subtrahend);
+        has_fast = 1;
+        /* Restore previous value before slow path.  */
+        jit_addi (j->jit, T0, T0, subtrahend);
+        jit_patch_here (j->jit, not_inum);
+        break;
+      }
+    default:
+      break;
+    }
+
+  emit_store_current_ip (j, T1);
+  emit_call_2 (j, intrinsic, op_a, op_b);
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+
+  if (has_fast)
+    jit_patch_here (j->jit, fast);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_scm_sz_u32 (scm_jit_state *j, uint8_t a, uint8_t b, uint8_t c, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_3 (j, intrinsic, sp_scm_operand (j, a), sp_sz_operand (j, b),
+               sp_sz_operand (j, c));
+  emit_reload_sp (j);
+}
+
+static void
+compile_call_scm_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, intrinsic, sp_scm_operand (j, a));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_f64_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, intrinsic, sp_scm_operand (j, a));
+  emit_retval_d (j, JIT_F0);
+  emit_reload_sp (j);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_call_u64_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+#if INDIRECT_INT64_INTRINSICS
+  emit_call_2 (j, intrinsic, sp_slot_operand (j, dst), sp_scm_operand (j, a));
+  emit_reload_sp (j);
+#else
+  emit_call_1 (j, intrinsic, sp_scm_operand (j, a));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_u64 (j, dst, T0);
+#endif
+}
+
+static void
+compile_make_short_immediate (scm_jit_state *j, uint8_t dst, SCM a)
+{
+  emit_movi (j, T0, SCM_UNPACK (a));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_make_long_immediate (scm_jit_state *j, uint32_t dst, SCM a)
+{
+  emit_movi (j, T0, SCM_UNPACK (a));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_make_long_long_immediate (scm_jit_state *j, uint32_t dst, SCM a)
+{
+  emit_movi (j, T0, SCM_UNPACK (a));
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_make_non_immediate (scm_jit_state *j, uint32_t dst, const void *data)
+{
+  emit_movi (j, T0, (uintptr_t)data);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_static_ref (scm_jit_state *j, uint32_t dst, void *loc)
+{
+  emit_ldi (j, T0, loc);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_static_set (scm_jit_state *j, uint32_t obj, void *loc)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  jit_sti (j->jit, loc, T0);
+}
+
+static void
+compile_static_patch (scm_jit_state *j, void *dst, const void *src)
+{
+  emit_movi (j, T0, (uintptr_t) src);
+  jit_sti (j->jit, dst, T0);
+}
+
+static void
+compile_prompt (scm_jit_state *j, uint32_t tag, uint8_t escape_only_p,
+                uint32_t proc_slot, const uint32_t *vcode)
+{
+  emit_store_current_ip (j, T0);
+
+  emit_reload_fp (j);
+  jit_subi (j->jit, FP, FP, proc_slot * sizeof (union scm_vm_stack_element));
+  jit_reloc_t mra = emit_mov_addr (j, T2);
+
+  jit_operand_t args[] =
+    { thread_operand (),
+      jit_operand_imm (JIT_OPERAND_ABI_UINT8, escape_only_p),
+      sp_scm_operand (j, tag),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, FP),
+      jit_operand_imm (JIT_OPERAND_ABI_POINTER, (uintptr_t)vcode),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T2) };
+  jit_calli (j->jit, scm_vm_intrinsics.push_prompt, 6, args);
+  clear_scratch_register_state (j);
+  emit_reload_sp (j);
+  emit_reload_fp (j);
+  add_inter_instruction_patch (j, mra, vcode);
+}
+
+static void
+compile_load_label (scm_jit_state *j, uint32_t dst, const uint32_t *vcode)
+{
+  emit_movi (j, T0, (uintptr_t) vcode);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_movi (j, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_call_s64_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx)
+{
+  compile_call_u64_from_scm (j, dst, a, idx);
+}
+
+static void
+compile_call_scm_from_u64 (scm_jit_state *j, uint16_t dst, uint16_t src, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+#if INDIRECT_INT64_INTRINSICS
+  emit_call_1 (j, intrinsic, sp_slot_operand (j, src));
+#else
+  emit_call_1 (j, intrinsic, sp_u64_operand (j, src));
+#endif
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_scm_from_s64 (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t b)
+{
+  compile_call_scm_from_u64 (j, dst, a, b);
+}
+
+static void
+compile_tag_char (scm_jit_state *j, uint16_t dst, uint16_t src)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, src);
+#else
+  emit_sp_ref_u64_lower_half (j, T0, src);
+#endif
+  emit_lshi (j, T0, T0, 8);
+  emit_addi (j, T0, T0, scm_tc8_char);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_untag_char (scm_jit_state *j, uint16_t dst, uint16_t src)
+{
+  emit_sp_ref_scm (j, T0, src);
+  emit_rshi (j, T0, T0, 8);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_movi (j, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_atomic_scm_ref_immediate (scm_jit_state *j, uint8_t dst, uint8_t obj, uint8_t offset)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_addi (j, T0, T0, offset * sizeof (SCM));
+  jit_ldr_atomic (j->jit, T0, T0);
+  record_gpr_clobber (j, T0);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_atomic_scm_set_immediate (scm_jit_state *j, uint8_t obj, uint8_t offset, uint8_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, val);
+  emit_addi (j, T0, T0, offset * sizeof (SCM));
+  jit_str_atomic (j->jit, T0, T1);
+}
+
+static void
+compile_atomic_scm_swap_immediate (scm_jit_state *j, uint32_t dst, uint32_t obj, uint8_t offset, uint32_t val)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, val);
+  emit_addi (j, T0, T0, offset * sizeof (SCM));
+  jit_swap_atomic (j->jit, T1, T0, T1);
+  record_gpr_clobber (j, T1);
+  emit_sp_set_scm (j, dst, T1);
+}
+
+static void
+compile_atomic_scm_compare_and_swap_immediate (scm_jit_state *j, uint32_t dst,
+                                               uint32_t obj, uint8_t offset,
+                                               uint32_t expected, uint32_t desired)
+{
+  emit_sp_ref_scm (j, T0, obj);
+  emit_sp_ref_scm (j, T1, expected);
+  emit_sp_ref_scm (j, T2, desired);
+  emit_addi (j, T0, T0, offset * sizeof (SCM));
+  jit_cas_atomic (j->jit, T1, T0, T1, T2);
+  record_gpr_clobber (j, T1);
+  emit_sp_set_scm (j, dst, T1);
+}
+
+static void
+compile_call_thread_scm_scm (scm_jit_state *j, uint16_t a, uint16_t b, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_3 (j, intrinsic, thread_operand (), sp_scm_operand (j, a),
+               sp_scm_operand (j, b));
+  emit_reload_sp (j);
+}
+
+static void
+compile_call_thread (scm_jit_state *j, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, intrinsic, thread_operand ());
+  emit_reload_sp (j);
+}
+
+static void
+compile_call_scm_from_thread_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, intrinsic, thread_operand (), sp_scm_operand (j, a));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_thread_scm (scm_jit_state *j, uint32_t a, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, intrinsic, thread_operand (), sp_scm_operand (j, a));
+  emit_reload_sp (j);
+}
+
+static void
+compile_call_scm_from_scm_u64 (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+#if INDIRECT_INT64_INTRINSICS
+  emit_call_2 (j, intrinsic, sp_scm_operand (j, a), sp_slot_operand (j, b));
+#else
+  emit_call_2 (j, intrinsic, sp_scm_operand (j, a), sp_u64_operand (j, b));
+#endif
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_call_scm_from_thread (scm_jit_state *j, uint32_t dst, uint32_t idx)
+{
+  void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+
+  emit_store_current_ip (j, T0);
+  emit_call_1 (j, intrinsic, thread_operand ());
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_fadd (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  emit_addr_d (j, JIT_F0, JIT_F0, JIT_F1);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_fsub (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  emit_subr_d (j, JIT_F0, JIT_F0, JIT_F1);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_fmul (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  emit_mulr_d (j, JIT_F0, JIT_F0, JIT_F1);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_fdiv (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  emit_divr_d (j, JIT_F0, JIT_F0, JIT_F1);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_uadd (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_addr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_addcr (j, T0, T0, T2);
+  emit_addxr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_usub (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_subr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_subcr (j, T0, T0, T2);
+  emit_subxr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_umul (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_mulr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: This is untested!  */
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_mulr (j, T1, T1, T2);      /* High A times low B */
+  emit_mulr (j, T3_OR_FP, T3_OR_FP, T0); /* High B times low A */
+  emit_addr (j, T1, T1, T3_OR_FP); /* Add high results, throw away overflow */
+  emit_qmulr_u (j, T0, T2, T0, T2); /* Low A times low B */
+  emit_addr (j, T1, T1, T2);        /* Add high result of low product */
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_uadd_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_addi (j, T0, T0, b);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_addci (j, T0, T0, b);
+  emit_addxi (j, T1, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_usub_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_subi (j, T0, T0, b);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_subci (j, T0, T0, b);
+  emit_subxi (j, T1, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_umul_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_muli (j, T0, T0, b);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: This is untested!  */
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_muli (j, T1, T1, b);         /* High A times low B */
+  /* High B times low A is 0.  */
+  emit_movi (j, T2, b);
+  emit_qmulr_u (j, T0, T2, T0, T2); /* Low A times low B */
+  emit_addr (j, T1, T1, T2);        /* Add high result of low product */
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_load_f64 (scm_jit_state *j, uint32_t dst, double a)
+{
+  jit_movi_d (j->jit, JIT_F0, a);
+  record_fpr_clobber (j, JIT_F0);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_load_u64 (scm_jit_state *j, uint32_t dst, uint64_t a)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_movi (j, T0, a);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_movi (j, T0, a & 0xffffffff);
+  emit_movi (j, T1, a >> 32);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_load_s64 (scm_jit_state *j, uint32_t dst, int64_t a)
+{
+  compile_load_u64 (j, dst, a);
+}
+
+static void
+compile_current_thread (scm_jit_state *j, uint32_t dst)
+{
+  emit_ldxi (j, T0, THREAD, thread_offset_handle);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_ulogand (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_andr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_andr (j, T0, T0, T2);
+  emit_andr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ulogior (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_orr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_orr (j, T0, T0, T2);
+  emit_orr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ulogsub (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_comr (j, T1, T1);
+  emit_andr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_comr (j, T2, T2);
+  emit_comr (j, T3_OR_FP, T3_OR_FP);
+  emit_andr (j, T0, T0, T2);
+  emit_andr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ursh (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_andi (j, T1, T1, 63);
+  emit_rshr_u (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  jit_reloc_t zero, both, done;
+
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_andi (j, T2, T2, 63);
+  zero = jit_beqi (j->jit, T2, 0);
+  both = jit_blti (j->jit, T2, 32);
+
+  /* 32 <= s < 64: hi = 0, lo = hi >> (s-32) */
+  emit_subi (j, T2, T2, 32);
+  emit_rshr_u (j, T0, T1, T2);
+  emit_movi (j, T1, 0);
+  done = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, both);
+  /* 0 < s < 32: hi = hi >> s, lo = lo >> s + hi << (32-s) */
+  emit_negr (j, T3_OR_FP, T2);
+  emit_addi (j, T3_OR_FP, T3_OR_FP, 32);
+  emit_lshr (j, T3_OR_FP, T1, T3_OR_FP);
+  emit_rshr_u (j, T1, T1, T2);
+  emit_rshr_u (j, T0, T0, T2);
+  emit_addr (j, T0, T0, T3_OR_FP);
+
+  jit_patch_here (j->jit, done);
+  jit_patch_here (j->jit, zero);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ulsh (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_andi (j, T1, T1, 63);
+  emit_lshr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  jit_reloc_t zero, both, done;
+
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_andi (j, T2, T2, 63);
+  zero = jit_beqi (j->jit, T2, 0);
+  both = jit_blti (j->jit, T2, 32);
+
+  /* 32 <= s < 64: hi = lo << (s-32), lo = 0 */
+  emit_subi (j, T2, T2, 32);
+  emit_lshr (j, T1, T0, T2);
+  emit_movi (j, T0, 0);
+  done = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, both);
+  /* 0 < s < 32: hi = hi << s + lo >> (32-s), lo = lo << s */
+  emit_negr (j, T3_OR_FP, T2);
+  emit_addi (j, T3_OR_FP, T3_OR_FP, 32);
+  emit_rshr_u (j, T3_OR_FP, T0, T3_OR_FP);
+  emit_lshr (j, T1, T1, T2);
+  emit_lshr (j, T0, T0, T2);
+  emit_addr (j, T1, T1, T3_OR_FP);
+
+  jit_patch_here (j->jit, done);
+  jit_patch_here (j->jit, zero);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ursh_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  b &= 63;
+
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_rshi_u (j, T0, T0, b);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  emit_sp_ref_u64 (j, T0, T1, a);
+  if (b == 0)
+    {
+      /* Nothing to do.  */
+    }
+  else if (b < 32)
+    {
+      /* 0 < s < 32: hi = hi >> s, lo = lo >> s + hi << (32-s) */
+      emit_lshi (j, T2, T1, 32 - b);
+      emit_rshi_u (j, T1, T1, b);
+      emit_rshi_u (j, T0, T0, b);
+      emit_addr (j, T0, T0, T2);
+    }
+  else if (b == 32)
+    {
+      /*  hi = 0, lo = hi */
+      emit_movr (j, T0, T1);
+      emit_movi (j, T1, 0);
+    }
+  else /* b > 32 */
+    {
+      /*  hi = 0, lo = hi >> (s-32) */
+      emit_rshi_u (j, T0, T1, b - 32);
+      emit_movi (j, T1, 0);
+    }
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ulsh_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  b &= 63;
+
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_lshi (j, T0, T0, b);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  emit_sp_ref_u64 (j, T0, T1, a);
+  if (b == 0)
+    {
+      /* Nothing to do.  */
+    }
+  else if (b < 32)
+    {
+      /* hi = hi << s + lo >> (32-s), lo = lo << s */
+      emit_rshi_u (j, T2, T0, 32 - b);
+      emit_lshi (j, T1, T1, b);
+      emit_lshi (j, T0, T0, b);
+      emit_addr (j, T1, T1, T2);
+    }
+  else if (b == 32)
+    {
+      /*  hi = lo, lo = 0 */
+      emit_movr (j, T1, T0);
+      emit_movi (j, T0, 0);
+    }
+  else /* b > 32 */
+    {
+      /* hi = lo << (s-32), lo = 0 */
+      emit_lshi (j, T1, T0, b - 32);
+      emit_movi (j, T0, 0);
+    }
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_ulogxor (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  emit_xorr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  emit_xorr (j, T0, T0, T2);
+  emit_xorr (j, T1, T1, T3_OR_FP);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_handle_interrupts (scm_jit_state *j)
+{
+  uint32_t saved_state = save_reloadable_register_state (j);
+
+  /* This instruction invalidates SP_CACHE_GPR / SP_CACHE_FPR.  */
+
+  void *again = jit_address (j->jit);
+
+  jit_addi (j->jit, T0, THREAD, thread_offset_pending_asyncs);
+  jit_ldr_atomic (j->jit, T0, T0);
+  jit_reloc_t none_pending = jit_beqi (j->jit, T0, SCM_UNPACK (SCM_EOL));
+  jit_ldxi_i (j->jit, T0, THREAD, thread_offset_block_asyncs);
+  jit_reloc_t blocked = jit_bnei (j->jit, T0, 0);
+
+  emit_store_current_ip (j, T0);
+  jit_jmpi_with_link (j->jit, handle_interrupts_trampoline);
+  jit_jmpi (j->jit, again);
+
+  jit_patch_here (j->jit, none_pending);
+  jit_patch_here (j->jit, blocked);
+  j->register_state = saved_state;
+}
+
+static void
+compile_return_from_interrupt (scm_jit_state *j)
+{
+  jit_gpr_t old_fp = T0, ra = T1;
+  jit_reloc_t interp;
+
+  emit_pop_fp (j, old_fp);
+
+  emit_load_mra (j, ra, old_fp);
+  interp = jit_beqi (j->jit, ra, 0);
+  jit_addi (j->jit, SP, old_fp, frame_overhead_slots * sizeof (union scm_vm_stack_element));
+  set_register_state (j, SP_IN_REGISTER);
+  emit_store_sp (j);
+  jit_jmpr (j->jit, ra);
+
+  jit_patch_here (j->jit, interp);
+  emit_load_vra (j, ra, old_fp);
+  emit_store_ip (j, ra);
+  jit_addi (j->jit, SP, old_fp, frame_overhead_slots * sizeof (union scm_vm_stack_element));
+  set_register_state (j, SP_IN_REGISTER);
+  emit_store_sp (j);
+  emit_exit (j);
+
+  clear_register_state (j, SP_CACHE_GPR | SP_CACHE_FPR);
+}
+
+static enum scm_opcode
+fuse_conditional_branch (scm_jit_state *j, uint32_t **target)
+{
+  uint8_t next = j->next_ip[0] & 0xff;
+
+  switch (next)
+    {
+    case scm_op_jl:
+    case scm_op_je:
+    case scm_op_jnl:
+    case scm_op_jne:
+    case scm_op_jge:
+    case scm_op_jnge:
+      *target = j->next_ip + (((int32_t) j->next_ip[0]) >> 8);
+      j->next_ip += op_lengths[next];
+      return next;
+    default:
+      ASSERT (0);
+    }
+}
+
+static void
+compile_u64_numerically_equal (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  uint32_t *target;
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_beqr (j->jit, T0, T1);
+      break;
+    case scm_op_jne:
+      k = jit_bner (j->jit, T0, T1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2;
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k1 = jit_bner (j->jit, T0, T2);
+      k2 = jit_beqr (j->jit, T1, T3_OR_FP);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    case scm_op_jne:
+      k1 = jit_bner (j->jit, T0, T2);
+      k2 = jit_bner (j->jit, T1, T3_OR_FP);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_u64_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  uint32_t *target;
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  emit_sp_ref_u64 (j, T0, a);
+  emit_sp_ref_u64 (j, T1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_bltr_u (j->jit, T0, T1);
+      break;
+    case scm_op_jnl:
+      k = jit_bger_u (j->jit, T0, T1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2, k3;
+  emit_sp_ref_u64 (j, T0, T1, a);
+  emit_sp_ref_u64 (j, T2, T3_OR_FP, b);
+  k1 = jit_bltr_u (j->jit, T1, T3_OR_FP);
+  k2 = jit_bner (j->jit, T1, T3_OR_FP);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k3 = jit_bltr_u (j->jit, T0, T2);
+      jit_patch_here (j->jit, k2);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    case scm_op_jnl:
+      k3 = jit_bger_u (j->jit, T0, T2);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_s64_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  uint32_t *target;
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  emit_sp_ref_s64 (j, T0, a);
+  emit_sp_ref_s64 (j, T1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_bltr (j->jit, T0, T1);
+      break;
+    case scm_op_jnl:
+      k = jit_bger (j->jit, T0, T1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2, k3;
+  emit_sp_ref_s64 (j, T0, T1, a);
+  emit_sp_ref_s64 (j, T2, T3_OR_FP, b);
+  k1 = jit_bltr (j->jit, T1, T3_OR_FP);
+  k2 = jit_bner (j->jit, T1, T3_OR_FP);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k3 = jit_bltr (j->jit, T0, T2);
+      jit_patch_here (j->jit, k2);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    case scm_op_jnl:
+      k3 = jit_bger (j->jit, T0, T2);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_f64_numerically_equal (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_beqr_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    case scm_op_jne:
+      k = jit_bner_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_f64_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_f64 (j, JIT_F0, a);
+  emit_sp_ref_f64 (j, JIT_F1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_bltr_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    case scm_op_jnl:
+      k = jit_bunger_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    case scm_op_jge:
+      k = jit_bger_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    case scm_op_jnge:
+      k = jit_bunltr_d (j->jit, JIT_F0, JIT_F1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_numerically_equal (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, scm_vm_intrinsics.numerically_equal_p,
+               sp_scm_operand (j, a), sp_scm_operand (j, b));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_bnei (j->jit, T0, 0);
+      break;
+    case scm_op_jne:
+      k = jit_beqi (j->jit, T0, 0);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t fast, k2, k3;
+  jit_reloc_t k1;
+  uint32_t *target;
+  enum scm_opcode op = fuse_conditional_branch (j, &target);
+
+  emit_sp_ref_scm (j, T0, a);
+  emit_sp_ref_scm (j, T1, b);
+
+  emit_andr (j, T2, T0, T1);
+  fast = jit_bmsi (j->jit, T2, scm_tc2_int);
+
+  emit_store_current_ip (j, T2);
+  emit_call_2 (j, scm_vm_intrinsics.less_p,
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T0),
+               jit_operand_gpr (JIT_OPERAND_ABI_POINTER, T1));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  switch (op)
+    {
+    case scm_op_jl:
+      k1 = jit_beqi (j->jit, T0, SCM_F_COMPARE_LESS_THAN);
+      break;
+    case scm_op_jnl:
+      k1 = jit_bnei (j->jit, T0, SCM_F_COMPARE_LESS_THAN);
+      break;
+    case scm_op_jge:
+      k1 = jit_beqi (j->jit, T0, SCM_F_COMPARE_NONE);
+      break;
+    case scm_op_jnge:
+      k1 = jit_bnei (j->jit, T0, SCM_F_COMPARE_NONE);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  k2 = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, fast);
+  switch (op)
+    {
+    case scm_op_jl:
+    case scm_op_jnge:
+      k3 = jit_bltr (j->jit, T0, T1);
+      break;
+    case scm_op_jnl:
+    case scm_op_jge:
+      k3 = jit_bger (j->jit, T0, T1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+
+  jit_patch_here (j->jit, k2);
+
+  add_inter_instruction_patch (j, k1, target);
+  add_inter_instruction_patch (j, k3, target);
+}
+
+static void
+compile_check_arguments (scm_jit_state *j, uint32_t expected)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+  jit_gpr_t t = T0;
+  
+  emit_reload_fp (j);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jne:
+      k = emit_branch_if_frame_locals_count_not_eq (j, t, expected);
+      break;
+    case scm_op_jl:
+      k = emit_branch_if_frame_locals_count_less_than (j, t, expected);
+      break;
+    case scm_op_jge:
+      /* The arguments<=? instruction sets NONE to indicate
+         greater-than, whereas for <, NONE usually indicates
+         greater-than-or-equal, hence the name jge.  So we need to fuse
+         to greater-than, not greater-than-or-equal.  Perhaps we just
+         need to rename jge to br-if-none.  */
+      k = emit_branch_if_frame_locals_count_greater_than (j, t, expected);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_check_positional_arguments (scm_jit_state *j, uint32_t nreq, uint32_t expected)
+{
+  uint32_t *target;
+  jit_reloc_t lt, gt;
+  jit_gpr_t walk = T0, min = T1, obj = T2;
+
+  ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER);
+
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jge:
+      /* Like arguments<=?, this instruction sets NONE to indicate
+         greater-than, whereas for <, NONE usually indicates
+         greater-than-or-equal, hence the name jge.  So we need to fuse
+         to greater-than, not greater-than-or-equal.  Perhaps we just
+         need to rename jge to br-if-none.  */
+      /* Break to target if npos > expected.  */
+      break;
+    default:
+      UNREACHABLE ();
+    }
+
+  emit_subtract_stack_slots (j, min, FP, expected);
+  emit_subtract_stack_slots (j, walk, FP, nreq);
+  
+  void *head = jit_address (j->jit);
+  /* npos > expected if walk < min.  */
+  gt = jit_bltr (j->jit, walk, min);
+  emit_subtract_stack_slots (j, walk, walk, 1);
+  lt = jit_bltr (j->jit, walk, SP);
+  emit_ldr (j, obj, walk);
+  jit_patch_there
+    (j->jit,
+     emit_branch_if_immediate (j, obj),
+     head);
+  jit_patch_there
+    (j->jit,
+     emit_branch_if_heap_object_not_tc7 (j, obj, obj, scm_tc7_keyword),
+     head);
+  jit_patch_here (j->jit, lt);
+  add_inter_instruction_patch (j, gt, target);
+}
+
+static void
+compile_immediate_tag_equals (scm_jit_state *j, uint32_t a, uint16_t mask,
+                              uint16_t expected)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_scm (j, T0, a);
+  emit_andi (j, T0, T0, mask);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_beqi (j->jit, T0, expected);
+      break;
+    case scm_op_jne:
+      k = jit_bnei (j->jit, T0, expected);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_heap_tag_equals (scm_jit_state *j, uint32_t obj,
+                         uint16_t mask, uint16_t expected)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_scm (j, T0, obj);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = emit_branch_if_heap_object_has_tc (j, T0, T0, mask, expected);
+      break;
+    case scm_op_jne:
+      k = emit_branch_if_heap_object_not_tc (j, T0, T0, mask, expected);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_eq (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_scm (j, T0, a);
+  emit_sp_ref_scm (j, T1, b);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_beqr (j->jit, T0, T1);
+      break;
+    case scm_op_jne:
+      k = jit_bner (j->jit, T0, T1);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_j (scm_jit_state *j, const uint32_t *vcode)
+{
+  jit_reloc_t jmp;
+  jmp = jit_jmp (j->jit);
+  add_inter_instruction_patch (j, jmp, vcode);
+}
+
+static void
+compile_jl (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_je (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_jnl (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_jne (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_jge (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_jnge (scm_jit_state *j, const uint32_t *vcode)
+{
+  UNREACHABLE (); /* All tests should fuse their following branches.  */
+}
+
+static void
+compile_heap_numbers_equal (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_store_current_ip (j, T0);
+  emit_call_2 (j, scm_vm_intrinsics.heap_numbers_equal_p, sp_scm_operand (j, a),
+               sp_scm_operand (j, b));
+  emit_retval (j, T0);
+  emit_reload_sp (j);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_bnei (j->jit, T0, 0);
+      break;
+    case scm_op_jne:
+      k = jit_beqi (j->jit, T0, 0);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+}
+
+static void
+compile_untag_fixnum (scm_jit_state *j, uint16_t dst, uint16_t a)
+{
+  emit_sp_ref_scm (j, T0, a);
+  emit_rshi (j, T0, T0, 2);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  /* FIXME: Untested!  */
+  emit_rshi (j, T1, T0, 31);
+  emit_sp_set_s64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_tag_fixnum (scm_jit_state *j, uint16_t dst, uint16_t a)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_s64 (j, T0, a);
+#else
+  emit_sp_ref_s32 (j, T0, a);
+#endif
+  emit_lshi (j, T0, T0, 2);
+  emit_addi (j, T0, T0, scm_tc2_int);
+  emit_sp_set_scm (j, dst, T0);
+}
+
+static void
+compile_srsh (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_s64 (j, T0, a);
+  emit_sp_ref_s64 (j, T1, b);
+  emit_andi (j, T1, T1, 63);
+  emit_rshr (j, T0, T0, T1);
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  jit_reloc_t zero, both, done;
+
+  emit_sp_ref_s64 (j, T0, T1, a);
+  emit_sp_ref_s64 (j, T2, T3_OR_FP, b);
+  emit_andi (j, T2, T2, 63);
+  zero = jit_beqi (j->jit, T2, 0);
+  both = jit_blti (j->jit, T2, 32);
+
+  /* 32 <= s < 64: hi = hi >> 31, lo = hi >> (s-32) */
+  emit_subi (j, T2, T2, 32);
+  emit_rshr (j, T0, T1, T2);
+  emit_rshi (j, T1, T1, 31);
+  done = jit_jmp (j->jit);
+
+  jit_patch_here (j->jit, both);
+  /* 0 < s < 32: hi = hi >> s, lo = lo >> s + hi << (32-s) */
+  emit_negr (j, T3_OR_FP, T2);
+  emit_addi (j, T3_OR_FP, T3_OR_FP, 32);
+  emit_lshr (j, T3_OR_FP, T1, T3_OR_FP);
+  emit_rshr (j, T1, T1, T2);
+  emit_rshr_u (j, T0, T0, T2);
+  emit_addr (j, T0, T0, T3_OR_FP);
+
+  jit_patch_here (j->jit, done);
+  jit_patch_here (j->jit, zero);
+  emit_sp_set_s64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_srsh_immediate (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b)
+{
+  b &= 63;
+
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_s64 (j, T0, a);
+  emit_rshi (j, T0, T0, b);
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  /* FIXME: Not tested.  */
+  emit_sp_ref_s64 (j, T0, T1, a);
+  if (b == 0)
+    {
+      /* Nothing to do.  */
+    }
+  else if (b < 32)
+    {
+      /* 0 < s < 32: hi = hi >> s, lo = lo >> s + hi << (32-s) */
+      emit_lshi (j, T2, T1, 32 - b);
+      emit_rshi (j, T1, T1, b);
+      emit_rshi_u (j, T0, T0, b);
+      emit_addr (j, T0, T0, T2);
+    }
+  else if (b == 32)
+    {
+      /*  hi = sign-ext, lo = hi */
+      emit_movr (j, T0, T1);
+      emit_rshi (j, T1, T1, 31);
+    }
+  else /* b > 32 */
+    {
+      /*  hi = sign-ext, lo = hi >> (s-32) */
+      emit_rshi (j, T0, T1, b - 32);
+      emit_rshi (j, T1, T1, 31);
+    }
+  emit_sp_set_s64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_s64_imm_numerically_equal (scm_jit_state *j, uint16_t a, int16_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k = jit_beqi (j->jit, T0, b);
+      break;
+    case scm_op_jne:
+      k = jit_bnei (j->jit, T0, b);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, T1, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_je:
+      k1 = jit_bnei (j->jit, T0, b);
+      k2 = jit_beqi (j->jit, T1, b < 0 ? -1 : 0);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    case scm_op_jne:
+      k1 = jit_bnei (j->jit, T0, b);
+      k2 = jit_bnei (j->jit, T1, b < 0 ? -1 : 0);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_u64_imm_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_u64 (j, T0, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_blti_u (j->jit, T0, b);
+      break;
+    case scm_op_jnl:
+      k = jit_bgei_u (j->jit, T0, b);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2;
+  uint32_t *target;
+
+  emit_sp_ref_u64 (j, T0, T1, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k1 = jit_bnei (j->jit, T1, 0);
+      k2 = jit_blti_u (j->jit, T0, b);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    case scm_op_jnl:
+      k1 = jit_bnei (j->jit, T1, 0);
+      k2 = jit_bgei_u (j->jit, T0, b);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_imm_u64_less (scm_jit_state *j, uint16_t a, uint16_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_u64 (j, T0, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_bgti_u (j->jit, T0, b);
+      break;
+    case scm_op_jnl:
+      k = jit_blei_u (j->jit, T0, b);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2;
+  uint32_t *target;
+
+  emit_sp_ref_u64 (j, T0, T1, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k1 = jit_bnei (j->jit, T1, 0);
+      k2 = jit_bgti_u (j->jit, T0, b);
+      add_inter_instruction_patch (j, k1, target);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    case scm_op_jnl:
+      k1 = jit_bnei (j->jit, T1, 0);
+      k2 = jit_blei_u (j->jit, T0, b);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_s64_imm_less (scm_jit_state *j, uint16_t a, int16_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_blti (j->jit, T0, b);
+      break;
+    case scm_op_jnl:
+      k = jit_bgei (j->jit, T0, b);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2, k3;
+  int32_t sign = b < 0 ? -1 : 0;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, T1, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k1 = jit_blti (j->jit, T1, sign);
+      k2 = jit_bnei (j->jit, T1, sign);
+      k3 = jit_blti (j->jit, T0, b);
+      add_inter_instruction_patch (j, k1, target);
+      jit_patch_here (j->jit, k2);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    case scm_op_jnl:
+      k1 = jit_blti (j->jit, T1, sign);
+      k2 = jit_bnei (j->jit, T1, sign);
+      k3 = jit_bgei (j->jit, T0, b);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_imm_s64_less (scm_jit_state *j, uint16_t a, int16_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+  jit_reloc_t k;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k = jit_bgti (j->jit, T0, b);
+      break;
+    case scm_op_jnl:
+      k = jit_blei (j->jit, T0, b);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+  add_inter_instruction_patch (j, k, target);
+#else
+  jit_reloc_t k1, k2, k3;
+  int32_t sign = b < 0 ? -1 : 0;
+  uint32_t *target;
+
+  emit_sp_ref_s64 (j, T0, T1, a);
+  switch (fuse_conditional_branch (j, &target))
+    {
+    case scm_op_jl:
+      k1 = jit_blti (j->jit, T1, sign);
+      k2 = jit_bnei (j->jit, T1, sign);
+      k3 = jit_bgti (j->jit, T0, b);
+      jit_patch_here (j->jit, k1);
+      add_inter_instruction_patch (j, k2, target);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    case scm_op_jnl:
+      k1 = jit_blti (j->jit, T1, sign);
+      k2 = jit_bnei (j->jit, T1, sign);
+      k3 = jit_blei (j->jit, T0, b);
+      add_inter_instruction_patch (j, k1, target);
+      jit_patch_here (j->jit, k2);
+      add_inter_instruction_patch (j, k3, target);
+      break;
+    default:
+      UNREACHABLE ();
+    }
+#endif
+}
+
+static void
+compile_u8_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_uc (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_movi (j, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_u16_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_us (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_movi (j, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_u32_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  jit_ldxr_ui (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_ldxr (j, T0, T0, T1);
+  emit_movi (j, T1, 0);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_u64_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_ldxr (j, T0, T0, T1);
+  emit_sp_set_u64 (j, dst, T0);
+#else
+  emit_addr (j, T0, T0, T1);
+  if (BIGENDIAN)
+    {
+      emit_ldr (j, T1, T0);
+      emit_ldxi (j, T0, T0, 4);
+    }
+  else
+    {
+      emit_ldxi (j, T1, T0, 4);
+      emit_ldr (j, T0, T0);
+    }
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_u8_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T2, v);
+#else
+  emit_sp_ref_u64_lower_half (j, T2, v);
+#endif
+  jit_stxr_c (j->jit, T0, T1, T2);
+}
+
+static void
+compile_u16_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T2, v);
+#else
+  emit_sp_ref_u64_lower_half (j, T2, v);
+#endif
+  jit_stxr_s (j->jit, T0, T1, T2);
+}
+
+static void
+compile_u32_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T2, v);
+  jit_stxr_i (j->jit, T0, T1, T2);
+#else
+  emit_sp_ref_u64_lower_half (j, T2, v);
+  jit_stxr (j->jit, T0, T1, T2);
+#endif
+}
+
+static void
+compile_u64_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_ref_u64 (j, T2, v);
+  jit_stxr (j->jit, T0, T1, T2);
+#else
+  jit_addr (j->jit, T0, T0, T1);
+  emit_sp_ref_u64 (j, T1, T2, v);
+  if (BIGENDIAN)
+    {
+      jit_str (j->jit, T0, T2);
+      jit_stxi (j->jit, 4, T0, T1);
+    }
+  else
+    {
+      jit_str (j->jit, T0, T1);
+      jit_stxi (j->jit, 4, T0, T2);
+    }
+#endif
+}
+
+static void
+compile_s8_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_c (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  emit_rshi (j, T1, T0, 7);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_s16_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_s (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  emit_rshi (j, T1, T0, 15);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_s32_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_i (j->jit, T0, T0, T1);
+  record_gpr_clobber (j, T0);
+#if SIZEOF_UINTPTR_T >= 8
+  emit_sp_set_s64 (j, dst, T0);
+#else
+  emit_rshi (j, T1, T0, 31);
+  emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+
+static void
+compile_s64_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  compile_u64_ref (j, dst, ptr, idx);
+}
+
+static void
+compile_s8_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  compile_u8_set (j, ptr, idx, v);
+}
+
+static void
+compile_s16_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  compile_u16_set (j, ptr, idx, v);
+}
+
+static void
+compile_s32_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  compile_u32_set (j, ptr, idx, v);
+}
+
+static void
+compile_s64_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  compile_u64_set (j, ptr, idx, v);
+}
+
+static void
+compile_f32_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_f (j->jit, JIT_F0, T0, T1);
+  record_fpr_clobber (j, JIT_F0);
+  jit_extr_f_d (j->jit, JIT_F0, JIT_F0);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_f64_ref (scm_jit_state *j, uint8_t dst, uint8_t ptr, uint8_t idx)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  jit_ldxr_d (j->jit, JIT_F0, T0, T1);
+  record_fpr_clobber (j, JIT_F0);
+  emit_sp_set_f64 (j, dst, JIT_F0);
+}
+
+static void
+compile_f32_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_sp_ref_f64 (j, JIT_F0, v);
+  jit_extr_d_f (j->jit, JIT_F0, JIT_F0);
+  record_fpr_clobber (j, JIT_F0);
+  jit_stxr_f (j->jit, T0, T1, JIT_F0);
+}
+
+static void
+compile_f64_set (scm_jit_state *j, uint8_t ptr, uint8_t idx, uint8_t v)
+{
+  emit_sp_ref_ptr (j, T0, ptr);
+  emit_sp_ref_sz (j, T1, idx);
+  emit_sp_ref_f64 (j, JIT_F0, v);
+  jit_stxr_d (j->jit, T0, T1, JIT_F0);
+}
+
+
+#define UNPACK_8_8_8(op,a,b,c)            \
+  do                                      \
+    {                                     \
+      a = (op >> 8) & 0xff;               \
+      b = (op >> 16) & 0xff;              \
+      c = op >> 24;                       \
+    }                                     \
+  while (0)
+
+#define UNPACK_8_16(op,a,b)               \
+  do                                      \
+    {                                     \
+      a = (op >> 8) & 0xff;               \
+      b = op >> 16;                       \
+    }                                     \
+  while (0)
+
+#define UNPACK_12_12(op,a,b)              \
+  do                                      \
+    {                                     \
+      a = (op >> 8) & 0xfff;              \
+      b = op >> 20;                       \
+    }                                     \
+  while (0)
+
+#define UNPACK_24(op,a)                   \
+  do                                      \
+    {                                     \
+      a = op >> 8;                        \
+    }                                     \
+  while (0)
+
+#define UNPACK_8_24(op,a,b)               \
+  do                                      \
+    {                                     \
+      a = op & 0xff;                      \
+      b = op >> 8;                        \
+    }                                     \
+  while (0)
+
+#define UNPACK_16_16(op,a,b)              \
+  do                                      \
+    {                                     \
+      a = op & 0xffff;                    \
+      b = op >> 16;                       \
+    }                                     \
+  while (0)
+
+#define COMPILE_OP1(t0) \
+  COMPILE_##t0
+#define COMPILE_OP2(t0, t1) \
+  COMPILE_##t0##__##t1
+#define COMPILE_OP3(t0, t1, t2) \
+  COMPILE_##t0##__##t1##__##t2
+#define COMPILE_OP4(t0, t1, t2, t3) \
+  COMPILE_##t0##__##t1##__##t2##__##t3
+#define COMPILE_OP5(t0, t1, t2, t3, t4) \
+  COMPILE_##t0##__##t1##__##t2##__##t3##__##t4
+
+#define COMPILE_DOP1(t0)                 COMPILE_OP1(t0)
+#define COMPILE_DOP2(t0, t1)             COMPILE_OP2(t0, t1)
+#define COMPILE_DOP3(t0, t1, t2)         COMPILE_OP3(t0, t1, t2)
+#define COMPILE_DOP4(t0, t1, t2, t3)     COMPILE_OP4(t0, t1, t2, t3)
+#define COMPILE_DOP5(t0, t1, t2, t3, t4) COMPILE_OP5(t0, t1, t2, t3, t4)
+
+#define COMPILE_NOP(j, comp)          \
+  {                                   \
+    bad_instruction (j);              \
+  }
+
+#define COMPILE_X32(j, comp)                                            \
+  {                                                                     \
+    comp (j);                                                           \
+  }
+
+#define COMPILE_X8_C24(j, comp)                                         \
+  {                                                                     \
+    uint32_t a;                                                         \
+    UNPACK_24 (j->ip[0], a);                                            \
+    comp (j, a);                                                        \
+  }
+#define COMPILE_X8_F24(j, comp)                                         \
+  COMPILE_X8_C24 (j, comp)
+#define COMPILE_X8_S24(j, comp)                                         \
+  COMPILE_X8_C24 (j, comp)
+
+#define COMPILE_X8_L24(j, comp)                                         \
+  {                                                                     \
+    int32_t a = j->ip[0];                                               \
+    a >>= 8; /* Sign extension.  */                                     \
+    comp (j, j->ip + a);                                                \
+  }
+#define COMPILE_X8_C12_C12(j, comp)                                     \
+  {                                                                     \
+    uint16_t a, b;                                                      \
+    UNPACK_12_12 (j->ip[0], a, b);                                      \
+    comp (j, a, b);                                                     \
+  }
+#define COMPILE_X8_S12_C12(j, comp)                                     \
+  COMPILE_X8_C12_C12 (j, comp)
+#define COMPILE_X8_S12_S12(j, comp)                                     \
+  COMPILE_X8_C12_C12 (j, comp)
+#define COMPILE_X8_F12_F12(j, comp)                                     \
+  COMPILE_X8_C12_C12 (j, comp)
+
+#define COMPILE_X8_S12_Z12(j, comp)                                     \
+  {                                                                     \
+    uint16_t a = (j->ip[0] >> 8) & 0xfff;                               \
+    int16_t b = ((int32_t) j->ip[0]) >> 20; /* Sign extension.  */      \
+    comp (j, a, b);                                                     \
+  }
+
+#define COMPILE_X8_S8_C8_S8(j, comp)                                    \
+  {                                                                     \
+    uint8_t a, b, c;                                                    \
+    UNPACK_8_8_8 (j->ip[0], a, b, c);                                   \
+    comp (j, a, b, c);                                                  \
+  }
+#define COMPILE_X8_S8_S8_C8(j, comp)                                    \
+  COMPILE_X8_S8_C8_S8 (j, comp)
+#define COMPILE_X8_S8_S8_S8(j, comp)                                    \
+  COMPILE_X8_S8_C8_S8 (j, comp)
+
+#define COMPILE_X8_S8_I16(j, comp)                                      \
+  {                                                                     \
+    uint8_t a;                                                          \
+    scm_t_bits b;                                                       \
+    UNPACK_8_16 (j->ip[0], a, b);                                       \
+    comp (j, a, SCM_PACK (b));                                          \
+  }
+
+#define COMPILE_X32__C32(j, comp)                                       \
+  {                                                                     \
+    comp (j, j->ip[1]);                                                 \
+  }
+
+#define COMPILE_X32__L32(j, comp)                                       \
+  {                                                                     \
+    int32_t a = j->ip[1];                                               \
+    comp (j, j->ip + a);                                                \
+  }
+#define COMPILE_X32__N32(j, comp)                                       \
+  COMPILE_X32__L32 (j, comp)
+
+#define COMPILE_X8_C24__L32(j, comp)                                    \
+  {                                                                     \
+    uint32_t a;                                                         \
+    int32_t b;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = j->ip[1];                                                       \
+    comp (j, a, j->ip + b);                                             \
+  }
+#define COMPILE_X8_S24__L32(j, comp)                                    \
+  COMPILE_X8_C24__L32 (j, comp)
+#define COMPILE_X8_S24__LO32(j, comp)                                   \
+  COMPILE_X8_C24__L32 (j, comp)
+#define COMPILE_X8_S24__N32(j, comp)                                    \
+  COMPILE_X8_C24__L32 (j, comp)
+#define COMPILE_X8_S24__R32(j, comp)                                    \
+  COMPILE_X8_C24__L32 (j, comp)
+
+#define COMPILE_X8_C24__X8_C24(j, comp)                                 \
+  {                                                                     \
+    uint32_t a, b;                                                      \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_24 (j->ip[1], b);                                            \
+    comp (j, a, b);                                                     \
+  }
+#define COMPILE_X8_F24__X8_C24(j, comp)                                 \
+  COMPILE_X8_C24__X8_C24(j, comp)
+#define COMPILE_X8_F24__X8_F24(j, comp)                                 \
+  COMPILE_X8_C24__X8_C24(j, comp)
+#define COMPILE_X8_S24__X8_S24(j, comp)                                 \
+  COMPILE_X8_C24__X8_C24(j, comp)
+
+#define COMPILE_X8_F12_F12__X8_C24(j, comp)                             \
+  {                                                                     \
+    uint16_t a, b;                                                      \
+    uint32_t c;                                                         \
+    UNPACK_12_12 (j->ip[0], a, b);                                      \
+    UNPACK_24 (j->ip[1], c);                                            \
+    comp (j, a, b, c);                                                  \
+  }
+
+#define COMPILE_X8_F24__B1_X7_C24(j, comp)                              \
+  {                                                                     \
+    uint32_t a, c;                                                      \
+    uint8_t b;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = j->ip[1] & 0x1;                                                 \
+    UNPACK_24 (j->ip[1], c);                                            \
+    comp (j, a, b, c);                                                  \
+  }
+
+#define COMPILE_X8_S12_S12__C32(j, comp)                                \
+  {                                                                     \
+    uint16_t a, b;                                                      \
+    uint32_t c;                                                         \
+    UNPACK_12_12 (j->ip[0], a, b);                                      \
+    c = j->ip[1];                                                       \
+    comp (j, a, b, c);                                                  \
+  }
+
+#define COMPILE_X8_S24__C16_C16(j, comp)                                \
+  {                                                                     \
+    uint32_t a;                                                         \
+    uint16_t b, c;                                                      \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_16_16 (j->ip[1], b, c);                                      \
+    comp (j, a, b, c);                                                  \
+  }
+
+#define COMPILE_X8_S24__C32(j, comp)                                    \
+  {                                                                     \
+    uint32_t a, b;                                                      \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = j->ip[1];                                                       \
+    comp (j, a, b);                                                     \
+  }
+
+#define COMPILE_X8_S24__I32(j, comp)                                    \
+  {                                                                     \
+    uint32_t a;                                                         \
+    scm_t_bits b;                                                       \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = j->ip[1];                                                       \
+    comp (j, a, SCM_PACK (b));                                          \
+  }
+
+#define COMPILE_X8_S8_S8_C8__C32(j, comp)                               \
+  {                                                                     \
+    uint8_t a, b, c;                                                    \
+    uint32_t d;                                                         \
+    UNPACK_8_8_8 (j->ip[0], a, b, c);                                   \
+    d = j->ip[1];                                                       \
+    comp (j, a, b, c, d);                                               \
+  }
+#define COMPILE_X8_S8_S8_S8__C32(j, comp)                               \
+  COMPILE_X8_S8_S8_C8__C32(j, comp)
+
+#define COMPILE_X32__LO32__L32(j, comp)                                 \
+  {                                                                     \
+    int32_t a = j->ip[1], b = j->ip[2];                                 \
+    comp (j, j->ip + a, j->ip + b);                                     \
+  }
+
+#define COMPILE_X8_F24__X8_C24__L32(j, comp)                            \
+  {                                                                     \
+    uint32_t a, b;                                                      \
+    int32_t c;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_24 (j->ip[1], b);                                            \
+    c = j->ip[2];                                                       \
+    comp (j, a, b, j->ip + c);                                          \
+  }
+
+#define COMPILE_X8_S24__A32__B32(j, comp)                               \
+  {                                                                     \
+    uint32_t a;                                                         \
+    uint64_t b;                                                         \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = (((uint64_t) j->ip[1]) << 32) | ((uint64_t) j->ip[2]);          \
+    ASSERT (b <= (uint64_t) UINTPTR_MAX);                               \
+    comp (j, a, SCM_PACK ((uintptr_t) b));                              \
+  }
+
+#define COMPILE_X8_S24__AF32__BF32(j, comp)                             \
+  {                                                                     \
+    uint32_t a;                                                         \
+    union { uint64_t u; double d; } b;                                  \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b.u = (((uint64_t) j->ip[1]) << 32) | ((uint64_t) j->ip[2]);        \
+    comp (j, a, b.d);                                                   \
+  }
+
+#define COMPILE_X8_S24__AS32__BS32(j, comp)                             \
+  {                                                                     \
+    uint32_t a;                                                         \
+    uint64_t b;                                                         \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = (((uint64_t) j->ip[1]) << 32) | ((uint64_t) j->ip[2]);          \
+    comp (j, a, (int64_t) b);                                           \
+  }
+
+#define COMPILE_X8_S24__AU32__BU32(j, comp)                             \
+  {                                                                     \
+    uint32_t a;                                                         \
+    uint64_t b;                                                         \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = (((uint64_t) j->ip[1]) << 32) | ((uint64_t) j->ip[2]);          \
+    comp (j, a, b);                                                     \
+  }
+
+#define COMPILE_X8_S24__B1_X7_F24__X8_L24(j, comp)                      \
+  {                                                                     \
+    uint32_t a, c;                                                      \
+    uint8_t b;                                                          \
+    int32_t d;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    b = j->ip[1] & 0x1;                                                 \
+    UNPACK_24 (j->ip[1], c);                                            \
+    d = j->ip[2]; d >>= 8; /* Sign extension.  */                       \
+    comp (j, a, b, c, j->ip + d);                                       \
+  }
+
+#define COMPILE_X8_S24__X8_S24__C8_S24(j, comp)                         \
+  {                                                                     \
+    uint32_t a, b, d;                                                   \
+    uint8_t c;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_24 (j->ip[1], b);                                            \
+    UNPACK_8_24 (j->ip[2], c, d);                                       \
+    comp (j, a, b, c, d);                                               \
+  }
+
+#define COMPILE_X8_C24__C8_C24__X8_C24__N32(j, comp)                    \
+  {                                                                     \
+    uint32_t a, c, d;                                                   \
+    uint8_t b;                                                          \
+    int32_t e;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_8_24 (j->ip[1], b, c);                                       \
+    UNPACK_24 (j->ip[2], d);                                            \
+    e = j->ip[3];                                                       \
+    comp (j, a, b, c, d, j->ip + e);                                    \
+  }
+
+#define COMPILE_X8_S24__X8_S24__C8_S24__X8_S24(j, comp)                 \
+  {                                                                     \
+    uint32_t a, b, d, e;                                                \
+    uint8_t c;                                                          \
+    UNPACK_24 (j->ip[0], a);                                            \
+    UNPACK_24 (j->ip[1], b);                                            \
+    UNPACK_8_24 (j->ip[2], c, d);                                       \
+    UNPACK_24 (j->ip[3], e);                                            \
+    comp (j, a, b, c, d, e);                                            \
+  }
+
+static uint8_t first_seen[256];
+
+static void
+compile1 (scm_jit_state *j)
+{
+  uint8_t opcode = j->ip[0] & 0xff;
+
+  if (!first_seen[opcode])
+    {
+      const char *n;
+      switch (opcode)
+        {
+#define NAME(code, cname, name, arity) case code: n = name; break;
+          FOR_EACH_VM_OPERATION(NAME)
+#undef NAME
+        default:
+          UNREACHABLE ();
+        }
+      first_seen[opcode] = 1;
+      DEBUG ("Instruction first seen at vcode %p: %s\n", j->ip, n);
+    }
+
+  j->next_ip = j->ip + op_lengths[opcode];
+
+  switch (opcode)
+    {
+#define COMPILE1(code, cname, name, arity) \
+      case code: COMPILE_##arity(j, compile_##cname); break;
+      FOR_EACH_VM_OPERATION(COMPILE1)
+#undef COMPILE1
+    default:
+      UNREACHABLE ();
+    }
+
+  j->ip = j->next_ip;
+}
+
+static void
+analyze (scm_jit_state *j)
+{
+  memset (j->op_attrs, 0, j->end - j->start);
+
+  j->op_attrs[0] = OP_ATTR_BLOCK | OP_ATTR_ENTRY;
+
+  for (j->ip = (uint32_t *) j->start; j->ip < j->end; j->ip = j->next_ip)
+    {
+      uint8_t opcode = j->ip[0] & 0xff;
+      uint8_t attrs = 0;
+      uint32_t *target;
+
+      j->next_ip = j->ip + op_lengths[opcode];
+
+      switch (opcode)
+        {
+        case scm_op_check_arguments:
+        case scm_op_check_positional_arguments:
+          attrs |= OP_ATTR_ENTRY;
+          /* Fall through. */
+        case scm_op_u64_numerically_equal:
+        case scm_op_u64_less:
+        case scm_op_s64_less:
+        case scm_op_f64_numerically_equal:
+        case scm_op_f64_less:
+        case scm_op_numerically_equal:
+        case scm_op_less:
+        case scm_op_immediate_tag_equals:
+        case scm_op_heap_tag_equals:
+        case scm_op_eq:
+        case scm_op_heap_numbers_equal:
+        case scm_op_s64_imm_numerically_equal:
+        case scm_op_u64_imm_less:
+        case scm_op_imm_u64_less:
+        case scm_op_s64_imm_less:
+        case scm_op_imm_s64_less:
+          attrs |= OP_ATTR_BLOCK;
+          fuse_conditional_branch (j, &target);
+          j->op_attrs[target - j->start] |= attrs;
+          break;
+
+        case scm_op_j:
+          target = j->ip + (((int32_t)j->ip[0]) >> 8);
+          j->op_attrs[target - j->start] |= OP_ATTR_BLOCK;
+          break;
+
+        case scm_op_call:
+        case scm_op_call_label:
+          attrs = OP_ATTR_BLOCK;
+          target = j->next_ip;
+          j->op_attrs[target - j->start] |= OP_ATTR_BLOCK | OP_ATTR_ENTRY;
+          break;
+
+        case scm_op_prompt:
+          target = j->ip + (((int32_t) j->ip[2]) >> 8);
+          j->op_attrs[target - j->start] |= OP_ATTR_BLOCK | OP_ATTR_ENTRY;
+          break;
+
+        default:
+          break;
+        }
+    }
+
+  /* Even in loops, the entry should be a jump target.  */
+  ASSERT (j->op_attrs[j->entry - j->start] & OP_ATTR_BLOCK);
+}
+
+static void
+compile (scm_jit_state *j)
+{
+  j->ip = (uint32_t *) j->start;
+  set_register_state (j, SP_IN_REGISTER | FP_IN_REGISTER);
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+
+  for (ptrdiff_t offset = 0; j->ip + offset < j->end; offset++)
+    j->labels[offset] = NULL;
+
+  j->reloc_idx = 0;
+
+  while (j->ip < j->end)
+    {
+      ptrdiff_t offset = j->ip - j->start;
+      uint8_t attrs = j->op_attrs[offset];
+      j->labels[offset] = jit_address (j->jit);
+      if (attrs & OP_ATTR_BLOCK)
+        {
+          uint32_t state = SP_IN_REGISTER;
+          if (attrs & OP_ATTR_ENTRY)
+            state |= FP_IN_REGISTER;
+          j->register_state = state;
+        }
+      compile1 (j);
+
+      if (jit_has_overflow (j->jit))
+        return;
+    }
+
+  for (size_t i = 0; i < j->reloc_idx; i++)
+    {
+      void *target = j->labels[j->relocs[i].target_vcode_offset];
+      ASSERT(target);
+      jit_patch_there (j->jit, j->relocs[i].reloc, target);
+    }
+}
+
+static scm_i_pthread_once_t initialize_jit_once = SCM_I_PTHREAD_ONCE_INIT;
+
+static void*
+jit_alloc_fn (size_t size)
+{
+  return scm_gc_malloc (size, "jit state");
+}
+
+static void
+jit_free_fn (void *unused)
+{
+}
+
+static scm_jit_state *
+initialize_thread_jit_state (scm_thread *thread)
+{
+  scm_jit_state *j;
+
+  ASSERT (!thread->jit_state);
+
+  j = scm_gc_malloc (sizeof (*j), "jit state");
+  memset (j, 0, sizeof (*j));
+  thread->jit_state = j;
+  j->jit = jit_new_state (jit_alloc_fn, jit_free_fn);
+
+  return j;
+}
+
+static void
+initialize_jit (void)
+{
+  scm_jit_state *j;
+
+  if (!init_jit ())
+    {
+      scm_jit_counter_threshold = -1;
+      fprintf (stderr, "JIT failed to initialize\n");
+      fprintf (stderr, "disabling automatic JIT compilation\n");
+      return;
+    }
+
+  /* Init the thread's jit state so we can emit the entry
+     trampoline and the handle-interrupts trampoline.  */
+  j = initialize_thread_jit_state (SCM_I_CURRENT_THREAD);
+
+  jit_pointer_t enter_mcode_addr = emit_code (j, emit_entry_trampoline);
+  ASSERT (enter_mcode_addr);
+  enter_mcode = jit_address_to_function_pointer (enter_mcode_addr);
+
+  handle_interrupts_trampoline =
+    emit_code (j, emit_handle_interrupts_trampoline);
+  ASSERT (handle_interrupts_trampoline);
+  handle_interrupts_trampoline = jit_address_to_function_pointer
+    (handle_interrupts_trampoline);
+
+  scm_jit_return_to_interpreter_trampoline =
+    emit_code (j, emit_return_to_interpreter_trampoline);
+  ASSERT (scm_jit_return_to_interpreter_trampoline);
+  scm_jit_return_to_interpreter_trampoline = jit_address_to_function_pointer
+    (scm_jit_return_to_interpreter_trampoline);
+}
+
+static uint8_t *
+compute_mcode (scm_thread *thread, uint32_t *entry_ip,
+               struct scm_jit_function_data *data)
+{
+  scm_jit_state *j = thread->jit_state;
+  uint8_t *entry_mcode;
+
+  if (!j)
+    {
+      scm_i_pthread_once (&initialize_jit_once, initialize_jit);
+      if (scm_jit_counter_threshold == -1)
+        {
+          /* initialization failed!  */
+          return NULL;
+        }
+
+      j = thread->jit_state;
+      /* It's possible that initialize_jit_once inits this thread's jit
+         state.  */
+      if (!j)
+        j = initialize_thread_jit_state (thread);
+    }
+
+  j->thread = thread;
+  j->start = (const uint32_t *) (((char *)data) + data->start);
+  j->end = (const uint32_t *) (((char *)data) + data->end);
+  j->entry = entry_ip;
+
+  ASSERT (j->start < j->end);
+  ASSERT (j->start <= j->entry);
+  ASSERT (j->entry < j->end);
+
+  j->op_attrs = calloc ((j->end - j->start), sizeof (*j->op_attrs));
+  ASSERT (j->op_attrs);
+  j->labels = calloc ((j->end - j->start), sizeof (*j->labels));
+  ASSERT (j->labels);
+
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+
+  INFO ("vcode: start=%p,+%zu entry=+%zu\n", j->start, j->end - j->start,
+        j->entry - j->start);
+
+  analyze (j);
+
+  data->mcode = emit_code (j, compile);
+  if (data->mcode)
+    entry_mcode = j->labels[j->entry - j->start];
+  else
+    entry_mcode = NULL;
+
+  free (j->op_attrs);
+  j->op_attrs = NULL;
+  free (j->labels);
+  j->labels = NULL;
+  free (j->relocs);
+  j->relocs = NULL;
+  j->reloc_idx = 0;
+  j->reloc_count = 0;
+
+  j->start = j->end = j->ip = j->entry = NULL;
+  j->frame_size_min = 0;
+  j->frame_size_max = INT32_MAX;
+
+  return entry_mcode;
+}
+
+const uint8_t *
+scm_jit_compute_mcode (scm_thread *thread, struct scm_jit_function_data *data)
+{
+  const uint32_t *vcode_start = (const uint32_t *) (((char *)data) + data->start);
+
+  if (data->mcode)
+    {
+      if (vcode_start == thread->vm.ip)
+        return data->mcode;
+
+      /* FIXME: The function has mcode, compiled via some other
+         activation (possibly in another thread), but right now we're
+         currently in an interpreted loop (not at the beginning of the
+         function).  We should re-compute the offset into the mcode.
+         For now though, just punt.  */
+      return NULL;
+    }
+  else
+    {
+      uint8_t *mcode = compute_mcode (thread, thread->vm.ip, data);
+
+      if (!mcode)
+        {
+          scm_jit_counter_threshold = -1;
+          fprintf (stderr, "JIT failed due to resource exhaustion\n");
+          fprintf (stderr, "disabling automatic JIT compilation\n");
+        }
+      else if (--jit_stop_after == 0)
+        {
+          scm_jit_counter_threshold = -1;
+          fprintf (stderr, "stopping automatic JIT compilation, as requested\n");
+          if (jit_pause_when_stopping)
+            {
+              fprintf (stderr, "sleeping for 30s; to debug:\n");
+              fprintf (stderr, "   gdb -p %d\n\n", getpid ());
+              sleep (30);
+            }
+        }
+
+      return mcode;
+    }
+}
+
+void
+scm_jit_enter_mcode (scm_thread *thread, const uint8_t *mcode)
+{
+  LOG ("entering mcode: %p\n", mcode);
+  if (!SCM_FRAME_MACHINE_RETURN_ADDRESS (thread->vm.fp))
+    SCM_FRAME_SET_MACHINE_RETURN_ADDRESS
+      (thread->vm.fp, scm_jit_return_to_interpreter_trampoline);
+  enter_mcode (thread, mcode);
+  LOG ("exited mcode\n");
+}
+
+/* Call to force a thread to go back to the interpreter, for example
+   when single-stepping is enabled.  */
+void
+scm_jit_clear_mcode_return_addresses (scm_thread *thread)
+{
+  union scm_vm_stack_element *fp;
+  struct scm_vm *vp = &thread->vm;
+
+  for (fp = vp->fp; fp < vp->stack_top; fp = SCM_FRAME_DYNAMIC_LINK (fp))
+    SCM_FRAME_SET_MACHINE_RETURN_ADDRESS
+      (fp, scm_jit_return_to_interpreter_trampoline);
+}
+
+void
+scm_jit_state_free (scm_jit_state *j)
+{
+  /* Nothing to do; we leave j->jit NULL between compilations.  */
+}
+
+void
+scm_init_jit (void)
+{
+  scm_jit_counter_threshold = scm_getenv_int ("GUILE_JIT_THRESHOLD",
+                                              default_jit_threshold);
+  jit_stop_after = scm_getenv_int ("GUILE_JIT_STOP_AFTER", -1);
+  jit_pause_when_stopping = scm_getenv_int ("GUILE_JIT_PAUSE_WHEN_STOPPING", 0);
+  jit_log_level = scm_getenv_int ("GUILE_JIT_LOG", 0);
+}
+
+#endif /* ENABLE_JIT */
diff --git a/libguile/jit.h b/libguile/jit.h
new file mode 100644
index 000000000..455f9c79c
--- /dev/null
+++ b/libguile/jit.h
@@ -0,0 +1,70 @@
+#ifndef SCM_JIT_H
+#define SCM_JIT_H
+
+/* Copyright 2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+#include "libguile/scm.h"
+
+
+
+struct scm_jit_function_data;
+struct scm_jit_state;
+
+#ifdef BUILDING_LIBGUILE
+struct scm_jit_function_data
+{
+  uint8_t *mcode;
+  uint32_t counter;
+  int32_t start;
+  int32_t end;
+#if SCM_SIZEOF_UINTPTR_T == 4
+#elif SCM_SIZEOF_UINTPTR_T == 8
+  uint32_t pad;
+#else
+#error unhandled sizeof(uintptr_t)
+#endif
+};
+
+/* These values should be even, so that a function's counter is never
+   0xffffffff, so that setting the JIT threshold to 0xffffffff always
+   disables compilation.  */
+enum scm_jit_counter_value
+{
+  SCM_JIT_COUNTER_ENTRY_INCREMENT = 30,
+  SCM_JIT_COUNTER_LOOP_INCREMENT = 2,
+};
+#endif
+
+SCM_INTERNAL uint32_t scm_jit_counter_threshold;
+
+SCM_INTERNAL const uint8_t *scm_jit_compute_mcode (scm_thread *thread,
+                                                   struct scm_jit_function_data *data);
+SCM_INTERNAL void scm_jit_enter_mcode (scm_thread *thread,
+                                       const uint8_t *mcode);
+SCM_INTERNAL void scm_jit_state_free (struct scm_jit_state *j);
+
+SCM_INTERNAL void *scm_jit_return_to_interpreter_trampoline;
+SCM_INTERNAL void scm_jit_clear_mcode_return_addresses (scm_thread *thread);
+
+SCM_INTERNAL void scm_init_jit (void);
+
+#endif  /* SCM_JIT_H */
diff --git a/libguile/keywords.c b/libguile/keywords.c
index 087042b84..0d0c11e41 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- *   2006, 2008, 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2003-2004,2006,2008-2009,2011,2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -26,15 +26,18 @@
 #include <string.h>
 #include <stdarg.h>
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/ports.h"
-#include "libguile/smob.h"
-#include "libguile/hashtab.h"
+#include "async.h"
+#include "dynwind.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "list.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "strings.h"
+#include "symbols.h"
 
-#include "libguile/validate.h"
-#include "libguile/keywords.h"
-#include "libguile/strings.h"
+#include "keywords.h"
 
 
 
@@ -194,12 +197,6 @@ void
 scm_init_keywords ()
 {
   keyword_obarray = scm_c_make_hash_table (0);
-#include "libguile/keywords.x"
+#include "keywords.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/keywords.h b/libguile/keywords.h
index 32311dd49..c8f480869 100644
--- a/libguile/keywords.h
+++ b/libguile/keywords.h
@@ -1,29 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_KEYWORDS_H
 #define SCM_KEYWORDS_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1999-2001,2006,2008,2015,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include <libguile/snarf.h>
 
 
 
@@ -37,6 +37,17 @@ SCM_API SCM scm_from_locale_keywordn (const char *name, size_t len);
 SCM_API SCM scm_from_latin1_keyword (const char *name);
 SCM_API SCM scm_from_utf8_keyword (const char *name);
 
+#define SCM_VALIDATE_KEYWORD(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword")
+
+#define SCM_KEYWORD(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_from_utf8_keyword (scheme_name))
+
+#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_from_utf8_keyword (scheme_name))
+
 enum scm_keyword_arguments_flags
 {
   SCM_ALLOW_OTHER_KEYS            = (1U << 0),
@@ -52,9 +63,3 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
 SCM_INTERNAL void scm_init_keywords (void);
 
 #endif  /* SCM_KEYWORDS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/libgettext.h b/libguile/libgettext.h
index f54b6bff7..780ff1ade 100644
--- a/libguile/libgettext.h
+++ b/libguile/libgettext.h
@@ -1,20 +1,21 @@
 /* Convenience header for conditional use of GNU <libintl.h>.
-   Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc.
+   Copyright 1995-1998, 2000-2002, 2    Free Software Foundation, Inc.
 
-   This program is free software; you can redistribute it and/or modify it
-   under the terms of the GNU Library General Public License as published
-   by the Free Software Foundation; either version 2, or (at your option)
-   any later version.
+   This file is part of Guile.
 
-   This program is distributed in the hope that it will be useful,
-   but WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-   Library General Public License for more details.
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-   You should have received a copy of the GNU Library General Public
-   License along with this program; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-   USA.  */
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _LIBGETTEXT_H
 #define _LIBGETTEXT_H 1
diff --git a/libguile/lightening/.gitignore b/libguile/lightening/.gitignore
new file mode 100644
index 000000000..d2a82cf1f
--- /dev/null
+++ b/libguile/lightening/.gitignore
@@ -0,0 +1,4 @@
+*.o
++*
+/lightning.info
+/tests/test-*
diff --git a/libguile/lightening/.gitlab-ci.yml b/libguile/lightening/.gitlab-ci.yml
new file mode 100644
index 000000000..43528960f
--- /dev/null
+++ b/libguile/lightening/.gitlab-ci.yml
@@ -0,0 +1,33 @@
+image: debian:testing
+
+before_script:
+  - dpkg --add-architecture i386
+  - dpkg --add-architecture arm64
+  - dpkg --add-architecture armhf
+  - apt-get update -qq
+  - apt-get install -y
+      libc6-dev:amd64 gcc make
+      qemu binfmt-support qemu-user-static
+      gcc-i686-linux-gnu libc6-dev-i386-cross libc6:i386
+      gcc-aarch64-linux-gnu libc6-dev-arm64-cross libc6:arm64
+      gcc-arm-linux-gnueabihf libc6-dev-armhf-cross libc6:armhf
+
+x86-64:
+  stage: test
+  script:
+    - make -C tests test-native
+
+i686:
+  stage: test
+  script:
+    - make -C tests test-ia32 CC_IA32=i686-linux-gnu-gcc
+
+aarch64:
+  stage: test
+  script:
+    - make -C tests test-aarch64 CC_AARCH64=aarch64-linux-gnu-gcc
+
+armhf:
+  stage: test
+  script:
+    - make -C tests test-armv7 CC_ARMv7=arm-linux-gnueabihf-gcc
diff --git a/libguile/lightening/AUTHORS b/libguile/lightening/AUTHORS
new file mode 100644
index 000000000..2097c635c
--- /dev/null
+++ b/libguile/lightening/AUTHORS
@@ -0,0 +1,14 @@
+Paulo Cesar Pereira de Andrade <pcpa@gnu.org>
+
+Paolo Bonzini <bonzini@gnu.org>
+
+PPC assembler by Ian Piumarta <piumarta@inria.fr>
+
+i386 assembler by Ian Piumarta <piumarta@inria.fr>
+and Gwenole Beauchesne <gb.public@free.fr>
+
+x86-64 backend by Matthew Flatt <mflatt@cs.utah.edu>
+
+Major PPC contributions by Laurent Michel <ldm@thorgal.homelinux.org>
+
+Major SPARC contributions by Ludovic Courtes <ludo@chbouib.org>
diff --git a/libguile/lightening/COPYING b/libguile/lightening/COPYING
new file mode 100644
index 000000000..443254047
--- /dev/null
+++ b/libguile/lightening/COPYING
@@ -0,0 +1,676 @@
+
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+ 
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+  
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+
diff --git a/libguile/lightening/COPYING.DOC b/libguile/lightening/COPYING.DOC
new file mode 100644
index 000000000..1a864561b
--- /dev/null
+++ b/libguile/lightening/COPYING.DOC
@@ -0,0 +1,355 @@
+		GNU Free Documentation License
+		   Version 1.1, March 2000
+
+ Copyright (C) 2000  Free Software Foundation, Inc.
+     51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+0. PREAMBLE
+
+The purpose of this License is to make a manual, textbook, or other
+written document "free" in the sense of freedom: to assure everyone
+the effective freedom to copy and redistribute it, with or without
+modifying it, either commercially or noncommercially.  Secondarily,
+this License preserves for the author and publisher a way to get
+credit for their work, while not being considered responsible for
+modifications made by others.
+
+This License is a kind of "copyleft", which means that derivative
+works of the document must themselves be free in the same sense.  It
+complements the GNU General Public License, which is a copyleft
+license designed for free software.
+
+We have designed this License in order to use it for manuals for free
+software, because free software needs free documentation: a free
+program should come with manuals providing the same freedoms that the
+software does.  But this License is not limited to software manuals;
+it can be used for any textual work, regardless of subject matter or
+whether it is published as a printed book.  We recommend this License
+principally for works whose purpose is instruction or reference.
+
+
+1. APPLICABILITY AND DEFINITIONS
+
+This License applies to any manual or other work that contains a
+notice placed by the copyright holder saying it can be distributed
+under the terms of this License.  The "Document", below, refers to any
+such manual or work.  Any member of the public is a licensee, and is
+addressed as "you".
+
+A "Modified Version" of the Document means any work containing the
+Document or a portion of it, either copied verbatim, or with
+modifications and/or translated into another language.
+
+A "Secondary Section" is a named appendix or a front-matter section of
+the Document that deals exclusively with the relationship of the
+publishers or authors of the Document to the Document's overall subject
+(or to related matters) and contains nothing that could fall directly
+within that overall subject.  (For example, if the Document is in part a
+textbook of mathematics, a Secondary Section may not explain any
+mathematics.)  The relationship could be a matter of historical
+connection with the subject or with related matters, or of legal,
+commercial, philosophical, ethical or political position regarding
+them.
+
+The "Invariant Sections" are certain Secondary Sections whose titles
+are designated, as being those of Invariant Sections, in the notice
+that says that the Document is released under this License.
+
+The "Cover Texts" are certain short passages of text that are listed,
+as Front-Cover Texts or Back-Cover Texts, in the notice that says that
+the Document is released under this License.
+
+A "Transparent" copy of the Document means a machine-readable copy,
+represented in a format whose specification is available to the
+general public, whose contents can be viewed and edited directly and
+straightforwardly with generic text editors or (for images composed of
+pixels) generic paint programs or (for drawings) some widely available
+drawing editor, and that is suitable for input to text formatters or
+for automatic translation to a variety of formats suitable for input
+to text formatters.  A copy made in an otherwise Transparent file
+format whose markup has been designed to thwart or discourage
+subsequent modification by readers is not Transparent.  A copy that is
+not "Transparent" is called "Opaque".
+
+Examples of suitable formats for Transparent copies include plain
+ASCII without markup, Texinfo input format, LaTeX input format, SGML
+or XML using a publicly available DTD, and standard-conforming simple
+HTML designed for human modification.  Opaque formats include
+PostScript, PDF, proprietary formats that can be read and edited only
+by proprietary word processors, SGML or XML for which the DTD and/or
+processing tools are not generally available, and the
+machine-generated HTML produced by some word processors for output
+purposes only.
+
+The "Title Page" means, for a printed book, the title page itself,
+plus such following pages as are needed to hold, legibly, the material
+this License requires to appear in the title page.  For works in
+formats which do not have any title page as such, "Title Page" means
+the text near the most prominent appearance of the work's title,
+preceding the beginning of the body of the text.
+
+
+2. VERBATIM COPYING
+
+You may copy and distribute the Document in any medium, either
+commercially or noncommercially, provided that this License, the
+copyright notices, and the license notice saying this License applies
+to the Document are reproduced in all copies, and that you add no other
+conditions whatsoever to those of this License.  You may not use
+technical measures to obstruct or control the reading or further
+copying of the copies you make or distribute.  However, you may accept
+compensation in exchange for copies.  If you distribute a large enough
+number of copies you must also follow the conditions in section 3.
+
+You may also lend copies, under the same conditions stated above, and
+you may publicly display copies.
+
+
+3. COPYING IN QUANTITY
+
+If you publish printed copies of the Document numbering more than 100,
+and the Document's license notice requires Cover Texts, you must enclose
+the copies in covers that carry, clearly and legibly, all these Cover
+Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
+the back cover.  Both covers must also clearly and legibly identify
+you as the publisher of these copies.  The front cover must present
+the full title with all words of the title equally prominent and
+visible.  You may add other material on the covers in addition.
+Copying with changes limited to the covers, as long as they preserve
+the title of the Document and satisfy these conditions, can be treated
+as verbatim copying in other respects.
+
+If the required texts for either cover are too voluminous to fit
+legibly, you should put the first ones listed (as many as fit
+reasonably) on the actual cover, and continue the rest onto adjacent
+pages.
+
+If you publish or distribute Opaque copies of the Document numbering
+more than 100, you must either include a machine-readable Transparent
+copy along with each Opaque copy, or state in or with each Opaque copy
+a publicly-accessible computer-network location containing a complete
+Transparent copy of the Document, free of added material, which the
+general network-using public has access to download anonymously at no
+charge using public-standard network protocols.  If you use the latter
+option, you must take reasonably prudent steps, when you begin
+distribution of Opaque copies in quantity, to ensure that this
+Transparent copy will remain thus accessible at the stated location
+until at least one year after the last time you distribute an Opaque
+copy (directly or through your agents or retailers) of that edition to
+the public.
+
+It is requested, but not required, that you contact the authors of the
+Document well before redistributing any large number of copies, to give
+them a chance to provide you with an updated version of the Document.
+
+
+4. MODIFICATIONS
+
+You may copy and distribute a Modified Version of the Document under
+the conditions of sections 2 and 3 above, provided that you release
+the Modified Version under precisely this License, with the Modified
+Version filling the role of the Document, thus licensing distribution
+and modification of the Modified Version to whoever possesses a copy
+of it.  In addition, you must do these things in the Modified Version:
+
+A. Use in the Title Page (and on the covers, if any) a title distinct
+   from that of the Document, and from those of previous versions
+   (which should, if there were any, be listed in the History section
+   of the Document).  You may use the same title as a previous version
+   if the original publisher of that version gives permission.
+B. List on the Title Page, as authors, one or more persons or entities
+   responsible for authorship of the modifications in the Modified
+   Version, together with at least five of the principal authors of the
+   Document (all of its principal authors, if it has less than five).
+C. State on the Title page the name of the publisher of the
+   Modified Version, as the publisher.
+D. Preserve all the copyright notices of the Document.
+E. Add an appropriate copyright notice for your modifications
+   adjacent to the other copyright notices.
+F. Include, immediately after the copyright notices, a license notice
+   giving the public permission to use the Modified Version under the
+   terms of this License, in the form shown in the Addendum below.
+G. Preserve in that license notice the full lists of Invariant Sections
+   and required Cover Texts given in the Document's license notice.
+H. Include an unaltered copy of this License.
+I. Preserve the section entitled "History", and its title, and add to
+   it an item stating at least the title, year, new authors, and
+   publisher of the Modified Version as given on the Title Page.  If
+   there is no section entitled "History" in the Document, create one
+   stating the title, year, authors, and publisher of the Document as
+   given on its Title Page, then add an item describing the Modified
+   Version as stated in the previous sentence.
+J. Preserve the network location, if any, given in the Document for
+   public access to a Transparent copy of the Document, and likewise
+   the network locations given in the Document for previous versions
+   it was based on.  These may be placed in the "History" section.
+   You may omit a network location for a work that was published at
+   least four years before the Document itself, or if the original
+   publisher of the version it refers to gives permission.
+K. In any section entitled "Acknowledgements" or "Dedications",
+   preserve the section's title, and preserve in the section all the
+   substance and tone of each of the contributor acknowledgements
+   and/or dedications given therein.
+L. Preserve all the Invariant Sections of the Document,
+   unaltered in their text and in their titles.  Section numbers
+   or the equivalent are not considered part of the section titles.
+M. Delete any section entitled "Endorsements".  Such a section
+   may not be included in the Modified Version.
+N. Do not retitle any existing section as "Endorsements"
+   or to conflict in title with any Invariant Section.
+
+If the Modified Version includes new front-matter sections or
+appendices that qualify as Secondary Sections and contain no material
+copied from the Document, you may at your option designate some or all
+of these sections as invariant.  To do this, add their titles to the
+list of Invariant Sections in the Modified Version's license notice.
+These titles must be distinct from any other section titles.
+
+You may add a section entitled "Endorsements", provided it contains
+nothing but endorsements of your Modified Version by various
+parties--for example, statements of peer review or that the text has
+been approved by an organization as the authoritative definition of a
+standard.
+
+You may add a passage of up to five words as a Front-Cover Text, and a
+passage of up to 25 words as a Back-Cover Text, to the end of the list
+of Cover Texts in the Modified Version.  Only one passage of
+Front-Cover Text and one of Back-Cover Text may be added by (or
+through arrangements made by) any one entity.  If the Document already
+includes a cover text for the same cover, previously added by you or
+by arrangement made by the same entity you are acting on behalf of,
+you may not add another; but you may replace the old one, on explicit
+permission from the previous publisher that added the old one.
+
+The author(s) and publisher(s) of the Document do not by this License
+give permission to use their names for publicity for or to assert or
+imply endorsement of any Modified Version.
+
+
+5. COMBINING DOCUMENTS
+
+You may combine the Document with other documents released under this
+License, under the terms defined in section 4 above for modified
+versions, provided that you include in the combination all of the
+Invariant Sections of all of the original documents, unmodified, and
+list them all as Invariant Sections of your combined work in its
+license notice.
+
+The combined work need only contain one copy of this License, and
+multiple identical Invariant Sections may be replaced with a single
+copy.  If there are multiple Invariant Sections with the same name but
+different contents, make the title of each such section unique by
+adding at the end of it, in parentheses, the name of the original
+author or publisher of that section if known, or else a unique number.
+Make the same adjustment to the section titles in the list of
+Invariant Sections in the license notice of the combined work.
+
+In the combination, you must combine any sections entitled "History"
+in the various original documents, forming one section entitled
+"History"; likewise combine any sections entitled "Acknowledgements",
+and any sections entitled "Dedications".  You must delete all sections
+entitled "Endorsements."
+
+
+6. COLLECTIONS OF DOCUMENTS
+
+You may make a collection consisting of the Document and other documents
+released under this License, and replace the individual copies of this
+License in the various documents with a single copy that is included in
+the collection, provided that you follow the rules of this License for
+verbatim copying of each of the documents in all other respects.
+
+You may extract a single document from such a collection, and distribute
+it individually under this License, provided you insert a copy of this
+License into the extracted document, and follow this License in all
+other respects regarding verbatim copying of that document.
+
+
+7. AGGREGATION WITH INDEPENDENT WORKS
+
+A compilation of the Document or its derivatives with other separate
+and independent documents or works, in or on a volume of a storage or
+distribution medium, does not as a whole count as a Modified Version
+of the Document, provided no compilation copyright is claimed for the
+compilation.  Such a compilation is called an "aggregate", and this
+License does not apply to the other self-contained works thus compiled
+with the Document, on account of their being thus compiled, if they
+are not themselves derivative works of the Document.
+
+If the Cover Text requirement of section 3 is applicable to these
+copies of the Document, then if the Document is less than one quarter
+of the entire aggregate, the Document's Cover Texts may be placed on
+covers that surround only the Document within the aggregate.
+Otherwise they must appear on covers around the whole aggregate.
+
+
+8. TRANSLATION
+
+Translation is considered a kind of modification, so you may
+distribute translations of the Document under the terms of section 4.
+Replacing Invariant Sections with translations requires special
+permission from their copyright holders, but you may include
+translations of some or all Invariant Sections in addition to the
+original versions of these Invariant Sections.  You may include a
+translation of this License provided that you also include the
+original English version of this License.  In case of a disagreement
+between the translation and the original English version of this
+License, the original English version will prevail.
+
+
+9. TERMINATION
+
+You may not copy, modify, sublicense, or distribute the Document except
+as expressly provided for under this License.  Any other attempt to
+copy, modify, sublicense or distribute the Document is void, and will
+automatically terminate your rights under this License.  However,
+parties who have received copies, or rights, from you under this
+License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+
+10. FUTURE REVISIONS OF THIS LICENSE
+
+The Free Software Foundation may publish new, revised versions
+of the GNU Free Documentation License from time to time.  Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.  See
+http://www.gnu.org/copyleft/.
+
+Each version of the License is given a distinguishing version number.
+If the Document specifies that a particular numbered version of this
+License "or any later version" applies to it, you have the option of
+following the terms and conditions either of that specified version or
+of any later version that has been published (not as a draft) by the
+Free Software Foundation.  If the Document does not specify a version
+number of this License, you may choose any version ever published (not
+as a draft) by the Free Software Foundation.
+
+
+ADDENDUM: How to use this License for your documents
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and
+license notices just after the title page:
+
+      Copyright (c)  YEAR  YOUR NAME.
+      Permission is granted to copy, distribute and/or modify this document
+      under the terms of the GNU Free Documentation License, Version 1.1
+      or any later version published by the Free Software Foundation;
+      with the Invariant Sections being LIST THEIR TITLES, with the
+      Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST.
+      A copy of the license is included in the section entitled "GNU
+      Free Documentation License".
+
+If you have no Invariant Sections, write "with no Invariant Sections"
+instead of saying which ones are invariant.  If you have no
+Front-Cover Texts, write "no Front-Cover Texts" instead of
+"Front-Cover Texts being LIST"; likewise for Back-Cover Texts.
+
+If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License,
+to permit their use in free software.
diff --git a/libguile/lightening/COPYING.LESSER b/libguile/lightening/COPYING.LESSER
new file mode 100644
index 000000000..fc8a5de7e
--- /dev/null
+++ b/libguile/lightening/COPYING.LESSER
@@ -0,0 +1,165 @@
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions. 
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version. 
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/libguile/lightening/ChangeLog b/libguile/lightening/ChangeLog
new file mode 100644
index 000000000..cc7c8e9b2
--- /dev/null
+++ b/libguile/lightening/ChangeLog
@@ -0,0 +1,17 @@
+-*- text -*-
+
+Starting from October 30, 2018, the Lightening project no longer stores
+change logs in `ChangeLog' files.  Instead, changes are detailed in the
+version control system's logs.  They can be seen by downloading a copy
+of the Git repository:
+
+  $ git clone https://gitlab.com/wingo/lightening
+  $ git log
+
+Alternatively, they can be seen on the web, using the Gitweb interface
+at:
+
+  https://gitlab.com/wingo/lightening
+
+Change logs from upstream GNU Lightning are still available in
+ChangeLog.lightning.
diff --git a/libguile/lightening/ChangeLog.lightning b/libguile/lightening/ChangeLog.lightning
new file mode 100644
index 000000000..19b3335f5
--- /dev/null
+++ b/libguile/lightening/ChangeLog.lightning
@@ -0,0 +1,4018 @@
+2018-04-20 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h: Add new register classes to
+	flag float registers and double only registers, required for sparc64
+	where only low 32 bit fpr registers can be used for single precision
+	operations.
+	Add new 128 bit jit_regset_t type for sparc64 register set.
+
+	* include/lightning/jit_sparc.h, lib/jit_sparc-cpu.c, lib/jit_sparc-fpu.c,
+	lib/jit_sparc-sz.c, lib/jit_sparc.c: Update for 64 bits sparc.
+
+	* lib/lightning.c: Update for new jit_regset_t required for sparc64.
+
+2018-02-26 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c, include/lightning.h: Add the new jit_va_push
+	interface. That should be called when passing a va_list to a C
+	function. This is required because on Alpha a va_list is passed
+	by value, and lightning does not know about data types, so, cannot
+	understand it is pushing a va_list as argument.
+
+	* lib/jit_names.c, lib/lightning.c: Minor changes for the new
+	jit_code_va_push.
+
+	* check/cva_list.c: Update only test case using jit_va_push, to
+	pass a va_list to a C function.
+
+	doc/body.texi: Better documentation of the varargs interface.
+
+	* jit_alpha.c, jit_alpha-cpu.c: Update to properly push a
+	C va_list and correctly calculate varargs offset.
+
+	* lib/jit_aarch64-sz.c, lib/jit_aarch64.c, lib/jit_alpha-sz.c,
+	lib/jit_arm-sz.c, lib/jit_arm.c, lib/jit_hppa-sz.c, lib/jit_hppa.c,
+	lib/jit_ia64-sz.c, lib/jit_ia64.c, lib/jit_mips-sz.c, lib/jit_mips.c,
+	lib/jit_ppc-sz.c, lib/jit_ppc.c, lib/jit_s390-sz.c, lib/jit_s390.c,
+	lib/jit_sparc-sz.c, lib/jit_sparc.c, lib/jit_x86-sz.c, lib/jit_x86.c:
+	Update for the new jit_va_push interface.
+
+2018-02-22 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_alpha-cpu.c: Always set t12 to the address of the
+	current function, to properly work on all systems. Previously
+	the shortcut did only work on Tru64. For Linux and glibc the
+	change is required.
+
+2018-02-22 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64.c, lib/jit_alpha.c, lib/jit_arm.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_sparc.c, lib/jit_x86.c:
+	Correct wrong logic in usage of jit_live in jit_retr. The
+	problem is that if a temporary is required during epilog,
+	the return register might be allocated, so, jit_live must always
+	be used.
+
+2018-01-31 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Avoid deep recursions when computing live
+	register ranges.
+
+2018-01-31 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-cpu.c: Correct frame size and varargs
+	initialization for the n32 abi.
+	* lib/jit_mips.c, lib/jit_mips-fpu.c: Correct 32 bit abis
+	in big-endian.
+
+2017-09-13 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac: Add check for binutils 2.29 prototype to the
+	disassembler function.
+	* lib/jit_disasm.c: Adapt for binutils 2.29 change.
+
+2017-06-09 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/lightning.c: Add a
+	second pass from start when computing register live ranges.
+	This should be used temporarily, and is required for certain
+	loop constructs, with several consecutive blocks not referencing
+	a live register.
+
+2016-05-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Correct wrong movr simplification,
+	remove no longer needed code to set return registers live
+	and update live register set when reaching a label boundary,
+	but do not descend if the block has been already visited.
+	The later need some tuning for complex code generation, where
+	it will still have issues.
+
+2015-11-30 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Change documentation to no longer say
+	it is a variant of the Fibonacci sequence, and document
+	a proper implementation.
+	Thanks to Jon Arintok for pointing out that the Fibonacci
+	sequence generation was incorrect. It was documented, but
+	still confusing.
+
+	* check/fib.tst, check/fib.ok, check/bp.tst, check/bp.ok,
+	doc/ifib.c, doc/rbif.c: Implement a proper Fibonacci
+	sequence implementation.
+
+2015-07-03 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-cpu.c: Correct definition of htonr_ul.
+	Correct prolog/epilog/va* routines to work on o64 abi.
+
+	* lib/jit_mips-fpu.c: Correct load of double literal
+	argument when not using a data buffer.
+	Remove alignment correction in vaarg_d if using the
+	new mips abi.
+
+	* lib/jit_mips.c: Correct code to allow creating variadic
+	jit functions when using the new mips abi.
+
+	* lib/jit_rewind.c: Minor adjust for rewind when using
+	the new mips abi, if there are varargs arguments in
+	registers.
+
+2015-06-06 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c: Search backward for the last output
+	register used, otherwise would stop too early if a float
+	argument used the slot.
+	Correct offset of first va_list argument, and use proper
+	va_list abi.
+
+	* lib/jit_ia64-fpu.c: Add new functions to move a gpr
+	to a fpr register, to counterpart the ones that move a
+	fpr to a gpr. These are required to properly implement
+	jit_getarg*_{f,d} on complex prototypes, or variadic
+	jit functions.
+
+	* lib/jit_ia64-sz.c: Update for support to jit variadic
+	functions.
+
+	* lib/jit_ia64.c: Implement proper abi for variadic
+	jit functions.
+
+2015-06-04 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_rewind.c: New file implementing generic functions
+	to "rewind", or rewrite IR code sequences.
+
+	* include/lightning.h: Add several new codes, that previously
+	were a function call, that would synthesize the operation.
+	Now, there is a code for the operation, and a new flag to
+	know an operation is synthesized.
+
+	* include/lightning/jit_private.h: Add several new macros to
+	help construct synthesized IR code sequences.
+
+	* lib/Makefile.am: Update for lib/jit_rewind.c.
+
+	* lib/jit_disasm.c: Update for a small rework on jit_node_t,
+	so that --enable-devel-disassembler does not need a change
+	in the layout of jit_node_t.
+
+	* lib/jit_names.c: Update for the new codes.
+
+	* lib/jit_print.c: Update to print more readable output, and
+	flag synthesized IR code sequences.
+
+	* lib/jit_aarch64-sz.c, lib/jit_aarch64.c,
+	lib/jit_arm-sz.c, lib/jit_arm.c, lib/jit_x86-sz.c,
+	lib/jit_x86.c: Update for new synthesized IR code sequences.
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc-fpu., lib/jit_ppc-sz.c,
+	lib/jit_ppc.c, lib/jit_mips-cpu.c, lib/jit_mips-fpu.c,
+	lib/jit_mips-sz.c, lib/jit_mips.c, lib/jit_s390-fpu.c,
+	lib/jit_s390-sz.c, lib/jit_s390.c: Update for new synthesized
+	IR code sequences and correct bugs in the initial varargs
+	implementation support.
+
+	* lib/jit_alpha-sz.c, lib/jit_alpha.c, lib/jit_hppa-sz.c,
+	lib/jit_hppa.c, lib/jit_ia64-sz.c, lib/jit_ia64.c,
+	lib/jit_sparc-sz.c, lib/jit_sparc.c: Add generic, untested
+	support for the new synthesized	IR code sequences. Known
+	most likely broken right now, and should be corrected once
+	access to these hosts is available.
+
+	* lib/lightning.c: Update for new IR codes, and add support
+	for not yet existing instructions that change third argument.
+
+	* size.c: Change to use different tables for LE and BE PowerPC.
+	Correct a wrong endif for x32.
+
+2015-05-25 Paulo Andrade <pcpa@gnu.org>
+
+	* check/cva_list.c: New file implementing a test to ensure
+	the value returned by jit_va_start is a valid C va_list.
+
+	* check/va_list.ok: New simple helper file, as now the
+	va_list.tst test is enabled.
+
+	* check/va_list.tst: Rewritten for an extensive variadic
+	jit functions test.
+
+	* check/Makefile.am: Update for the new tests.
+
+	* lib/jit_arm-cpu.c, lib/jit_arm-swf.c, lib/jit_arm-vfp.c,
+	lib/jit_arm.c: Correct broken software float in a previous
+	commit. Note that the hard float abi implementation is known
+	broken at this time, for special cases involving variadic
+	functions, and should be corrected next.
+
+	lib/jit_x86-cpu.c, lib/jit_x86-sz.c, lib/jit_x86.c: Correct
+	the jit_va_list_t semantics to match C va_list.
+
+2015-05-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/Makefile.am: Bump library major. This is a preparation
+	for a rework that was due for quite some time, but that is
+	now required to properly implement variadic jit functions.
+	The rework is mainly required to know at prolog parsing, if
+	a function is variadic or not. This will benefit a few
+	backends, and is mandatory for the hard float arm abi.
+	The rework was already planned for quite some time, to
+	be able to use a variable stack framesize, and for leaf
+	functions optimization where applicable.
+	The change will be source compatible, but will change
+	some internals, and jit_code_t values, as some new will
+	be added.
+	The only behavior change is that, jit_arg_register_p may
+	change return value on hard float arm abi, if called before
+	or after jit_ellipsis. Common sense anyway, would say to
+	make that call after jit_ellipsis, but documentation
+	should be updated for it.
+
+2015-05-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64-fpu.c, lib/jit_aarch64.c: Correct base
+	aarch64 varargs code.
+
+2015-05-24 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Clearly run check if clang is the system
+	compiler.
+
+2015-05-20 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_sparc-cpu.c, lib/jit_sparc-fpu.c, lib/jit_sparc.c:
+	Add base support to jit vararg functions to the sparc backend.
+
+2015-05-20 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_alpha-cpu.c, lib/jit_alpha-fpu.c, lib/jit_alpha.c:
+	Add base support to jit vararg functions to the alpha backend.
+
+2015-05-19 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_hppa-cpu.c, lib/jit_hppa-fpu.c, lib/jit_hppa.c:
+	Add base support to jit vararg functions to the hppa backend.
+
+2015-05-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c, lib/jit_ia64-fpu.c, lib/jit_ia64.c:
+	Add base support to jit vararg functions to the ia64 backend.
+
+2015-05-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-fpu.c, lib/jit_ia64.c: Correct movi_d_w
+	and movi_f_w implementation to work when not using a
+	data buffer. This causes the check varargs.tst to
+	work when passing "-d" to the lightning test tool.
+
+2015-05-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64.c: Implement inline assembly cache flush,
+	required on multiprocessor systems.
+
+2015-05-06 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-cpu.c, lib/jit_mips-fpu.c, lib/jit_mips.c:
+	Add base support to jit vararg functions to the mips backend.
+	Currently only supported on the o32 abi, until access to a
+	n32 system is arranged.
+
+2015-05-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc-fpu.c, lib/jit_ppc.c:
+	Add base support to jit vararg functions to the PowerPC backend.
+
+2015-05-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_s390-cpu.c, lib/jit_s390-fpu.c, lib/jit_s390.c:
+	Add base support to jit vararg functions to the s390 backend.
+
+2015-05-01 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-cpu.c, lib/jit_arm-swf.c, lib/jit_arm-vfp.c,
+	lib/jit_arm.c: Add base support to jit vararg
+	functions to the arm backend.
+
+2015-04-30 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64-cpu.c, lib/jit_aarch64-fpu.c,
+	lib/jit_aarch64.c: Add base support to jit vararg
+	functions to the aarch64 backend.
+
+2015-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_names.c, lib/lightning.c: Add initial support
+	for the new jit_va_start, jit_va_arg, jit_va_arg_d, and
+	jit_va_end interfaces. The jit_va_start call is supposed
+	to return a va_list compatible pointer, but not yet
+	decided if it will be "declared" stdarg compatible,
+	as for now only x86 support has been added (and should
+	be compatible), but issues may arise on other backends.
+
+	* check/lightning.c: Add wrappers to call the new jit_va_*
+	interfaces.
+
+	* lib/jit_x86-cpu.c, lib/jit_x86.c: Implement the new
+	jit_va_* for x86.
+
+	* lib/jit_x86-sz.c: Add fields, but not yet fully updated,
+	as this is an intermediate commit.
+
+	* lib/jit_aarch64-sz.c, lib/jit_aarch64.c,
+	lib/jit_alpha-sz.c, lib/jit_alpha.c,
+	lib/jit_arm-sz.c, lib/jit_arm.c,
+	lib/jit_hppa-sz.c, lib/jit_hppa.c,
+	lib/jit_ia64-sz.c, lib/jit_ia64.c,
+	lib/jit_mips-sz.c, lib/jit_mips.c,
+	lib/jit_ppc-sz.c, lib/jit_ppc.c,
+	lib/jit_s390-sz.c, lib/jit_s390.c,
+	lib/jit_sparc-sz.c, lib/jit_sparc.c: Prepare for the
+	new jit_va_* interfaces. Not yet implemented, and will
+	cause an assertion if used.
+
+	* check/va_list.tst: Simple early test case, that works
+	on x86_64, x32, ix86, cygwin, and cygwin64.
+
+2015-02-17 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_aarch64-cpu.c, lib/jit_aarch64.c,
+	lib/jit_alpha-cpu.c, lib/jit_alpha.c,
+	lib/jit_arm-cpu.c, lib/jit_arm.c,
+	lib/jit_hppa-cpu.c, lib/jit_hppa.c,
+	lib/jit_ia64-cpu.c, lib/jit_ia64.c,
+	lib/jit_mips-cpu.c, lib/jit_mips.c,
+	lib/jit_ppc-cpu.c, lib/jit_ppc.c,
+	lib/jit_s390-cpu.c, lib/jit_s390.c,
+	lib/jit_sparc-cpu.c, lib/jit_sparc.c,
+	lib/jit_x86-cpu.c, lib/jit_x86.c: Implement the new
+	jit_allocar(offs, size) interface, that receives
+	two integer registers arguments, allocates space
+	dynamically in the stack, returns the offset in
+	the first argument, and uses the second argument
+	for the size in bytes of the memory to be allocated.
+
+	* check/allocar.ok, check/allocar.tst: New files
+	implementing test cases for the new jit_allocar
+	interface.
+
+	* check/Makefile.am, check/lightning.c: Update for
+	the new test case and interface.
+
+	* doc/body.texi: Add documentation of the new
+	interface.
+
+2015-02-17 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_x86.h, lib/jit_x86-cpu.c,
+	lib/jit_x86-x87.c: No longer make st(7) available.
+	Need to keep one x87 slots empty to avoid exceptions.
+	This has the side effect of no longer needing the
+	hackish emms instruction before a function call.
+
+2015-02-16 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Remove the jit_regno_patch bitfield
+	register fields before actual emit, as it is only really
+	used before emit, otherwise, on special	conditions it
+	may consider live registers as dead during code emit.
+
+2015-02-15 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c, lib/jit_x86-sse.c, lib/jit_x86-x87.c:
+	Correct encoding of ldxr* stxr* in the x32 abi. If the
+	displacement register is negative, it would generate
+	a 64 bit instruction with a 32 bit unsigned displacement.
+
+	* check/ranger.tst, check/ranger.ok: New files, implementing
+	a test case for negative loads and stores. This is range.tst
+	converted to use registers instead of immediate offsets.
+
+	check/Makefile.am: Update for the new test case.
+
+2015-02-07 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_size.c: Preventively use at least 144 bytes
+	if JIT_INSTR_MAX is less than it. The logic is not
+	guaranteed to be 100% precise, it is mostly heuristics
+	to allocate a buffer with as close as possible size,
+	but a wrong value may cause code generation to write
+	past the end of the buffer.
+
+2015-02-03 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Correct the reason the bug in
+	simplify_stxi was not triggered before, it was due to
+	incorrectly resetting the value->code field, what was
+	causing it to never properly optimize:
+		stxi Im0 Rb0 Rt0
+		ldxi Rt1 Rb1 Im1
+	when Rb0 == Rb1, Rt0 == Rt1 and Im0 == Im1
+	There was another possible issue, that has been also
+	addressed in this commit, that would be the case of
+	Rbn == Rtn, where no redundancy removal is possible.
+
+2015-02-03 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Correct wrong check in simplify_stxi.
+	The test was incorrectly comparing the target register
+	and the displacement offset. This was a time bomb bug,
+	that would trigger in code like:
+		stxi Im0 Rb0 Rt0
+		stxi Im1 Rb1 Rt1
+	if Rb0 == Rb1 && Rt0 == Rt1 && Im0 == Rt1, that is,
+	the wrong check was Im0 == Rt1, instead of the supposed
+	Im0 == Imm1 (that was what the code mean't to do). It
+	was removing the second stxi assuming it was redundantly
+	generated; as that is not uncommon pattern on
+	translators generating jit.
+
+2015-02-02 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, include/lightning/jit_private.h,
+	lib/jit_aarch64.c, lib/jit_alpha.c, lib/jit_arm.c,
+	lib/jit_disasm.c, lib/jit_hppa.c, lib/jit_ia64.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_print.c,
+	lib/jit_s390.c, lib/jit_sparc.c, lib/jit_x86.c: Add a new
+	--enable-devel-disassembler option, that should be used
+	during development, or lightning debug. This option
+	intermixes previous jit_print and jit_disassemble
+	output, making it easier to visualize what lightning
+	call was used, and what code was generated.
+
+2015-01-31 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-cpu.c, lib/jit_arm.c: Only limit to 24 bit
+	displacement non conditional jump in the same jit_state_t.
+
+2015-01-19 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Reorder documentation, making jit_frame
+	and jit_tramp the lightning response to the need of
+	trampolines, continuations and tail call optimizations.
+	A pseudo code example of a factorial function was added.
+	Also added a section for description of the available
+	predicates.
+
+	* doc/fact.c: New file, implementing a simple example of
+	a translation of a trivial, recursive, tail call optimization
+	into lightning calls. This is the conversion to functional C
+	code of the example in doc/body.texi.
+
+	* doc/Makefile.am: Update for the next test case.
+
+2015-01-17 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/jit_aarch64.c,
+	lib/jit_alpha.c, lib/jit_arm-vfp.c, lib/jit_arm.c,
+	lib/jit_hppa.c,	lib/jit_ia64.c, lib/jit_mips.c,
+	lib/jit_ppc.c, lib/jit_s390.c, lib/jit_sparc.c,
+	lib/jit_x86.c: Add the new jit_arg_register_p predicate.
+	The predicate is expected to be used to know if an
+	argument is in a register, what would need special
+	handling if code that can overwrite non callee save
+	registers is executed.
+
+	* check/carg.c: New test case to check consistency and
+	expected usage of jit_arg_register_p.
+
+	* check/Makefile.am: Update for new test case.
+
+2015-01-17 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_aarch64.h,
+	include/lightning/jit_alpha.h,
+	include/lightning/jit_arm.h,
+	include/lightning/jit_hppa.h,
+	include/lightning/jit_mips.h,
+	 include/lightning/jit_ppc.h,
+	include/lightning/jit_s390.h,
+	include/lightning/jit_sparc.h,
+	include/lightning/jit_x86.h,
+	lib/jit_aarch64.c, lib/jit_alpha.c,
+	lib/jit_arm.c, lib/jit_hppa.c,
+	lib/jit_ia64.c, lib/jit_mips.c,
+	lib/jit_ppc.c, lib/jit_s390.c,
+	lib/jit_sparc.c, lib/jit_x86.c: Remove jit_arg_reg_p and
+	jit_arg_f_reg_p from a public header, and define it only
+	on port specific files where an integer offset is used
+	to qualify an argument identifier. Exported code expects
+	an opaque pointer (but of jit_node_t* type) to "qualify"
+	an argument identifier.
+	This patch, and the code review/simplification done during
+	it also corrected some bugs:
+	o Inconsistent jit_arg_d value of double argument after 3
+	  integer arguments in arm for jit_functions; tested, C
+	  functions were being properly called.
+	o Inconsistent use of getarg_{f,d} and putarg*_{f,d} on
+	  s390 (32-bit) that happened to not have a proper test
+	  case, as it would only happen for jit functions, and
+	  tested, called C functions had proper arguments.
+	o Corrected a "last minute" correction that did not go
+	  to the committed version, and would not compile on hppa,
+	  due to bad _jit_putargi_d prototype definition.
+
+2015-01-17 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Correct wrong/outdated information for
+	hton*, pusharg* and ret*, and add missing documentation
+	for rsb*, qmul*, qdvi* and putarg*.
+
+2015-01-15 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, lib/jit_disasm.c: Rewrite workaround
+	to apparent problem to initialize powerpc disassembler.
+
+2015-01-15 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/jit_aarch64.c,
+	lib/jit_alpha.c, lib/jit_arm.c, lib/jit_hppa.c,
+	lib/jit_ia64.c, lib/jit_mips.c,	lib/jit_ppc.c,
+	lib/jit_s390.c, lib/jit_sparc.c, lib/jit_x86.c:
+	Implement jit_putarg*. It works as a mix of jit_getarg*
+	and jit_pusharg*, in the way that the first argument is
+	a register or immediate, and the second is a pointer
+	returned by jit_arg*. The use of the interface is to change
+	values of arguments to the current jit function.
+
+	* check/put.ok, check/put.tst: New test cases exercising
+	the new jit_putarg* interface.
+
+	* check/Makefile.am, check/lightning.c: Update for the
+	new test case and interface.
+
+2015-01-08 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_s390.h, lib/jit_s390-cpu.c,
+	lib/jit_s390-fpu.c, lib/jit_s390-sz.c, lib/jit_s390.c:
+	Renamed s390x* files to s390*.
+
+	* check/float.tst, check/lightning.c, configure.ac,
+	include/lightning.h, include/lightning/Makefile.am,
+	lib/Makefile.am, lib/jit_s390.c, lib/jit_size.c,
+	lib/lightning.c: Update for renamed files.
+
+2015-01-08 Paulo Andrade <pcpa@gnu.org>
+
+        * include/lightning.h, include/lightning/jit_private.h,
+        include/lightning/jit_s390x.h, lib/jit_disasm.c,
+        lib/jit_s390x-cpu.c, lib/jit_s390x-fpu.c, lib/jit_s390x-sz.c,
+        lib/jit_s390x.c, lib/jit_size.c, lib/lightning.c:
+	Add support for generating jit for s390 32 bit. This change
+	also removed %f15 from the list of temporaries fpr registers;
+	it was not being used, but if were, it would corrupt the
+	stack frame because the spill address would overwrite grp
+	offsets.
+
+2014-12-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc.c: Correct some endianess issues
+	on the powerpc le backend.
+
+2014-12-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c: Add mcrxr instruction emulation,
+	as this instruction has been phased out, and should be
+	implemented as a kernel trap.
+
+2014-12-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Better check for need to flush constants
+	before the pool being no longer reachable.
+
+2014-12-25 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h: Split jit_htonr in the new 3 interfaces
+	jit_htonr_us, jit_htonr_ui and jit_htonr_ul, the later only
+	available on 64 bit. The plain/untyped jit_htonr macro call
+	maps to the wordsize one.
+	* lib/jit_aarch64-cpu.c,  lib/jit_aarch64-sz.c, lib/jit_aarch64.c,
+	lib/jit_alpha-cpu.c, lib/jit_alpha-sz.c, lib/jit_alpha.c,
+	lib/jit_arm-cpu.c, lib/jit_arm-sz.c, lib/jit_arm.c,
+	lib/jit_hppa-cpu.c, lib/jit_hppa-sz.c, lib/jit_hppa.c,
+	lib/jit_ia64-cpu.c, lib/jit_ia64-sz.c, lib/jit_ia64.c,
+	lib/jit_mips-cpu.c, lib/jit_mips-sz.c, lib/jit_mips.c,
+	lib/jit_ppc-cpu.c, lib/jit_ppc-sz.c, lib/jit_ppc.c,
+	lib/jit_s390x-cpu.c, lib/jit_s390x-sz.c, lib/jit_s390x.c,
+	lib/jit_sparc-cpu.c, lib/jit_sparc-sz.c, lib/jit_sparc.c,
+	lib/jit_x86-cpu.c, lib/jit_x86-sz.c, lib/jit_x86.c:
+	Update backends for the new jit_htonr*.
+	* check/lightning.c, lib/jit_names.c, lib/lightning.c:
+	Update for the new jit_htonr* interfaces.
+	* check/Makefile.am: Update for new test cases.
+	* check/hton.ok, check/hton.tst: New test cases.
+
+2014-12-24 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, include/lightning/jit_x86.h,
+	lib/jit_disasm.c, lib/jit_x86-cpu.c, lib/jit_x86-sse.c,
+	lib/jit_x86-sz.c, lib/jit_x86-x87.c, lib/jit_x86.c,
+	size.c: Implement support for the x32 abi. Built and
+	tested on Gentoo default/linux/amd64/13.0/x32 profile.
+
+2014-12-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_names.c: Add missing rsbi_f and rsbi_d strings.
+
+2014-12-21 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Call __clear_cache for every page.
+	This should only be required for older boards or
+	toolchain setup, but has been reported to be required
+	for lightning at some point.
+
+2014-12-21 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Correct check to guard overflow of index
+	of constants from program counter.
+
+2014-11-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Remove an optimization to calee save
+	registers that may incorrectly remove a jit_movr under
+	special conditions.
+
+2014-11-20 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_ppc.h, lib/jit_ppc-cpu.c,
+	lib/jit_ppc.c: Add initial powerpc le support.
+
+2014-11-20 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_disasm.c: Change thumb or arm disassemble based on
+	jit code before disassembly.
+
+	* lib/jit_arm-cpu.c: Correct reversed arguments to LDRD and
+	STRD instructions, and correct checking for support of those.
+
+	* lib/jit_arm-swf.c: Correct wrong use of LDRD and STRD and
+	only use those if the register is even.
+
+	* check/check.arm.swf.sh, check/check.arm4.swf.sh: New files
+	to test LDRD and STRD, as well as the alternate code path
+	when those are not available, in the .arm4. test case.
+
+	* check/Makefile.am: Update for the new test cases.
+
+2014-11-08 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_aarch64.c,
+	lib/jit_alpha.c, lib/jit_arm.c, lib/jit_hppa.c,
+	lib/jit_ia64.c, lib/jit_mips.c, lib/jit_ppc.c,
+	lib/jit_s390x.c, lib/jit_sparc.c, lib/jit_x86.c:
+	Implement a private jit_flush call, that flushes
+	the cache, if applicable, aligning down to the
+	previous and up to the next page boundary.
+
+2014-11-08 Paulo Andrade <pcpa@gnu.org>
+
+	* check/ctramp.c: New file. It just repeats the test
+	of tramp.tst, but using two jit_state_t, what should
+	test possible issues with two contexts, and also validate
+	jit_tramp works on backends with function descriptions.
+
+	* check/Makefile.am: Update for new test case.
+
+2014-11-03 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_mips.h: Do not make the t9 register
+	JIT_R11 (or JIT_R7 for n32 or n64 abi) available. Previously
+	it cause problems if one expects it to not be changed in a
+	function call. For example, calling a jit function, where it
+	really does not need to be changed.
+
+2014-10-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64.c, lib/jit_alpha.c, lib/jit_arm.c,
+	lib/jit_hppa.c, lib/jit_ia64.c, lib/jit_mips.c, lib/jit_ppc.c,
+	lib/jit_s390x.c, lib/jit_sparc.c, lib/jit_x86.c: Add an
+	assertion to all code generation "drivers" to ensure
+	_jitc->regarg is empty or in an expected state, after
+	translation of a lightning instruction to native code.
+	This change was a brute force test to find out other cases
+	of a temporary not being release (like was happening with
+	_bmsi and _bmci on x86), but no other case was found,
+	after running make check, with assertions enabled, on all
+	backends.
+
+2014-10-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c: Correct a register allocation leak in
+	_bmsi and _bmci.
+
+2014-10-25 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_disasm.c: Do not cause an fatal error if init_jit
+	fails in the jit_init_debug call.
+
+2014-10-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64.c, lib/jit_ppc.c: Correct handling of function
+	descriptor when first prolog is a jit_tramp prolog. The
+	test case was using the same jit_context_t, so was not
+	triggering this condition.
+
+	* lib/jit_ppc-cpu.c: Properly handle jump displacements that
+	do not fit on 24 powerpc. This required changing from previous
+	"mtlr reg, blr" to "mtctr reg, bctr" to properly handle
+	the logic to "hide" function descriptors, but that would
+	also be required as the proper jit_jmpr when/if implementing
+	optimizations to leaf functions (was working with blr because
+	it is saved/reloaded in prolog/epilog).
+
+2014-10-21 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Add three predicates
+	to query information about labels. jit_forward_p(label)
+	will return non zero if the label is "forward", that is
+	need a call to jit_link(label), jit_indirect_p(label)
+	that returns non zero if the label was created with the
+	jit_indirect() call, and jit_target_p(label) that will
+	return non zero if there is at least one jump patched
+	to land at that label.
+
+2014-10-18 Paulo Andrade <pcpa@gnu.org>
+
+	* check/range.ok, check/range.tst: New test case designed
+	to catch incorrect code generation, usually due to incorrect
+	test of immediate size. The test checks a large amount of
+	encodings in "power of two" boundaries. This test exorcises
+	a significant amount of code paths that was previously not
+	tested.
+
+	* check/Makefile.am: Add range test to make check target.
+
+	* lib/jit_aarch64-cpu.c: Correct wrong address calculation
+	for stxi_c, stxi_s, stxi_i and stxi_l when the offset is
+	too large.
+
+        * lib/jit_mips-fpu.c: Correct wrong size test to check if
+	an immediate can be encoded in a float or double store.
+
+	* lib/jit_s390x-cpu.c: Correct inverted encoding to stxi_s
+	when the offset cannot be encoded, and fallbacks to an
+	alternate encoding in 2 instructions.
+
+2014-10-17 Paulo Andrade <pcpa@gnu.org>
+
+	* check/alu_rsb.ok, check/alu_rsb.tst: New files implementing
+	tests for jit_rsb*.
+
+	* check/Makefile.am, check/lightning.c, include/lightning.h,
+	lib/jit_aarch64-cpu.c, lib/jit_aarch64-fpu.c, lib/jit_aarch64-sz.c,
+	lib/jit_aarch64.c, lib/jit_alpha-cpu.c, lib/jit_alpha-fpu.c,
+	lib/jit_alpha-sz.c, lib/jit_alpha.c, lib/jit_arm-cpu.c,
+	lib/jit_arm-swf.c, lib/jit_arm-sz.c, lib/jit_arm-vfp.c,
+	lib/jit_arm.c, lib/jit_hppa-cpu.c, lib/jit_hppa-fpu.c,
+	lib/jit_hppa-sz.c, lib/jit_hppa.c, lib/jit_ia64-cpu.c,
+	lib/jit_ia64-fpu.c, lib/jit_ia64-sz.c, lib/jit_ia64.c,
+	lib/jit_mips-cpu.c, lib/jit_mips-fpu.c, lib/jit_mips-sz.c,
+	lib/jit_mips.c, lib/jit_names.c, lib/jit_ppc-cpu.c,
+	lib/jit_ppc-fpu.c, lib/jit_ppc-sz.c, lib/jit_ppc.c,
+	lib/jit_s390x-cpu.c, lib/jit_s390x-fpu.c, lib/jit_s390x-sz.c,
+	lib/jit_s390x.c, lib/jit_sparc-cpu.c, lib/jit_sparc-fpu.c,
+	lib/jit_sparc-sz.c, lib/jit_sparc.c, lib/jit_x86-cpu.c,
+	lib/jit_x86-sse.c, lib/jit_x86-sz.c, lib/jit_x86-x87.c,
+	lib/jit_x86.c, lib/lightning.c: Implement jit_rsb*. This
+	was a missing lightning 1.x interface, that on most
+	backends is synthesized, but on a few backends (hppa and ia64),
+	it can generate better code as on those there is, or the
+	only instruction with an immediate is in "rsb" format
+	(left operand).
+
+2014-10-17 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_names.c: New file with single definition of string
+	representation of lightning IR codes.
+
+	* size.c: Modified to append the code name in a C comment
+	after the maximum instruction size.
+
+	* lib/jit_print.c: Minor change to not duplicate jit_names.c
+	contents.
+
+	* lib/jit_aarch64-sz.c, lib/jit_alpha-sz.c, lib/jit_arm-sz.c,
+	lib/jit_hppa-sz.c, lib/jit_ia64-sz.c, lib/jit_mips-sz.c,
+	lib/jit_ppc-sz.c, lib/jit_s390x-sz.c, lib/jit_sparc-sz.c,
+	lib/jit_x86-sz.c: Rewritten to add string representation of
+	IR codes in a C comment.
+
+2014-10-14 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64-cpu.c, lib/jit_alpha-cpu.c, lib/jit_arm-cpu.c,
+	lib/jit_hppa-cpu.c, lib/jit_mips-cpu.c, lib/jit_ppc-cpu.c,
+	lib/jit_sparc-cpu.c: Implement or correct the internal
+	nop(count) call that receives an argument that tells the
+	modulo bytes to align the code for the next instruction.
+
+	* include/lightning.h, lib/lightning.c, lib/jit_aarch64.c,
+	lib/jit_alpha.c, lib/jit_arm.c, lib/jit_hppa.c, lib/jit_ia64.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_s390x.c, lib/jit_sparc.c,
+	lib/jit_x86.c: Implement the new jit_align() call that receive
+	an argument, that tells the modulo, in bytes, to align the
+	next instruction. In most backends the only value that makes
+	a difference is a value that matches sizeof(void*), as all
+	other values usually are already automatically aligned in
+	labels, but not guaranteed to be aligned at word size bytes.
+
+	* check/align.ok, check/align.tst: New files, implementing
+	a simple test for the new jit_align() interface.
+
+	* check/Makefile.am, check/lightning.c, lib/jit_aarch64-sz.c,
+	lib/jit_alpha-sz.c, lib/jit_arm-sz.c, lib/jit_hppa-sz.c,
+	lib/jit_ia64-sz.c, lib/jit_mips-sz.c, lib/jit_ppc-sz.c,
+	lib/jit_print.c, lib/jit_s390x-sz.c, lib/jit_sparc-sz.c,
+	lib/jit_x86-sz.c: Update for the new jit_code_align code and
+	the jit_align() interface.
+
+2014-10-13 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/jit_size.c, size.c: Use a
+	symbolic value for the last IR code.
+
+2014-10-12 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_aarch64-cpu.c, lib/jit_alpha-cpu.c, lib/jit_arm-cpu.c,
+	lib/jit_hppa-cpu.c, lib/jit_ia64-cpu.c, lib/jit_mips-cpu.c,
+	lib/jit_ppc-cpu.c, lib/jit_s390x-cpu.c, lib/jit_sparc-cpu.c,
+	lib/jit_x86-cpu.c, lib/lightning.c: Implement the new
+	jit_frame and jit_tramp interfaces, that allow writing
+	trampoline like calls, where a single dispatcher jit buffer
+	is written, and later other jit buffers are created, with
+	the same stack frame layout as the dispatcher. This is the
+	logic that GNU Smalltalk used in lightning 1.x, and is required
+	to make a sane port for lighting 2.x.
+
+	* jit_ia64-cpu.c: Implement support for jit_frame and jit_tramp,
+	and also correct wrong encoding for B4 instructions, that
+	implement jmpr, as well as correct reverse logic in _jmpr,
+	that was moving the branch register to the jump register,
+	and not vice-versa.
+	Also, if a stack frame is to be assumed, always assume it may
+	call a function with up to 8 arguments, regardless of the
+	hint frame argument.
+
+	* lib/jit_arm.c: Add a new must_align_p() interface to ensure
+	function prologs are always aligned. This condition was
+	previously always true, somewhat by accident, but with
+	jit_tramp it is not guaranteed.
+
+	* jit_ia64-cpu.c: lib/jit_ppc.c: Add minor special handling
+	required to implement jit_tramp, where a function descriptor
+	should not be added before a prolog, as jit_tramp means omit
+	prolog.
+
+	* check/lightning.c: Update test driver for the new interfaces.
+
+	* check/Makefile.am, check/tramp.tst, check/tramp.ok: Add
+	a simple test and example of the jit_frame and jit_tramp
+	usage implementing a simple Fibonacci function using a
+	simulation of an interpreter stack and how it would handle
+	state in language specific variables.
+
+	* doc/body.texi: Add documentation for jit_frame and
+	jit_tramp.
+
+2014-09-29 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64.c, lib/jit_alpha.c, lib/jit_arm.c,
+	lib/jit_hppa.c, lib/jit_ia64.c, lib/jit_mips.c,
+	lib/jit_ppc.c, lib/jit_s390x.c, lib/jit_sparc.c,
+	lib/jit_x86.c, lib/lightning.c: Allow jit_jmpi on a
+	target that is not a node. This may lead to hard to
+	debug code generation, but is a required feature for
+	certain generators, like the ones that used lightning
+	1.2x. Note that previously, but not really well
+	documented, it was instructed to use:
+	jit_movi(rn, addr); jit_jmpr(rn);
+	but now, plain:
+	jit_patch_abs(jit_jmpi(), addr);
+	should also work.
+
+2014-09-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-sz.c: Generate information about instruction
+	lengths for more precise calculation of buffer size on
+	Windows x64. This change is specially important because
+	the maximum instruction length is larger than other
+	systems, what could cause an out of bounds write on
+	special conditions without this update.
+
+2014-09-24 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Add workaround to conflicting global
+	optind variable in cygwin binutils that have an internal
+	getopt* implementation.
+
+	* lib/jit_x86-cpu.c: Add a simple define ffsl ffs if building
+	for 32 bit and there is no ffsl function.
+
+2014-09-24 Paulo Andrade <pcpa@gnu.org>
+
+        * check/lightning.c: Add a hopefully temporary kludge to not use
+	sprintf and sscanf returned by dlsym. This is required to pass
+	the varargs test.
+
+        * include/lightning/jit_private.h: Use symbolic name for first
+	integer register argument, as this is different in sysv and
+	win64 abi.
+
+        * include/lightning/jit_x86.h: Add conditionals and definitions
+	for Windows x64 (under __CYGWIN__ preprocessor conditional).
+
+        * lib/jit_x86-cpu.c: Correct one instruction encoding bug, that
+	was working by accident. Only use rax to rdx for some byte
+	operations to work on compatibility mode (that is, to generate
+	the proper encoding, instead of actually generating encoding
+	for high byte registers, e.g. %bh).
+	Add proper prolog and epilog for windows x64.
+
+        * lib/jit_x86-sse.c: Correct a swapped rex prefix for float
+	operations.
+
+        * lib/jit_x86.c: Adjust to support Windows x64 abi.
+
+	* check/check.x87.nodata.sh: New file, previously used but that
+	was missing git.
+
+2014-09-07 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Mark all registers advertised as live, as
+	per jit_callee_save_p as live whenever reaching a jump that
+	cannot be tracked. This is a rethink of the previous commit,
+	and is a better approach, otherwise there would not be much
+	sense on relying on jit_callee_save_p if it could not be
+	trusted.
+
+	* check/jmpr.tst, check/jmpr.ok: New files implementing a very
+	simple test case, that would actually cause an assertion on
+	code before the change to only mark as live when reaching a
+	jump that could not tracked, the actually advertised as callee
+	save registers.
+
+	check/Makefile.am: Update for new jmpr test case.
+
+2014-09-01 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Do not mark all registers in unknown state
+	as live on jit_jmpr, or jit_jmpi to an absolute address. Instead,
+	treat it as a function call, and only consider JIT_Vn registers
+	as possibly live.
+
+2014-08-29 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Add a proper info menu entry for
+	GNU lightning.
+
+	* doc/version.texi: Regenerate.
+
+2014-08-16 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64-cpu.c, lib/jit_aarch64-fpu.c,
+	lib/jit_arm-cpu.c, lib/jit_arm-vfp.c,
+	lib/jit_hppa-cpu.c, lib/jit_hppa-fpu.c,
+	lib/jit_ia64-cpu.c, lib/jit_ia64-fpu.c,
+	lib/jit_mips-cpu.c, lib/jit_mips-fpu.c,
+	lib/jit_ppc-cpu.c, lib/jit_ppc-fpu.c,
+	lib/jit_s390x-cpu.c, lib/jit_s390x-fpu.c,
+	lib/jit_s390x.c, lib/jit_sparc-cpu.c,
+	lib/jit_x86-cpu.c, lib/jit_x86-sse.c,
+	lib/jit_x86-x87.c: Review generation of all branch
+	instructions and always adds the jit_class_nospill
+	bitfield for temporary registers that cannot be	spilled
+	because the reload would be after a conditional jump; the
+	patch only adds an extra assertion. These conditions do
+	not happen on documented lightning usage, but can happen
+	if one uses the not exported jit_get_reg and jit_unget_reg
+	calls and cause enough register starvation.
+
+2014-08-16 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_alpha.c: Correct wrong bitmask of most argument
+	float register arguments, that were being set as callee
+	save instead of argument registers class.
+
+2014-08-16 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-sz.c: Regenerate table of known maximum
+	instruction sizes for the software float fallback,
+	that implements "virtual" float registers in the stack
+	and operations as calls to libgcc.
+
+	* size.c: Correct typo in the generated jit_arm-sz.c file.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+        * include/lightning/jit_alpha.h, lib/jit_alpha-cpu.c,
+        lib/jit_alpha-fpu.c, lib/jit_alpha-sz.c, lib/jit_alpha.c:
+	New files implementing a lightning Alpha port. Thanks
+	to Trent Nelson and snakebit.net staff for providing access
+	to an Alpha system.
+
+        * check/float.tst, check/lightning.c, configure.ac,
+        include/lightning.h, include/lightning/Makefile.am,
+        include/lightning/jit_private.h, lib/Makefile.am,
+        lib/jit_disasm.c, lib/jit_size.c, lib/lightning.c:
+	Minor changes to adapt for the new Alpha port.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Always mark JIT_RET and JIT_FRET as
+	live in a function epilog. This is required because
+	on some ports a complex sequence, allocating one or more
+	registers, may be required to jump from a ret* to the
+	epilog, and the lightning api does not have annotations
+	to know if a function returns a value, or the type of
+	the return value.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Change the correct live bitmask of
+	return registers after a function call in jit_update.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Change assertions to have an int
+	result and correct a bad bit mask assertion.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64.c: Correct bad setup for assertion
+	of consistency before a patch.
+
+2014-08-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-cpu.c: Correct typo in the jit_bmsr
+	implementation that was using the wrong test result
+	register.
+
+2014-07-28 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_memory.c: Do not call free on NULL pointers.
+
+	* include/lightning/jit_private.h, lib/jit_note.c,
+	lib/lightning.c: Add a wrapper to memcpy and memmove
+	to not actually call those functions with a zero size
+	argument, and likely also a null src or dst.
+
+2014-07-27 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_disasm.c,
+	lib/lightning.c: Remove the global jit_progname variable.
+	It was being only used in jit_init_debug, that is called
+	from init_jit, so, just pass an argument.
+
+2014-07-27 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Add note that jit_set_memory_functions
+	should be called before init_jit, because init_jit
+	itself may call the memory wrappers.
+
+2014-04-22 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Do not get confused with default settings
+	if /proc is not mounted on Linux specific code path.
+
+2014-04-09 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_aarch64.h, include/lightning/jit_arm.h,
+	include/lightning/jit_hppa.h, include/lightning/jit_ia64.h,
+	include/lightning/jit_mips.h, include/lightning/jit_ppc.h,
+	include/lightning/jit_private.h, include/lightning/jit_s390x.h,
+	include/lightning/jit_sparc.h, include/lightning/jit_x86.h:
+	Do not add jit_regset_t, JIT_RA0, and JIT_FA0 to the installed
+	header file. These types and definitions are supposed to be
+	only used internally.
+
+2014-04-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-cpu.c: Only adjust stack pointer in prolog if
+	need stack space, that is, do not emit a nop instruction
+	subtracting zero from the stack pointer.
+
+2014-04-04 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_disasm.c: Correct a crash in the doc/printf example
+	on arm due to releasing the data_info information in
+	jit_clear_state. This is a special case for arm only, and
+	actually, only armv5 or older uses the data_info buffer,
+	or when forcing arm instruction set mode besides thumb
+	available.
+
+2014-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Write detailed description and examples for
+	jit_get_memory_functions, jit_set_memory_functions,
+	jit_get_code, jit_set_code, jit_get_data and jit_set_data.
+
+2014-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/lightning.c: Implement the new jit_set_data() interface,
+	and the new jit_get_data() helper. Like jit_set_code(),
+	jit_realize() should be called before jit_set_data().
+	The most common usage should be jit_set_data(JIT_DISABLE_DATA
+	| JIT_DISABLE_NOTE), to force synthesize any float/double
+	constant in the stack and not generate any debug information.
+
+	* lib/jit_note.c: Minor change to debug note generation as
+	now it uses an alternate temporary data buffer during constants
+	and debug generation to accommodate the possibility of the user
+	setting an alternate data buffer.
+
+	* lib/jit_hppa-fpu.c, lib/jit_s390x.c, lib/jit_s390x-cpu.c,
+	lib/jit_s390x-fpu.c, lib/jit_sparc.c, lib/jit_sparc-fpu.c,
+	lib/jit_x86-sse.c, lib/jit_x86-x87.c: Implement jit_set_data.
+
+	* lib/jit_hppa-sz.c, lib/jit_sparc-sz.c, lib/jit_x86-sz.c,
+	lib/jit_s390x-sz.c: Update for several instructions that now
+	have a different maximum length due to jit_set_data.
+
+	* lib/jit_mips-fpu.c: Implement jit_set_data, but missing
+	validation on n32 and n64 abis (and/or big endian).
+
+	* lib/jit_mips-sz.c: Update for changes in o32.
+
+	* lib/jit_ppc-fpu.c: Implement jit_set_data, but missing
+	validation on Darwin PPC.
+
+	* lib/jit_ppc-sz.c: Update for changes in powerpc 32 and
+	64 bit.
+
+	* lib/jit_ia64-fpu.c: Implement untested jit_set_data.
+
+	* TODO: Add note to list ports that were not tested for the
+	new jit_set_data() feature, due to no longer having access
+	to them.
+
+	* check/nodata.c: New file implementing a simple test exercising
+	several different conditions created by jit_set_data().
+
+	* check/check.nodata.sh: New file implementing a wrapper
+	over the existing *.tst files, that runs all tests without
+	using a data buffer for constants; only meaningful (and
+	enabled) on architectures that used to store float/double
+	constants on a read only data buffer.
+
+	* configure.ac, check/Makefile.am: Update for the new test
+	cases.
+
+	* check/lightning.c: Implement the new "-d" option that
+	sets an internal flag to call jit_set_data() disable
+	constants and debug, that is, using only a pure code
+	buffer.
+
+2014-11-03 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/lightning.c: Implement the new jit_set_code() interface,
+	that allows instructing lightning to use an alternate code
+	buffer. The new jit_realize() function should be called
+	before jit_set_code(), and usually call jit_get_code()
+	to query the amount of bytes expected to be required for
+	the code.
+
+	* lib/jit_size.c: Minor update to have less chances of
+	miscalculating the code buffer by starting the counter
+	with the size of the longest instruction instead of zero,
+	as code emit fails if at any moment less than the longest
+	instruction bytes are available.
+
+	* check/setcode.c: New file implementing some basic tests
+	of the new jit_set_code() interface.
+
+	* check/Makefile.am: Update for newer test case.
+
+2014-06-03 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Add the new
+	jit_indirect() call, that returns a special label node,
+	and tells lightning that the label may be the target of
+	an indirect jump.
+
+	* doc/body.texi: Document the new jit_indirect() call, and
+	add examples of different ways to create labels and branches.
+
+2014-23-02 Paulo Andrade <pcpa@gnu.org>
+
+	*  lib/jit_x86.c: Rewrite previous patch to inline save/restore
+	because clobbering %ebx in x86 is treated as an error
+	(jit_x86.c:239:5: error: PIC register clobbered by 'ebx' in 'asm').
+
+2014-19-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86.c: Rewrite incorrect inline assembly that could
+	truncate a variable in a callee save register. Now it simply
+	tells gcc that the register is clobbered, instead of using a
+	*32 bit* swap with a temporary variable. The problem only
+	happens when compiling with optimization.
+
+2014-19-02 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_aarch64.h, include/lightning/jit_arm.h,
+	include/lightning/jit_hppa.h, include/lightning/jit_ia64.h,
+	include/lightning/jit_mips.h, include/lightning/jit_ppc.h,
+	include/lightning/jit_s390x.h, include/lightning/jit_sparc.h,
+	include/lightning/jit_x86.h: Change jit_regset_t to an
+	unsigned type, to allow safe right shift.
+
+	* lib/lightning.c: Rewrite jit_regset_scan1 to allow easier
+	compiler optimization.
+
+2013-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-x87.c: Correct wrong optimization when
+	loading the log(2) constant.
+
+2013-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c: Use the emms instruction before
+	calling any function. This is particularly important
+	when using c99 complex functions as it can easily
+	overflow the x87 stack due to the way lightning uses
+	the x87 stack as a flat register file.
+
+2013-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-x87.c: Correct wrong code generation due
+	to comparing the base and not the value register with
+	%st(0) in stxi_f.
+
+2013-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-x87.c, lib/jit_x86.c: Use 8 bytes aligned
+	stack offset for float/double x87 to/from sse move.
+
+2013-11-27 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, lib/jit_arm-swf.c, lib/jit_arm.c: Add
+	changes that should at least allow building lightning
+	on Apple iOS7.
+
+2013-10-08 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c: Correct wrong shortcut for ldxi_l with
+	a zero offset, that was calling ldr_i instead of ldr_l.
+
+2013-10-08 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_arm.h, lib/jit_arm-cpu.c: Do not use
+	by default load/store instructions that map to ldrt/strt.
+	There is already the long displacement version for positive
+	offsets, and when using a (shorter) negative offset it does
+	not map to ldrt/strt. At least on qemu strt may cause
+	reproducible, but unexpected SIGILL.
+
+2013-10-08 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-vfp.c: Correct wrong load/store offset
+	calculation when the displacement is constant but too
+	large to use an instruction with an immediate offset.
+
+2013-10-07 Paulo Andrade <pcpa@gnu.org>
+
+	* check/self.c: Extend tests to validate jit_callee_save_p
+	does not cause an assertion on valid arguments, and test
+	extra registers defined on some backends.
+
+	* configure.ac: Do not ignore environment CFLAGS when
+	checking if need to test runtime configurable options,
+	like use x87 when sse2 is available, arm instruction set
+	instead of thumb, etc.
+
+	* include/lightning/jit_arm.h: Correct wrong jit_f macro
+	definition.
+
+	* include/lightning/jit_ia64.h, include/lightning/jit_ppc.h: 
+	Correct wrong jit_r macro definition.
+
+	* lib/jit_x86-x87.c, lib/jit_x86.c: Actually use the
+	reserved stack space for integer to/from float conversion.
+	The stack space was also changed to ensure it is 8 bytes
+	aligned. Also, for Solaris x86 in 32 bit mode, an alternate
+	truncr_d was implemented because for some reason it is
+	failing with SIGILL if using the "fisttpl" instructions,
+	that must be available on p6 or newer, but for the sake of
+	making all tests pass, implement a 486 or newer sequence
+	if "sun" is defined.
+
+2013-10-03 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_mips.h, lib/jit_mips-cpu.c,
+	lib/jit_mips-sz.c, lib/jit_mips.c, size: Build and
+	pass all test cases on Irix big endian mips using
+	the 64 bit abi.
+
+2013-10-02 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_mips.h: Add proper mips abi detection.
+
+2013-09-30 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_print.c: Do not crash if calling jit_print from
+	gdb before actually emitting code.
+
+	* lib/lightning.c: Correct misplaced check for already
+	visited blocks on conditional branches, what was preventing
+	proper merge live bit masks of forward blocks.
+
+2013-09-30 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c: Correct not properly tested case of using
+	%r12 as index register, what was causing an invalid assertion.
+	%r12 is mapped to the "extra" JIT_R3 register, and test cases
+	only test "standard" lightning registers.
+
+2013-09-28 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64.c: Minor change to force collecting the maximum
+	instruction length in the --enable-devel-get-jit-size build
+	mode. The actual generated file did not change because the
+	sampling was large enough that it had already collected proper
+	information in the previously slightly buggy code (not forcing
+	a sync of the instructions that could be combined).
+
+2013-09-27 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Correct build when disassembler is
+	disabled.
+
+2013-09-25 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c, lib/jit_ia64-fpu.c: Correct some
+	off by one range checks (that were only accepting values
+	one less than the maximum allowed) and an invalid test
+	condition check that was forcing it to always use
+	indirect jumps even when reachable with an immediate
+	displacement.
+
+2013-09-24 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64-sz.c, lib/jit_arm-sz.c, lib/jit_hppa-sz.c,
+	lib/jit_ia64-sz.c, lib/jit_mips-sz.c, lib/jit_ppc-sz.c,
+	lib/jit_s390x-sz.c, lib/jit_size.c, lib/jit_sparc-sz.c,
+	lib/jit_x86-sz.c: New files implementing static tables
+	with longest known instructions length generated to match
+	a lightning instruction. These tables should make it easier
+	to make it very unlikely to ever miscalculate, or by too
+	much, the size of a code buffer.
+
+	* lib/jit_size.c: New file that aids to either collect
+	jit code size information, or use the information depending
+	on build options.
+
+	* size.c: New helper file that parses input for, and create
+	an initial jit_$arch-sz.c file, that needs some minor edit
+	for arches with multiple configurations.
+
+	* configure.ac, Makefile.am: Add the new, devel mode only
+	--enable-devel-get-jit-size configure option, that sets
+	compile time flags to collect jit code size information,
+	that will be used as input for the "noinst size program".
+
+	* lib/jit_aarch64.c, lib/jit_arm.c, lib/jit_disasm.c,
+	lib/jit_hppa.c, lib/jit_ia64.c, lib/jit_memory.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_s390x.c,
+	lib/jit_sparc.c, lib/jit_x86.c, lib/lightning.c: Minor
+	changes for the --enable-devel-get-jit-size build mode,
+	as well as the "production build mode" with jit code
+	size information.
+
+2013-09-14 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Add the new
+	jit_pointer_p interface, that returns a boolean value
+	telling if the pointer argument is inside the jit
+	code buffer. This is useful to avoid the need to add
+	extra labels and calls to jit_address to figure bounds
+	of code buffer, and still keep internal data private.
+
+2013-09-13 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_note.c: Change the code argument of jit_get_note
+	to a jit_pointer_t and make jit_get_note a public interface.
+	It was intended so since start, as a way to map an offset
+	in the code to a function name, file name and line number
+	mapping.
+
+2013-09-11 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Correct reversed arguments in example of
+	usage in a (possibly) multi threaded, multiple jit_state_t
+	environments.
+
+	* include/lightning/jit_arm.h, include/lightning/jit_private.h,
+	lib/jit_arm-cpu.c, lib/jit_arm.c: Make a previously, non
+	documented, global state private to the related jit_state_t
+	generating code.
+
+2013-09-10 Paulo Andrade <pcpa@gnu.org>
+
+	* check/self.c, check/self.ok: New files implementing simple
+	consistency check assertions. At first validating some macros
+	that use values from different sources agree.
+
+	* check/Makefile.am: Update for the new test case.
+
+	* include/lightning.h,  lib/lightning.c: Add the new
+	jit_callee_save_p() call, that is intended to be used when
+	writing complex code using lightning, so that one does not
+	need to verify what backend is being used, or have access to
+	private data, to query if a register is callee save or not;
+	on several backends the scratch registers are actually callee
+	save.
+
+	* include/lightning/jit_aarch64.h, include/lightning/jit_arm.h,
+	include/lightning/jit_hppa.h, include/lightning/jit_mips.h,
+	include/lightning/jit_ppc.h, include/lightning/jit_sparc.h,
+	include/lightning/jit_x86.h: Add an explicit definition for
+	JIT_R3-JIT_Rn, JIT_V3-JIT_Vn and JIT_F6-JIT_Fn when applicable.
+	This allows one to write code based on "#if defined(JIT_XN)"
+	and therefore, not need to check what is the current backend
+	or have access to private data structures. This is particularly
+	useful when writing virtual machines with several specialized,
+	global registers.
+
+	* lib/jit_ia64.c: Properly flag the callee save general
+	purpose registers as such, so that jit_callee_save_p() works
+	as intended.
+
+2013-09-10 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c, configure.ac: Conditionally use the
+	code written to workaround a bug in the Hercules emulator,
+	as isnan and isinf are not available at least on HP-UX ia64.
+
+2013-09-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_s390x-cpu.c: Spill/reload correct callee save
+	float registers.
+
+2013-09-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_hppa-cpu.c: Correct code to call a function stored
+	in a register or a patched function address.
+
+2013-09-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c: Correct incorrect logic when restoring
+	the value of the "r2" callee save register.
+
+2013-08-29 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-cpu.c, lib/jit_arm.c: Correct wrong test and update
+	of the thumb offset information, when checking if needing to
+	patch a jump from arm to thumb mode. The problem would happen when
+	remapping the code buffer, and the new address being lower than
+	the previous one.
+
+2013-08-26 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac: Extend FreeBSD test to also handle NetBSD.
+
+	* lib/jit_x86-cpu.c: Correct wrongly defined offset type of
+	ldxi_ui. Problem detected when building on NetBSD.
+
+	* lib/lightning.c: Adjust code to handle NetBSD mremap,
+	where arguments do not match Linux mremap.
+
+2013-08-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc.c: Correct C sequence point problem miscalculating
+	the actual function address in a function descriptor. Problem
+	happens with gcc 4.8.1 at least.
+
+2013-08-11 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_s390x-cpu.c: Correct code checking if immediate
+	fits instruction, but using the negated value.
+
+2013-07-28 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_s390x.h, lib/jit_s390x-cpu.c,
+	lib/jit_s390x-fpu.c, lib/jit_s390x.c: New files
+	implementing the new s390x port.
+
+	* configure.ac, include/lightning.h,
+	include/lightning/Makefile.am,
+	include/lightning/jit_private.h,
+	lib/Makefile.am, lib/jit_disasm.c, lib/lightning.c:
+	Minor adaptation for the new s390x backend.
+
+	* check/float.tst: Update for the s390x result of
+	truncating +Inf to integer.
+
+	* check/qalu_mul.tst: Add extra test cases to better test
+	high word of signed multiplication as the result is
+	adjust from unsigned multiplication on s390x.
+
+2013-07-28 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Do not assume casting a double NaN or
+	Inf to float will produce the expected float NaN or Inf.
+	This is not true at least under s390x.
+
+2013-07-28 Paulo Andrade <pcpa@gnu.org>
+
+	* check/check.arm.sh, check/check.sh, check/check.swf.sh,
+	check/check.x87.sh: Properly check test programs output,
+	not just rely on the test program self testing the results
+	and not crashing.
+
+2013-07-28 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_aarch64.c: Remove unused macros left from cut&paste
+	of jit_arm.c.
+
+2013-07-16 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_aarch64.h, lib/jit_aarch64-cpu.c,
+	lib/jit_aarch64-fpu.c, lib/jit_aarch64.c: New files
+	implementing the new aarch64 port, as a new architecture,
+	not as an expansion of the existing armv[4-7] port.
+
+	* check/lightning.c: Add aarch64 support and a small
+	change to recognize character constants as immediate
+	values.
+
+	* check/float.tst: Add aarch64 preprocessor conditionals
+	to select proper expected value when converting [+-]Inf
+	and NaN to integer.
+
+	* include/lightning/jit_arm.h, lib/jit_arm.c: Minor changes
+	to better match the new aarch64 files.
+
+	* configure.ac, include/lightning.h,
+	include/lightning/Makefile.am, include/lightning/jit_private.h,
+	lib/Makefile.am, lib/lightning.c: Minor adjustments
+	for the aarch64 port.
+
+2013-07-08 Paulo Andrade <pcpa@gnu.org>
+
+	* NEWS, THANKS, configure.ac, doc/version.texi: Update for
+	the 1.99a second alpha release.
+
+2013-06-25 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips.c: Correct cut&paste error that caused wrong
+	stack offset calculation for double arguments in stack in
+	the o32 abi.
+	Correct typo in the __LITTLE_ENDIAN macro name, that came
+	from cut&paste error in the original typo in lib/jit_ppc.c.
+
+	* lib/jit_ia64.c, lib/jit_ppc.c: Correct typo in the
+	__LITTLE_ENDIAN macro name.
+
+2013-06-22 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c, configure.ac, include/lightning.h,
+	lib/lightning.c: Add tests and quirks to build/detect
+	and/or work on Irix.
+
+	* include/lightning/jit_mips.h, lib/jit_mips-cpu.c,
+	lib/jit_mips-fpu.c, lib/jit_mips.c: Adapt code to run
+	in big endian mips, using the n32 abi.
+
+2013-06-18 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h: Minor extra preprocessor testing
+	to "detect" byte order on x86 solaris, that now builds
+	and pass all test cases.
+
+2013-06-18 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_sparc-cpu.c: Correct compiler warning of value
+	used before assignment. The usage is bogus as the api
+	requires always patching jumps, but the random value used
+	could cause an assertion due to invalid displacement.
+
+	* lib/jit_sparc.c: Always load and store double arguments
+	in stack as 2 float loads or stores, for safety, as unaligned
+	access is not allowed in Sparc Solaris.
+
+2013-06-14 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac: Force -mlp64 to CFLAGS on HP-UX ia64 port.
+	It is the only supported mode, and expects gcc as C compiler.
+
+	* include/lightning.h, lib/jit_ia64-cpu.c, lib/jit_ia64.c:
+	Correct ia64 port to work on HP-UX that runs it in big endian
+	mode.
+
+2013-06-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_hppa.c: Sanitize the cache synchronization inline
+	assembly code that was doing twice the work and redundantly
+	flushing the end address every loop iteration.
+
+2013-06-09 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, check/Makefile.am, doc/Makefile.am: Do not
+	explicitly link to -ldl, but instead autodetect the library
+	with dlopen, dlsym, etc.
+
+	* check/lightning.c: Add workaround to apparently buggy
+	getopt in HP-UX that sets optind to the wrong index, and
+	use RTLD_NEXT on HP-UX instead of RTLD_DEFAULT to dlsym
+	global symbols.
+
+	* include/lightning.h: Rework definitions of wordsize and
+	byte order to detect proper values on HP-UX.
+
+	* lib/lightning.c: Minor correction to use MAP_ANONYMOUS
+	instead of MAP_ANON on HP-UX.
+
+	* lib/jit_hppa.c: Float arguments must be passed on integer
+	registers on HP-UX, not only for varargs functions.
+	  Add code to properly clear instruction cache. This was
+	not required on Debian hppa port, but may have been working
+	by accident.
+
+	* lib/jit_hppa-cpu.c: Follow pattern of HP-UX binaries and
+	use bve,n instead of bv,n to return from functions.
+
+	* lib/jit_hppa-fpu.c: For some reason "fst? frX,rX,(rY)" did
+	not work on the tested computer	(HP-UX B.11.23 U 9000/785 HP-UX)
+	so the code was changed, at first for __hpux only to add the
+	base and offset register and use the instruction with an
+	immediate (zero) offset.
+
+2013-06-07 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c, lib/jit_disasm.c, lib/jit_ppc-cpu.c,
+	lib/jit_ppc-fpu.c, lib/jit_ppc.c, include/lightning.h,
+	include/lightning/jit_ppc.h, include/lightning/jit_private.h:
+	Adapt code to work on 32 bit AIX ppc using gcc. Most changes
+	are basically to adapt the elf64 logic to 32 bit, as it does
+	not use the same convention of 32 bit Darwin ppc.
+
+	* check/stack.tst: Add a fake memcpy function to the test
+	case if running under AIX, as it is not available to dlsym.
+
+	* configure.ac: Check for getopt.h header, not available in
+	AIX.
+
+2013-06-01 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_hppa.h, lib/jit_hppa-cpu.c,
+	lib/jit_hppa-fpu.c, lib/jit_hppa.c: New files implementing
+	the hppa port. Built on Debian Linux PA-RISC 2.0, 32 bit.
+
+	* check/float.tst: Add preprocessor for hppa expected
+	values when converting NaN and +-Inf to an integer.
+
+	* check/ldst.inc: Ensure double load/store tests use an
+	8 byte aligned address by default.
+
+	* lib/lightning.c: Correct a bug found during tests in
+	the new port, where qmul* and qdiv* were not properly
+	setting one of the result registers as modified in the
+	function, what would be a problem if the only "write"
+	usage were the qmul* or qdiv*.
+
+	* check/varargs.tst, check/varargs.ok: Add one extra
+	interleaved integer/double test to validate proper code
+	generation in the extra case.
+
+	* check/lightning.c, configure.ac, include/lightning.h,
+	include/lightning/Makefile.am,
+	include/lightning/jit_private.h, lib/Makefile.am,
+	lib/jit_disasm.c: Update for the hppa port.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* check/varargs.tst: Correct misplaced .align directive
+	that was causing the double buffer to not be aligned at
+	8 bytes.
+	* lib/jit_ia64-cpu.c:
+	  Properly implement abi for excess arguments passed on
+	stack.
+	  Simplify load/store with immediate displacement argument
+	with zero value.
+	  Simplify some calls to "subi" changing to "addi" with
+	a negative argument.
+	  Remove some #if 0'ed code, that could be useful in
+	special conditions, but the most useful one would be
+	to "optimize" "static" jit functions, but for the sake
+	of simplicity, jit functions are implemented in a way
+	that can be passed back to C code as C function pointers.
+	  Add an attribute to prototypes of several unused functions.
+	These functions are defined for the sake of implementing all
+	Itanium documented instructions, but a significant amount of
+	them is not used by lightning.
+	* lib/jit_ia64-fpu.c: Simplify load/store with zero immediate
+	displacement and add unused attribute for functions not used
+	by lightning, but required to provide macros implementing all
+	Itanium documented instructions.
+	* lib/jit_ia64.c: Update for the properly implemented abi
+	for stack arguments.
+	* lib/lightning.c: Mark an unused function as such.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	lib/jit_ia64-cpu.c:
+	  Correct immediate range check of integer comparisons when
+	inverting arguments.
+	  Correct gei_u that was not decrementing immediate when
+	inverting arguments.
+	  Correct b?add* and b?sub* that were not properly updating
+	the result register.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c: Correct wrong mapping of 2 instructions
+	in "M-, stop, M-, stop" translation, that was ignoring the
+	last stop (implemented as a nop I- stop).
+
+	* lib/jit_ia64-fpu.c: Properly implement fnorm.s and fnorm.d,
+	as well as the proper integer to float or double conversion.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c: Correct bogus implementation of ldr_T
+	for signed integers, that was using ld1.s, ld2.s and ld4.s.
+	The ".s" stands for speculative load, not sign extend.
+
+	* lib/jit_ia64-fpu.c: Correct bogus implementation of ldxr_T
+	for float and double. The third (actually, second) argument
+	is indeed added to the base register, but the base register
+	is modified. The actual M7 implementation was already correct,
+	just the ldxr_f and ldxr_d implementation that was kept in
+	a prototype state, misinterpreting what M7 does.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c: Correct X2 pattern matching by preventing
+	it to attempt to require a stop between the L and the X
+	instruction; that is, check the registers and predicates
+	before emitting the L instruction, not after.
+
+	* lib/jit_ia64-fpu.c: Slightly simplify and correct
+	divr_f and divrd_d implementation.
+
+	* check/lightning.c: Add __ia64__ preprocessor define
+	on Itanium. 
+
+	* check/alu.inc, check/clobber.tst, check/float.tst: Define
+	several macros conditionally to __ia64__. This is required
+	because __ia64__ jit generation can use way too many memory,
+	due to not implementing instruction reordering to avoid
+	as much as possible "stops", what causes way too many nops
+	to be generated, as well as the fact that division and
+	remainder requires function calls, and float division
+	requires significant code to implement.
+
+2013-04-27 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h: Add new backend specific movr_w_d,
+	movr_d_w and movi_d_w codes as helpers to ia64 varargs
+	functions arguments.
+
+	* lib/jit_ia64-cpu.c:
+	  Correct wrong encoding of A5 small integers.
+	  Correct define of "mux" instruction modifiers.
+	  Correct ordering of arguments and predicates of cmp_xy
+	implementation with immediate arguments; like most other
+	codes with an immediate, the immediate is the second, not
+	the third argument.
+
+	* lib/jit_ia64-fpu.c: Actual implementation of the code
+	to move to/from gpr to/from fpr, to implement varargs abi.
+
+	* lib/jit_ia64.c: Make fpr argument registers not allocatable
+	as temporaries, no need for the extra checks when there are
+	plenty registers.
+
+	* lib/jit_print.c, lib/lightning.c: Minor updates for the
+	new movr_w_d, movr_d_w and movi_d_w codes.
+
+2013-04-26 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ia64-cpu.c, lib/jit_ia64-fpu.c: Correct code to
+	also insert a stop to break an instruction group if a
+	register is written more than once in the same group.
+	This may happen if a register is argument and result of
+	some lightning call (not a real instruction). The most
+	common case should be code in the pattern:
+		movl rn=largenum
+		...
+		mov rn=smallnum
+	where "rn" would end up holding "largenum".
+	But the problem possibly could happen in other circumstances.
+
+2013-04-26 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_ia64.h, lib/jit_ia64-cpu.c,
+	lib/jit_ia64-fpu.c, lib/jit_ia64.c:
+	  Relocate JIT_Rn registers to the local registers, as, like
+	float registers, div/rem and sqrt are implemented as function
+	calls, and may overwrite non saved scratch registers.
+	  Change patch_at to receive a jit_code_t instead of a
+	jit_node_t, so that it is easier to "inline" patches when
+	some instruction requires complex code to implement, e.g.
+	uneq and ltgt.
+	  Correct arguments to FMA and FMA like instructions that,
+	due to a cut&paste error were passing the wrong argument
+	to the related F- implementation function.
+	  Rewrite ltgt to return the proper result if one (or both)
+	of the arguments is unordered.
+
+2013-04-26 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_ia64.h, include/lightning/jit_private.h,
+	lib/jit_ia64-cpu.c, lib/jit_ia64-fpu.c, lib/jit_ia64.c,
+	lib/lightning.c: Rework code to detect need of a "stop" to
+	also handle predicates, as if a predicate is written, it
+	cannot be read in the same instruction group.
+	  Use a single jit_regset_t variable for all registers when
+	checking need for a stop (increment value by 128 for
+	float registers).
+	  Correct wrong "subi" implementation, as the code executed
+	is r0=im-r1, not r0=r1-im.
+	  Use standard lightning 6 fpr registers, and rework to
+	use callee save float registers, that may be spill/reloaded
+	in prolog/epilog. This is required because some jit
+	instructions implementations need to call functions; currently
+	integer div/mod and float sqrt, what may change the value of
+	scratch float registers.
+	  Rework point of "sync" of branches that need to return a
+	patch'able address, because the need for a "stop" before a
+	predicate read causes all branches to be the instruction
+	in slot 0, as there is no template to "stop" and branch
+	in the same instruction "bundle".
+
+2013-04-25 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_ia64.h, lib/jit_ia64-cpu.c,
+	lib/jit_ia64-fpu.c, lib/jit_ia64.c: New files implementing
+	the basic infrastructure of an Itanium port. The code
+	compiles and can generate jit for basic hello world like
+	functions.
+
+	* check/lightning.c, configure.ac, include/lightning.h,
+	include/lightning/Makefile.am, include/lightning/jit_private.h,
+	lib/Makefile.am, lib/lightning.c: Update for the Itanium
+	port.
+
+	* lib/jit_mips-cpu.c, lib/jit_mips.c: Correct typo and
+	make the jit_carry register local to the jit_state_t.
+	This matches code reviewed in the Itanium port, that
+	should use the same base logic to handle carry/borrow.
+
+2013-04-10 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_arm.c,
+	lib/jit_mips-cpu.c, lib/jit_mips.c, lib/jit_ppc-cpu.c,
+	lib/jit_ppc.c, lib/jit_print.c, lib/jit_sparc-cpu.c,
+	lib/jit_sparc.c, lib/jit_x86-cpu.c, lib/jit_x86.c,
+	lib/lightning.c: Change all jit_regset macros to take
+	a pointer argument, to avoid structure copies when
+	adding a port to an architecture with more than 64
+	registers.
+
+2013-04-08 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c, lib/jit_ppc.c: Do not rely on __clear_cache
+	aligning to the next page boundary the end argument. It may
+	actually truncate it.
+
+2013-03-29 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_arm.c, lib/jit_memory.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_sparc.c, lib/jit_x86.c,
+	lib/lightning.c: Do not start over jit generation if can grow
+	the code buffer with mremap without moving the base pointer.
+
+2013-03-29 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_memory.c: Implement a simple memory allocation wrapper
+	to allow overriding calls to malloc/calloc/realloc/free, as well
+	as ensuring all memory containing pointers is zero or points to
+	allocated memory.
+
+	* include/lightning.h, include/lightning/jit_private.h: Definitions
+	for the memory allocation wrapper.
+
+	* lib/Makefile.am: Update for new jit_memory.c file.
+
+	* lib/jit_arm.c, lib/jit_disasm.c, lib/jit_mips.c, lib/jit_note.c,
+	lib/jit_ppc.c, lib/jit_sparc.c, lib/jit_x86.c, lib/lightning.c:
+	Use the new memory allocation wrapper code.
+
+2013-03-22 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, include/lightning/jit_private.h, lib/lightning.c:
+	Remove dependency on gmp. Only a simple bitmap was required, and
+	that was not enough reason to force linking to gmp and possible
+	complications caused by it.
+
+2013-03-10 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h: Add check for __powerpc__ defined
+	in Linux, while Darwin defines __ppc__.
+
+	* include/lightning/jit_ppc.h: Adjust register definitions
+	for Darwin 32 bit and Linux 64 bit ppc usage and/or ABI.
+
+	* include/lightning/jit_private.h: Add proper check for
+	Linux __powerpc__ and an data definition for an workaround
+	to properly handle code that starts with a jump to a "main"
+	label.
+
+	* lib/jit_disasm.c: Add extra disassembler initialization
+	for __powerpc64__.
+
+	* lib/jit_ppc-cpu.c: Add extra macros and functions, and
+	correct/adapt previous ones to handle powerpc64.
+
+	* lib/jit_ppc-fpu.c: Adapt for 64 bit wordsize. Basically
+	add conversion from/to int32/int64 and proper handling of
+	load/store offsets too large for 32 bit.
+
+	* lib/jit_ppc.c: Add calls to 64 bit codes and adaptation
+	for the PowerPC 64 bit Linux ABI.
+
+	* lib/jit_arm.c, lib/jit_mips.c, lib/jit_sparc, lib/jit_x86.c,
+	lib/lightning.c: Correct off by one error when restarting jit
+	of a function due to finding too late that needs to spill/reload
+	some register. Problem was found by accident on a very special
+	condition during PowerPC 64 code adaptation.
+
+2013-03-08 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Add missing ppc preprocessor definition.
+
+2013-03-06 Paulo Andrade <pcpa@gnu.org>
+
+	* check/float.tst: Comment out the int to negative infinity
+	test in mips for the moment because not all Loongson agrees
+	on the result.
+
+	* lib/jit_disasm.c: Add a test instead of an assertion
+	when loading symbols for disassembly due to a failure with
+	a simple binutils build in Debian mipsel64.
+
+2013-03-06 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_arm-cpu.c,
+	lib/jit_arm.c, lib/jit_disasm.c, lib/jit_mips-cpu.c,
+	lib/jit_mips.c, lib/jit_note.c, lib/jit_ppc-cpu.c,
+	lib/jit_ppc.c, lib/jit_print.c, lib/jit_sparc-cpu.c,
+	lib/jit_sparc.c, lib/jit_x86-cpu.c, lib/jit_x86.c,
+	lib/lightning.c: Add an extra structure for data storage
+	during jit generation, and release it after generating
+	jit, to reduce a bit memory usage, and also to make it
+	easier to understand what data is available during
+	jit runtime.
+
+2013-03-06 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Make data and code buffer readonly.
+
+2013-02-20 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Fool proof validate the examples of what
+	an assembly-language programmer would write and correct the
+	wrong sparc example.
+
+2013-02-19 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Add back the SPARC code generation example.
+
+2013-02-19 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Remove state flag to work with partial
+	sparc port, by just disassembling if there was incomplete
+	code generation.
+
+	* jit_sparc-cpu.c: Correct wrong range check for immediate
+	integer constants (off by one bit shift).
+	  Correct macro implementing equivalent "rd %y, rd" assembly.
+	  Implement qmul* and qdiv*.
+
+	* jit_sparc.c: Update for qmul* and qdiv* and remove logic
+	to handle incomplete code generation during sparc port.
+
+2013-02-18 Paulo Andrade <pcpa@gnu.org>
+
+	* check/float.tst: Add sparc to list of known NaN and +-Inf
+	to integer conversion.
+
+	* check/lightning.c: Define __sparc__ to preprocessor in
+	the sparc backend.
+
+	* include/lightning/jit_private.h: Correct wrong definition
+	of emit_stxi_d, that has lived for a long time, but would
+	cause problems whenever needing to spill/reload a float
+	register.
+
+	* include/lightning/jit_sparc.h: Can only use %g2,%g3,%g4
+	for scratch variables, as other "global" registers are
+	reserved for the system, e.g. libc.
+	  Reorder float register naming to make it easier to
+	access odd float registers, so that generating code for
+	pusharg and getarg is easier for the IR.
+
+	* lib/jit_mips-cpu.c, lib/jit_ppc-cpu.c: Update to match
+	new code in jit_sparc-cpu.c. It must call jit_get_reg
+	with jit_class_nospill if using the register to move
+	an unconditional branch address to it, as the reload
+	will not happen (actually could happen in the delay
+	slot...)
+
+	* lib/jit_sparc-cpu.c: Correct wrong macro definition for
+	ldxr_s.
+	  Properly implement div* and implement rem. Div* needs
+	to use the y register, and rem* needs to be synthesized.
+	  Correct b?sub* macro definitions.
+
+	* lib/jit_sparc-fpu.c: Correct reversed float to/from double
+	conversion.
+	  Correct wrong jit_get_reg call asking for a gpr and then
+	using the fpr with that number.
+	  Correct wrong branch displacement computation for
+	conditional branches.
+
+	* lib/jit_sparc.c: Correct getarg_d and pushargi_d implementation.
+	  Add rem* entries to the switch converting IR to machine code.
+
+	* lib/lightning.c: Correct a problem detected when adding
+	the jit_class_nospill flag to jit_get_reg, that was caused
+	when having a branch to an "epilog" node, what would cause
+	the code to think all registers in unknown state were live,
+	while in truth, all registers in unknown state in the
+	"just after return" point are actually dead.
+
+2013-02-17 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_sparc.h, lib/jit_sparc-cpu.c,
+	lib/jit_sparc-fpu.c, lib/jit_sparc.c: New files implementing
+	the basic framework of the sparc port.
+
+	* configure.ac, include/lightning.h, include/lightning/Makefile.am,
+	include/lightning/jit_private.h, lib/jit_disasm.c: Update
+	for the sparc port framework.
+
+	* lib/jit_mips.c: Correct reversed retr/reti logic.
+
+	* lib/jit_ppc.c: Correct misspelled __LITTLE_ENDIAN.
+
+	* lib/lightning.c: Always do byte hashing in hash_data, because
+	the logic to "compress" strings causes large pointers to not
+	be guaranteed aligned at 4 byte boundaries.
+	  Update for the sparc port framework.
+
+2013-02-11 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Correct jit_pushargi_f in the arm hardfp abi.
+	Most of the logic uses even numbered register numbers, so that
+	a float and a double can be used in the same register, but
+	the abi requires packing the float arguments, so jit_pushargi_f
+	needs to allocate a temporary register to modify only the
+	proper register argument (or be very smart to push two
+	immediate arguments if applicable).
+
+2013-02-11 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Implement the new
+	jit_clear_state and jit_destroy_state calls. jit_clear_state
+	releases all memory not required during jit_execution; that
+	is, leaves only the mmap'ed data and code buffers allocated.
+	jit_destroy_state releases the mmap'ed buffers as well as
+	the jit_state_t object itself, that holds pointers to the
+	code and data buffers, as well as annotation pointers (for
+	disassembly or backtrace) in the data buffer.
+
+	* lib/jit_note.c: Correct invalid vector offset access.
+
+	* check/ccall.c, check/lightning.c, doc/ifib.c, doc/incr.c,
+	doc/printf.c, doc/rfib.c, doc/rpn.c: Use the new jit_clear_state
+	and jit_destroy_state calls, to demonstrate the new code to
+	release all jit memory.
+
+	* doc/body.texi: Add basic documentation and usage description
+	of jit_clear_state and jit_destroy_state.
+
+2013-02-11 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_private.h, lib/jit_note.c, lib/lightning.c:
+	  Store all annotation information in the mmap'ed area reserved for
+	read only data. This adds code to not allocate memory for jit_note_t
+	objects, and to	relocate jit_line_t objects and its contents after
+	calculating annotation information. The jit_line_t objects are
+	relocated because it is not possible to always calculate before
+	hand data layout because note information may be extended or
+	redundant entries removed, as well as allowed to be added in
+	non sequential order.
+	  A bug was also corrected in _jit_set_note, that was causing it
+	to allocate new jit_line_t objects when not needed. It was still
+	working correctly, but allocating way more memory than required.
+
+2013-02-05 Paulo Andrade <pcpa@gnu.org>
+
+	*include/lightning.h, lib/lightning.c: Add the new jit_live code
+	to explicitly mark a register as live. It is required to avoid
+	assuming functions always return a value in the gpr and fpr return
+	register, and to avoid the need of some very specialized codes
+	that vary too much from backend to backend, to instruct the
+	optimization code the return register is live.
+
+	* lib/jit_arm.c, lib/jit_mips.c, lib/jit_ppc.c, lib/jit_print.c,
+	lib/jit_x86.c: Update for the new jit_live code.
+
+	* check/ret.ok, check/ret.tst: New files implementing a simple
+	test case that would previously fail at least in ix86/x86_64.
+
+	* check/Makefile.am: Update for new "ret" test case.
+
+2013-02-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc.c: Validate and correct
+	problems in the qmul and qdiv ppc implementation.
+
+2013-02-04 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_arm-cpu.c, lib/jit_arm.c, lib/jit_mips-cpu.c,
+	lib/jit_mips.c, lib/jit_ppc-cpu.c, lib/jit_ppc.c,
+	lib/jit_x86-cpu.c, lib/jit_x86.c, lib/lightning.c:
+	Implement the new qmul and qdiv instructions that return signed
+	and unsigned lo/hi multiplication result and div/rem division result.
+	These should be useful for jit translation of code that needs to
+	know if a multiplication overflows (no branch opcode added) or if
+	a division is exact (easy check if remainder is zero).
+
+	* check/lightning.c, lib/jit_print.c, check/Makefile.am,
+	check/all.tst: Update for the new qmul and qdiv instructions.
+
+	* check/qalu.inc, check/qalu_div.ok, check/qalu_div.tst,
+	check/qalu_mul.ok, check/qalu_mul.tst: New files implementing
+	simple test cases for qmul and qdiv.
+
+2013-01-30 Paulo Andrade <pcpa@gnu.org>
+
+	* doc/body.texi: Correct "jmpi" description that incorrectly
+	told it was possible to pass any address as jump target. The
+	only way to do that is "movi+jmpr".
+
+2013-01-30 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c: Correct undefined behavior code.
+	http://gcc.gnu.org/bugzilla/show_bug.cgi?id=56143
+
+2013-01-29 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac: Use AC_CONFIG_HEADERS instead of AC_CONFIG_HEADER
+	to have HAVE_CONFIG_H defined with latest aclocal.
+
+	* include/lightning/jit_private.h, lib/lightning.c: Add new
+	abstraction to use an heuristic to calculate amount of space
+	required for jit generation, and code to reallocate buffer if
+	did miscalculate it.
+
+	* lib/jit_arm.c, lib/jit_mips.c, lib/jit_ppc.c, lib/jit_x86.c:
+	Update to use new code to estimate and resize of required buffer
+	for jit code.
+
+	* lib/jit_x86-cpu.c: Minor cosmetic change to avoid adding a
+	non required rex prefix when calling a function pointer stored
+	in a register.
+
+2013-01-24 Paulo Andrade <pcpa@gnu.org>
+
+	* check/Makefile.am: "make debug" target should pass only
+	the main test tool program as argument for running gdb
+
+	* configure.ac: Add the --enable-assertions options.
+
+	* doc/Makefile.am, doc/body.texi, doc/lightning.texi:
+	Major rewrite of the documentation to match the current
+	implementation.
+
+	* doc/version.texi: Automatic date update.
+
+	* doc/ifib.c, doc/incr.c, doc/printf.c, doc/rfib.c, doc/rpn.c:
+	Implementation of the documentation examples, that are also
+	compiled during a normal build.
+
+	* doc/p-lightning.texi, doc/porting.texi, doc/toc.texi,
+	doc/u-lightning.texi, doc/using.texi: These files were
+	renamed in the documentation rewrite, as the documentation
+	was significantly trimmed due to full removal of the porting
+	chapters. Better porting documentation should be added but
+	for the moment it was just removed the documentation not
+	matching the implementation.
+
+2013-01-18 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_note.c: Correct bounds check and wrong code keeping
+	a pointer that could be changed after a realloc call.
+
+2013-01-18 Paulo Andrade <pcpa@gnu.org>
+
+	* check/3to2.tst, check/add.tst, check/allocai.tst, check/bp.tst,
+	check/call.tst, check/ccall.c, check/clobber.tst, check/divi.tst,
+	check/fib.tst, check/ldsti.tst, check/ldstr-c.tst, check/ldstr.tst,
+	check/ldstxi-c.tst, check/ldstxi.tst, check/ldstxr-c.tst,
+	check/ldstxr.tst, check/lightning.c, check/rpn.tst, check/stack.tst,
+	check/varargs.tst, include/lightning.h,
+	include/lightning/jit_private.h, lib/jit_arm.c, lib/jit_disasm.c,
+	lib/jit_mips.c, lib/jit_note.c, lib/jit_ppc.c, lib/jit_print.c,
+	lib/jit_x86.c, lib/lightning.c:	Extend the "jit_note" abstraction
+	with the new "jit_name" call, that receives a string argument, and
+	should usually be called to mark boundaries of functions of code
+	generating jit (that is, it is not expected that the language
+	generating jit map its functions to jit functions).
+
+2013-01-17 Paulo Andrade <pcpa@gnu.org>
+
+	* check/add.tst, check/allocai.tst, check/bp.tst, check/divi.tst,
+	check/fib.tst, check/lightning.c, include/lightning/jit_arm.h,
+	include/lightning/jit_mips.h, include/lightning/jit_ppc.h,
+	include/lightning/jit_private.h, include/lightning/jit_x86.h:
+	Make JIT_RET, JIT_FRET and JIT_SP private. These should not be
+	used in any operations due to frequently having special
+	constraints (usually JIT_FRET). JIT_FP must be made available
+	because it must be used as the base register to access stack
+	space allocated with jit_allocai.
+
+2013-01-14 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Add an extra align
+	argument to the jit_data call (that should be made private),
+	so that it should not align strings at 8 bytes.
+	  Correct the jit_note call to include the null ending byte
+	when adding label/note names to the "jit data section".
+
+2013-01-11 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_note.c: New file implementing a simple string+integer
+	annotation, that should be used to map filename and line number
+	to offsets in the generated jit.
+
+	* include/lightning.h, lib/lightning.c: Update for the new
+	note code.
+	  Add an extra mandatory argument to init_jit, that is used
+	as argument to bfd_openr.
+	  Change from generic void* to char* the argument to jit_note
+	and add an extra integer argument, to map to filename and
+	line number.
+
+	* check/ccall.c, check/lightning.c, include/lightning/jit_private.h,
+	lib/jit_arm.c, lib/jit_disasm.c, lib/jit_mips.c, lib/jit_ppc.c,
+	lib/jit_print.c, lib/jit_x86.c: lib/Makefile.am: Update for the
+	new annotation code.
+
+	* configure.ac, check/Makefile.am: Update to work with latest
+	automake.
+
+2013-01-09 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/jit_arm.c, jit_mips-fpu.c,
+	lib/jit_mips.c, lib/jit_print.c, lib/jit_x86.c, lib/lightning.c:
+	Remove the jit_code_getarg_{f,d} and jit_code_pusharg{i,r}_{f,d}
+	calls, replacing them with the new, internal only, jit_movr_w_f,
+	jit_mov{r,i}_f_w, jit_movr_ww_d, and jit_mov{i,r}_d_ww, that
+	better describe the operation being done, and allow removing
+	the hackish code to detect special conditions for arm when
+	moving from/to vfp from/to a grp register pair.
+	Rename jit_code_retval_{f,d} to jit_code_x86_retval_{f,d} as
+	it is specific to 32 bit x86, and used to move abi return
+	value in x87 register to a sse register.
+
+2013-01-05 Paulo Andrade <pcpa@gnu.org>
+
+	* check/cccall.c, check/ccall.ok: New test case to validate
+	interleaved calls from/to C code and jit.
+
+	* check/Makefile.am: Update for the new ccall test case.
+
+	* include/lightning.h, lib/lightning.c: Add the new jit_address
+	call that returns the real/final address of a "note" in the
+	generated jit. It requires a jit_node_t as returned by the
+	jit_note call, and is only valid after calling jit_emit.
+	  Add an intermediate solution to properly handle arm
+	soft and softfp modes that move a double to an integer register
+	pair. Currently it just adds extra tests for the condition,
+	but the proper solution should be to have extra lightning
+	codes for these conditions, codes which should be only used
+	by the backends that need it, and merged with the existing
+	jit_pusharg*_{f,d}.
+
+	* include/lightning/jit_private.h: Add new jit_state_t flag
+	to know it finished jit_emit, so that calls to jit_address
+	are valid.
+
+	* lib/jit_mips.c: Correct abi implementation so that the
+	new ccall test case pass. Major problem was using
+	_jit->function.self.arg{i,f} as boolean values, but that
+	would cause lightning.c:patch_registers() to incorrectly
+	assume only one register was used as argument when calling
+	jit_regarg_p(); _jit->function.self.arg{i,f} must be the
+	number of registers used as arguments (in all backends).
+
+	* lib/jit_x86.c: Add workaround, by marking %rax as used,
+	to a special condition, when running out of registers and the
+	allocator trying to spill and reload %rax, but %rax was used
+	as a pointer to a function, what would cause the reload to
+	destroy the return value. This condition can be better
+	generalized, but the current solution is good enough.
+
+	* include/lightning/jit_ppc.h, lib/jit_ppc-cpu.c, lib/jit_ppc.c:
+	Rewrite logic to handle arguments, as the original code was
+	written based on a SysV pdf about the generic powerpc ABI,
+	what did "invent" a new abi for the previous test cases, but
+	failed in the new ccall test in Darwin PPC. Now it properly
+	handles 13 float registers for arguments, as well as proper
+	computation of stack offsets when running out of registers
+	for arguments.
+
+2013-01-02 Paulo Andrade <pcpa@gnu.org>
+
+	* check/float.tst: Correct test case to match ppc also
+	converting positive infinity to 0x7fffffff.
+
+	* lib/jit_arm-swf.c: Correct typos with double underscores.
+
+	* lib/lightning.c: Correct remaining wrong reverse jump logic.
+
+2012-12-29 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Correct both, wrong and confusing logic
+	to compute the reverse of a jump. Now it properly matches
+	C semantics for "eq" (==) and "ne" (!=) and correct computation
+	of reverse of "uneq" as "gt".
+
+	* check/branch.tst: Update "ne" float branch check that
+	previously happened to be wrongly tested with a NaN argument.
+
+2012-12-29 Paulo Andrade <pcpa@gnu.org>
+
+	* check/float.ok, check/float.tst: New test cases implementing
+	extensive validation of float comparison and branch code
+	generation as well as integer conversion, involving NaN and
+	[+-]Inf.
+
+	* lib/jit_arm-swf.c, lib/jit_x86-sse.c, lib/jit_x86-x87.c:
+	Correct bugs found by new float test case.
+
+	* lib/jit_x86.c: Correct cut&paste error added in commit to
+	convert jit_arg* return value to a jit_node_t*,	that would
+	cause it to not properly handle double arguments in ix86.
+
+	* check/Makefile.am: Update for the new test case.
+
+2012-12-28 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c, include/lightning.h, lib/jit_arm.c,
+	lib/jit_mips.c, lib/jit_ppc.c, lib/jit_print.c,	lib/jit_x86.c,
+	lib/lightning.c: Change return value of jit_arg{,_f,_d} to
+	a jit_node_t* object, that should be used as argument to
+	jit_getarg_{c,uc,s,us,i,ui,l,f,d}. This just requires changing
+	from jit_int32_t to jit_pointer_t (or jit_node_t*) the "handle"
+	for the getarg calls, with the benefit that it makes it easy
+	to implement patching of the stack address of non register
+	arguments, this way allowing to implement variable size stack
+	frames if applicable; useful if there are too many registers and
+	jit functions uses only a few callee save registers.
+
+2012-12-27 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c, lib/jit_mips-cpu.c, lib/jit_mips.c: Correct
+	regressions when patching jit_calli for a forward function.
+
+	* lib/jit_ppc-cpu.c: Correct wrong arguments to ANDI opcode
+	in jit_getarg_u{c,s} implementation.
+
+2012-12-23 Paulo Andrade <pcpa@gnu.org>
+
+	* check/call.ok, check/call.tst: New test cases to validate
+	simple typed argument and return values in function calls.
+
+	* check/lightning.c: Properly handle jit_movi of labels for
+	backward and forward code labels.
+
+	* check/Makefile.am: Update for new test case.
+
+2012-12-23 Paulo Andrade <pcpa@gnu.org>
+
+	* check/carry.ok, check/carry.tst: New test case to validate
+	carry condition handling.
+
+	* check/Makefile.am: Update for new test case.
+
+2012-12-22 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc.c: Implement logic for
+	jit_htonr for big endian, so that ppc (big endian) pass the
+	new clobber.tst test case.
+
+2012-12-22 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm.c: Correct use of wrong argument offset
+	variable in armv7l or float/double argument for varargs
+	function in armv7hl.
+	  Correct jit_getarg* logic in software float mode to
+	match expected behavior in other backends, that is, if
+	a function is not called, it is safe to use a few lightning
+	calls before a next jit_getarg* call, as done in the test
+	case check/stack.tst. The proper solution should be to
+	extend the parser in lib/lightning.c to check if there is
+	some float operation that will call some (libgcc?) function,
+	but software float arm should be a very uncommon backend for
+	lightning, so, just load the already in place arguments
+	saved to stack, assuming the register argument was clobbered
+	(what should not be the case most times...).
+
+2012-12-22 Paulo Andrade <pcpa@gnu.org>
+
+	* check/clobber.ok, check/clobber.tst: New test case doing
+	extensive validation tests to ensure registers not used in
+	a operation are not clobbered.
+
+	* check/Makefile.am: Update for new test case.
+
+2012-12-21 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/lightning.c: Partially rewrite/revert code to compute
+	initial	register live state at the start of a basic block.
+	The original logic was corrupted when adding optimizations
+	to do as few computations as possible in jit_update. The
+	reglive field must be always a known set of live registers
+	at the start of a basic block. The value that was incorrect
+	was the regmask field, that must be the set of registers
+	that are in unknown state, because they are not known live,
+	neither set (or possibly not set) in the basic block, and
+	*must* store the state at the start of the basic block.
+
+2012-12-20 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_ppc.h: Correct mismatch of JIT_F{1,5}
+	with enum codes, that were correct, and returned by jit_f().
+
+	* lib/jit_ppc-cpu.c, lib/jit_ppc-fpu.c, lib/jit_ppc.c: Properly
+	implement and better describe values when generating stack
+	frames.
+
+2012-12-18 Paulo Andrade <pcpa@gnu.org>
+
+	* check/stack.ok, check/stack.tst: New files to test data
+	integrity on a deep chain of stack frames.
+
+	* lib/jit_arm.c, lib/jit_arm-cpu.c, lib/jit_mips.c,
+	lib/jit_mips-cpu.c, lib/jit_ppc.c, lib/jit_ppc-cpu.c,
+	lib/jit_x86.c, lib/jit_x86-cpu.c: Calculate _jit->function->stack
+	in the emit stage, otherwise it will calculate it wrong if
+	need to jit_allocai space to spill registers.
+
+	* lib/lightning.c: Correct wrong offset when updating the
+	"current" jit function pointer in the code that may need to
+	allocate stack space to spill registers.
+
+	* check/lightning.c: Correct off by one data space check.
+
+	* check/Makefile.am: Update for new test case.
+
+2012-12-17 Paulo Andrade <pcpa@gnu.org>
+
+	* check/fop_abs.ok, check/fop_abs.tst, check/fop_sqrt.ok,
+	check/fop_sqrt.tst: New files implementing simple test cases
+	for the extra float operations.
+
+	* check/Makefile.am: Update for new test cases.
+
+	* check/alu.inc: Add an extra macro to check for unordered
+	equality on tests where it is expected to use NaN as an
+	argument.
+
+	* check/lightning.c: Minor change for proper/common argument
+	syntax handling ommiting arguments to options.
+
+2012-12-17 Paulo Andrade <pcpa@gnu.org>
+
+	* check/Makefile.am: Automatically generate pattern list
+	of tests with alternate jit generation options. This should
+	prevent typos and needing to change multiple places after
+	a change.
+
+2012-12-14 Paulo Andrade <pcpa@gnu.org>
+
+	* check/lightning.c: Remove the ".cpu name value" syntax,
+	as it was not able to do proper changes before the jit
+	internal data structure was initialized. Now it supports
+	several getopt options to force using different jit
+	generation options, effectively replacing the previous
+	syntax.
+
+	* check/run-test: Add simple extra logic to handle differently
+	named test scripts, used to test things like x87 coprocessor
+	in ix86, and arm instruction set or software float in armv7l.
+
+	* configure.ac: Add some AC_RUN_IFELSE calls to figure at
+	compile time if can test different code generation options,
+	and update Makefile generation accordingly.
+
+	* check/Makefile.am, lib/jit_arm.c, lib/jit_x86.c: Update to
+	properly work with the test tool updating the jit_cpu global
+	information.
+
+	* check/check.arm.sh, check/check.swf.sh, check/check.x87.sh:
+	New wrapper files passing -mthumb=0, mvfp=0 and -mx87=1 to
+	the test tool, if applicable, so that it can validate alternate
+	code generation options on test hosts that support them.
+
+2012-12-14 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-x87.c, lib/jit_x86.c: Correct test cases in ix86
+	when using the x87 coprocessor instead of sse2+.
+
+2012-12-14 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, include/lightning/jit_private.h,
+	lib/jit_arm.c, lib/jit_mips.c, lib/jit_ppc.c, lib/jit_x86.c,
+	lib/lightning.c: Make jit_ellipsis implementation not
+	backend specific. It is not intended to handle va_list
+	like objects at runtime, as jit_arg* and jit_getarg*
+	return constant values resolved at parse time, so, effectively
+	it is not possible to create printf like jit functions, as
+	there is no va_start, va_arg, va_end, etc, abstraction. This
+	limitation should be kept for the sake of making new ports
+	easier.
+
+2012-12-14 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/lightning.c: Add two extra wrapper
+	functions to avoid need for excess pointer to/from word casts.
+
+	* check/lightning.c: Only need for pointer to/from word cast
+	now is jit_movi, update accordingly.
+
+2012-12-13 Paulo Andrade <pcpa@gnu.org>
+
+	* check/varargs.ok, check/varargs.tst: New test cases implementing
+	simple varargs calls with a large amount of arguments to exercise
+	excess arguments on stack.
+
+	* include/lightning.h: Include config.h if HAVE_CONFIG_H is
+	defined.
+
+	* lib/jit_arm.c: Allocate a fpr register, not a gpr one for
+	temporary when pushing varargs arguments in the stack.
+
+	* lib/jit_arm-swf.c: Correct code changing the wrong offset
+	in jit_absr_d and jit_negr_d in software float.
+
+	* lib/jit_mips.c: Correct calculation of offsets of arguments
+	on stack.
+
+	* lib/jit_ppc.c: Correct bogus logic for "next" offset of arguments
+	on stack and adjust for fixed offset of stack arguments.
+
+2012-12-12 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning.h, lib/jit_arm.c, lib/jit_mips.c,
+	lib/jit_ppc.c, lib/jit_x86.c, lib/lightning.c: Change jit_prepare
+	to no longer receive an argument. If receiving an argument, it
+	should be an ABI specifier, not a boolean if varargs or not,
+	and add the new jit_ellipsis call, to specify where the
+	ellipsis is in the C prototype of the function being called.
+	Note that currently it is not supported to define varargs
+	functions and it will be ignored if calling jit_ellipsis not
+	in a prepare/finish* block, but this should be addressed.
+
+	* check/allocai.tst, check/alu_add.tst, check/alu_and.tst,
+	check/alu_com.tst, check/alu_div.tst, check/alu_lsh.tst,
+	check/alu_mul.tst, check/alu_neg.tst, check/alu_or.tst,
+	check/alu_rem.tst, check/alu_rsh.tst, check/alu_sub.tst,
+	check/alu_xor.tst, check/alux_add.tst, check/alux_sub.tst,
+	check/bp.tst, check/branch.tst, check/cvt.tst, check/divi.tst,
+	check/fib.tst, check/ldsti.tst, check/ldstr-c.tst,
+	check/ldstr.tst, check/ldstxi-c.tst, check/ldstxi.tst,
+	check/ldstxr-c.tst, check/ldstxr.tst, check/rpn.tst,
+	check/lightning.c: Update for the change to jit_prepare and
+	addition of jit_ellipsis.
+
+2012-12-11 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc-cpu.c: Make movr a function that checks arguments
+	so that other code can safely assume it is a noop if src and dst
+	are the same register.
+	  Implement rem{r,i}{,_u} as a div{,u}/mul/sub.
+	  Correct ANDIS, ORIS and XORIS calls to cast the argument to
+	unsigned before the shift to avoid an assertion if the argument
+	had the topmost bit set.
+	  Implement lshi, rshi and rshi_u as functions to test for a
+	zero argument, that would otherwise trigger an assertion when
+	computing the shift value.
+	  Do a simple implementation of bm{s,c}{r,i} with a temporary,
+	"andr" of arguments and jump based on comparison with zero.
+	  Correct typo in ldxi_c.
+
+	* lib/jit_ppc-fpu.c: Correct wrong arguments to FDIV* and STF*.
+
+	* lib/jit_ppc.c: Correct wrong check for 6 instead of 8 integer
+	arguments in registers. If calling a varargs function and
+	passing a float or double argument, also either store the
+	value in the stack or in integer registers, as varargs functions
+	do not fetch it from float registers.
+	  Add "case" for new functions and incorrectly missing ones.
+	  Call libgcc's __clear_cache, that should know what to do
+	if the hardware needs flushing cache before execution.
+
+	* lib/lightning.c: Do a simple/trivial logic in jit_regset_scan1,
+	that should make it easier for the compiler to optimize it, and
+	that also corrects the previously wrong code for big endian, and
+	that was causing problems in ppc due to not saving all callee save
+	registers as it was not "finding" them in the regset due to the
+	little endian assumption bug.
+
+2012-12-11 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac: Only default to using the builtin disassembler
+	if on GNU/Linux. This should be temporary, due to requiring
+	/proc/self/exe.
+	  Correctly check $target_cpu for powerpc.
+
+	* include/lightning/jit_ppc.h: Correctly implement jit_v_num.
+
+	* include/lightning/jit_private.h: Declare proper prototype
+	for jit_init_debug and jit_finish_debug.
+
+	* lib/jit_ppc-cpu.c: Remove code to save/restore callee save
+	float registers, as it is not required since those float
+	registers are not usable currently.
+	  Change prolog and epilog generation to, at least comparing
+	code, match what gcc generates in "gcc -O0", but it is still
+	failing in Darwin PPC, apparently due to the __clear_cache
+	call not being enough, as frequently it will also fail to
+	execute, and the code buffer is all zeroes.
+
+	* lib/lightning.c: Do not fail in jit_regset_scan1 calls due
+	to passing 64 as argument on computers with 64 registers.
+
+2012-12-10 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-cpu.c: Correct all current test cases.
+	  Call the "xori" not the "XORI" macro for jit_xori implementation,
+	as the XORI macro handles only 16 bit unsigned values.
+	  Call the "movr" macro, not the "movi" macro in the special
+	case of adding or subtracting zero.
+	  Use the proper temporary register in the jit_andr implementation.
+
+2012-12-09 Paulo Andrade <pcpa@gnu.org>
+
+	* check/alu.inc, check/alu_add.ok, check/alu_add.tst,
+	check/alu_and.ok, check/alu_and.tst, check/alu_com.ok,
+	check/alu_com.tst, check/alu_div.ok, check/alu_div.tst,
+	check/alu_lsh.ok, check/alu_lsh.tst, check/alu_mul.ok,
+	check/alu_mul.tst, check/alu_neg.ok, check/alu_neg.tst,
+	check/alu_or.ok, check/alu_or.tst, check/alu_rem.ok,
+	check/alu_rem.tst, check/alu_rsh.ok, check/alu_rsh.tst,
+	check/alu_sub.ok, check/alu_sub.tst, check/alu_xor.ok,
+	check/alu_xor.tst, check/alux_add.ok, check/alux_add.tst,
+	check/alux_sub.ok, check/alux_sub.tst, check/branch.ok,
+	check/branch.tst: New test cases for arithmetic and branch
+	tests.
+
+	* check/Makefile.am: Update for new test cases.
+
+	* include/lightning/jit_private.h: Make the jit_reg_free_p
+	macro shared by all backends. Previously was added for the
+	arm backend, but is useful in the x86_64 backend when checking
+	state of "special purpose register".
+	Also add the new jit_class_named register class, that must be
+	or'ed with the register value if calling jit_get_reg expecting
+	an specific value, because the specific register value may be
+	zero, that previously was treated as no register requested.
+
+	* lib/jit_arm-cpu.c: Correct argument order for T2_MVN.
+
+	* lib/jit_arm-swf.c: Call the proper function for double
+	divide. The "software float" implementation just calls
+	libgcc functions.
+
+	* lib/jit_arm.c: Return float/double values in the float
+	register if using the hard float ABI.
+
+	* lib/jit_x86-cpu.c: Change the can_sign_extend_int_p macro
+	to not include -0x80000000L, because there is code that
+	"abuses" it and thinks it can negate the immediate value
+	after calling that macro.
+	  Correct implementation of jit_subi that had a wrong code
+	patch logic doing subtraction with reversed arguments.
+	  Correct REX prefix calculation in the jit_muli implementation.
+	  Correct logic to get/unget %*ax and %*dx registers in divremr
+	and divremi.
+	  Correct divremi that was using the symbolic, unique %*ax
+	value in on place (not using the _REGNO name suffix).
+	  Correct cut&paste error causing it to use "xor" instead of
+	"or" in one code path of the jit_ori implementation.
+	  Correct several flaws when clobbering registers and/or when
+	one of the arguments was %*cx in the rotshr wrapper function
+	implementing most shift operations.
+
+	* lib/lightning.c: No longer expect that the backend be smart
+	enough to know what to do when asking for a named register
+	if that register is already an argument or is live. It fails
+	if it is an argument, or if register is live, fails if cannot
+	spill.
+	  No longer incorrectly assume that eqr_{f,d} and ltgr_{f,d} are
+	safe to inverse value tests in jump thread optimization.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* check/Makefile.am, check/cvt.ok, check/cvt.tst: Add new
+	"cvt" test case to test conversion from/to int/float types.
+
+	* check/lightning.c: Only define truncr_{f,d}_l in 64 bit mode.
+
+	* include/lightning.h: Correct typo that caused it to define
+	jit_truncr_{f,d}_l in 32 bit mode.
+
+	* lib/jit_arm-cpu.c: Avoid assertion failure in the signed/unsigned
+	extend opcodes generation as it shares an interface for 3 argument
+	opcode generation.
+
+	* lib/jit_x86-cpu.c: Correct wrong argument passed to
+	jit_unget_reg in the andi implementation and wrong byte
+	unsigned extend code generation.
+
+	* lib/jit_x86-sse.c: Correct conversion from "word" to float or
+	double as is dependent on wordsize.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* check/ldstr-c.ok, check/ldstr-c.tst, check/ldstxi-c.ok,
+	check/ldstxi-c.tst, check/ldstxr-c.ok, check/ldstxr-c.tst:
+	New test case files testing load clobbering the base and/or
+	index register;
+
+	* check/ldst.inc: New file with common definition for all the
+	ldst* test cases.
+
+	check/Makefile.am, check/ldsti.tst, check/ldstr.tst,
+	check/ldstxi.tst, check/ldstxr.tst: Update for new common
+	definitions file and new register clobber ldst tests.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-fpu.c: Correct wrong register order in stxr_{f,d}
+	in the mips backend.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_arm-vfp.c: Correct regression found in armv7l with
+	latest test cases.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* check/ldstxi.tst, check/ldstxr.tst: Correct wrong argument
+	order for 32 bit mode tests.
+
+	* configure.ac: Correct check for ix86 target_cpu.
+
+2012-12-05 Paulo Andrade <pcpa@gnu.org>
+
+	* check/ldstr.ok, check/ldstr.tst, check/ldsti.ok,
+	check/ldsti.tst, check/ldstxr.ok, check/ldstxr.tst,
+	check/ldstxi.ok, check/ldstxi.tst:
+	New test case files exercising a very large amount of
+	register combinations to verify load/store implementation.
+
+	* check/Makefile.am: Update for new test cases.
+
+	* lib/jit_x86-cpu.c: Correct wrong argument order when
+	computing REX prefix for {ld,st}r_T codes;
+
+2012-12-04 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_mips-fpu.c, lib/jit_mips.c: Implement missing mips
+	jit_sqrtr_{f,d} codes.
+
+	* check/all.tst, include/lightning.h, lib/jit_print.c: Change
+	declaration order and call order in all.tst of {add,sub}c and
+	{add,sub}x. *c must be called before to set the carry and *x
+	second to use the carry and keep it set. The wrong call order
+	was causing all.tst to fail in mips, where a register is
+	allocated to keep a global carry state.
+
+2012-12-04 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_mips.h, lib/jit_mips-cpu.c,
+	lib/jit_mips-fpu.c, lib/jit_mips.c: Correct float/double
+	argument handling and make the mips backend pass the initial
+	test cases.
+
+	* include/lightning.h, ib/jit_print.c, lib/lightning.c:
+	Add extra enum values for argument handling functions that
+	could not be abstracted to the current codes, that is, when
+	float values need to move from/to gpr from/to fpr. It would
+	be more tempting to add such primitives, but they would have
+	wordsize limitations, and it is not expected to add codes
+	with one gpr argument for 64 bit and two for 32 bit.
+
+	* lib/jit_ppc.c: Check _jit->function before calling jit_epilog()
+	to avoid a runtime exception.
+
+2012-12-04 Paulo Andrade <pcpa@gnu.org>
+
+	* include/lightning/jit_mips.h, lib/jit_mips.c: Update to
+	make the mips backend compile in a qemu image.
+
+	* lib/jit_ppc.c: Minor adaptations to help in having the
+	ppc backend compilable.
+
+2012-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, include/lightning/jit_private.h, lib/jit_arm-cpu.c,
+	lib/jit_arm-swf.c, lib/jit_arm.c, check/Makefile.am: Correct
+	implementation of the arm backend port to build and pass the
+	current test cases. Tested on armv7 with softfp abi.
+
+	* lib/jit_disasm.c: Rename and change prototype of static
+	disassemble function as in the arm backend it is required
+	to access state information stored in the jit_state_t object.
+
+	* check/3to2.tst, check/add.tst: Correct test case code assuming
+	JIT_RO and JIT_RET are the same, and even if they are the same,
+	the logic was incorrect because it must always call jit_retval*
+	to fetch a function call return before any other instruction.
+	The arm backend hash a special condition if jit_retval is not
+	called, because "r0" is not JIT_R0, but is JIT_RET and *also*
+	the first argument for a called function, so JIT_RET must be
+	only used as an argument to jit_retval.
+
+2012-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* check/all.tst, check/lightning.c: Only declare or use 64 bit
+	interfaces on 64 bit builds.
+
+	* check/fib.tst: Use simpler logic to not need preprocessor
+	conditionals for 32 or 64 bit.
+
+	* include/lightning.h: Only declare 64 bit macros on a 64 bit
+	build. Code using lightning must know about wordsize and the
+	jit generation limitations, also, this way it generates a
+	compile time failure, not a runtime assertion.
+
+	* include/lightning/jit_x86.h: Correct typo in macro name.
+
+	* lib/jit_arm.c, lib/jit_arm-cpu.c, lib/jit_mips.c,
+	lib/jit_mips-cpu.c, lib/jit_ppc.c, lib/jit_ppc-cpu.c, 
+	lib/jit_x86.c, lib/jit_x86-cpu.c: Correct wrong code to get
+	current jit function pointer.
+
+	* lib/lightning.c: Move call to the simplify() optimization
+	to after register liveness is known. Previous code did work
+	by accident but now with proper test cases the problem was
+	noticed.
+
+	* lib/jit_disasm.c: Always cast bfd_vma to long long when
+	passing it as printf argument.
+
+2012-12-03 Paulo Andrade <pcpa@gnu.org>
+
+	* configure.ac, check/Makefile.am, check/check.sh,
+	doc/Makefile.am, include/lightning/Makefile.am,
+	lib/Makefile.am: Correct make distcheck.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_ppc.c: Assign copyright ownership to FSF.
+
+	* lib/jit_x86-cpu.c: Correct integer multiplication that was
+	generating code with reversed register arguments.
+
+	* check/rpn.ok, check/rpn.tst: New test case file.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lib/jit_x86-cpu.c, lib/jit_x86-sse.c, lib/jit_x86-x87.c:
+	Actually change copyright owner to FSF as avertised.
+
+	*  lib/jit_arm-cpu.c,  lib/jit_arm-swf.c,
+	lib/jit_arm-vfp.c, lib/jit_arm.c,
+	lib/jit_mips-cpu.c, lib/jit_mips-fpu.c, lib/jit_mips.c,
+	lib/jit_ppc-cpu.c, lib/jit_ppc-fpu.c, lib/jit_ppc.c: New
+	files implementing initial code different jit backends.
+
+	* include/lightning/jit_private.h: Add extra field to the
+	private jit_patch_t type, required by the arm port.
+
+	* lib/Makefile.am: Update for the new backend implementation
+	files.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* check/Makefile.am: Add proper "make clean" rule and missing
+	check.sh to EXTRA_DIST.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* .gitignore: Update pattern of ignored files.
+
+	* check/Makefile.am: Add rule to build liblightning.la dependency
+	in case of running "make check" before building the library.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* lightning/Makefile.am, lightning/asm-common.h,
+	lightning/core-common.h, lightning/fp-common.h,
+	lightning/funcs-common.h, lightning/i386/Makefile.frag,
+	lightning/i386/asm-32.h, lightning/i386/asm-64.h,
+	lightning/i386/asm.h, lightning/i386/core-32.h,
+	lightning/i386/core-64.h, lightning/i386/core.h,
+	lightning/i386/fp-32.h, lightning/i386/fp-64.h,
+	lightning/i386/fp.h, lightning/i386/funcs.h,
+	lightning/ppc/asm.h, lightning/ppc/core.h,
+	lightning/ppc/fp.h, lightning/ppc/funcs.h,
+	lightning/sparc/asm.h, lightning/sparc/core.h,
+	lightning/sparc/fp.h, lightning/sparc/funcs.h:
+	Removed. The core logic is used in the new code, and new mips
+	and arm ports will be added. At first, sparc will not be
+	supported as it has not yet been ported to the new engine.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+
+	* tests/Makefile.am, tests/3to2.c, tests/3to2.ok, tests/add.c,
+	tests/add.ok, tests/allocai.c, tests/allocai.ok, tests/bp.c,
+	tests/bp.ok, tests/divi.c, tests/divi.ok, tests/fib.c, tests/fib.ok,
+	tests/fibdelay.c, tests/fibdelay.ok, tests/fibit.c, tests/fibit.ok,
+	tests/funcfp.c, tests/funcfp.ok, tests/incr.c, tests/incr.ok,
+	tests/ldst.c, tests/ldst.ok, tests/ldxi.c, tests/ldxi.ok,
+	tests/modi.c, tests/modi.ok, tests/movi.c, tests/movi.ok,
+	tests/printf.c, tests/printf.ok, tests/printf2.c, tests/printf2.ok,
+	tests/ret.c, tests/ret.ok, tests/rpn.c, tests/rpn.ok, tests/rpnfp.c,
+	tests/rpnfp.ok, tests/sete.c, tests/sete.ok, tests/testfp.c,
+	tests/testfp.ok, tests-run-test: Removed previous test suite, in
+	favor of a newer one in the check subdirectory.
+
+	* check/3to2.ok, check/3to2.tst, check/add.ok, check/add.tst,
+	check/allocai.ok, check/allocai.tst, check/bp.ok, check/bp.tst,
+	check/divi.ok, check/divi.tst, check/fib.ok, check/fib.tst:
+	New sample input for the new test program, loosely matching
+	several of the previous test cases.
+
+	* check/Makefile.am: New test suite makefile.
+
+	* check/check.sh, check/run-test: New wrapper files for the
+	new test suite.
+
+	* check/lightning.c: New file. The main driver of the new test
+	suite, that compiles to a parser of a very simple assembly like
+	language, generates jit and executes it.
+
+	* check/all.tst: New file. A generic debug and sample test file
+	with a directive to prevent it from being executed, and useful to
+	read disassembly of all possible instructions, using a fixed set
+	of registers.
+
+	* include/Makefile.am, include/lightning.h,
+	include/lightning/Makefile.am, include/lightning/jit_arm.h,
+	include/lightning/jit_mips.h, include/lightning/jit_ppc.h,
+	include/lightning/jit_private.h, include/lightning/jit_x86.h,
+	lib/Makefile.am, lib/jit_disasm.c, lib/jit_print.c,
+	lib/jit_x86-cpu.c, lib/jit_x86-sse.c, lib/jit_x86-x87.c,
+	lib/jit_x86.c, lib/lightning.c: New files. These files are
+	written from scratch, only by <pcpa@gnu.org>, and have now
+	copyright assignment to the FSF. This is the core of the new
+	lightning rework. Previously it was integrated in code with
+	a garbage collector and several custom types like vectors and
+	hash tables, so this first code merge with lightning converts
+	that code into a library extracting only the jit bits, and at
+	first only for x86_64 GNU/Linux.
+
+	* lightning.h, m4/lightning.m4: Removed. These are no longer
+	required in the new lightning code.
+
+	.gitignore, Makefile.am, configure.ac: Update for the new
+	lightning code.
+
+2012-12-02 Paulo Andrade <pcpa@gnu.org>
+	* .cvsignore: Removed for extra cleanup.
+
+	* build-aux: Rename directory to m4.
+
+	* m4: Renamed to "default" name and for consistency with merge
+	with code rework to be imported in lightning.
+
+	* .gitignore, configure.ac, Makefile.am, doc/Makefile.am:
+	Update for build-aux to m4 rename.
+
+2012-12-01 Paulo Andrade <pcpa@gnu.org>
+
+	* opcode/Makefile.am, opcode/Makefile.in, opcode/ansidecl.h,
+	opcode/bfd.h, opcode/dis-asm.h, opcode/dis-buf.c, opcode/disass.c,
+	opcode/i386-dis.c, opcode/i386.h, opcode/ppc-dis.c, opcode/ppc-opc.c,
+	opcode/ppc.h, opcode/sparc-dis.c, opcode/sparc-opc.c, opcode/sparc.h,
+	opcode/sysdep.h: Removed. Do not bundle GNU binutils files.
+
+	* aclocal.m4, configure, Makefile.in, config.h.in, doc/Makefile.in,
+	lightning/Makefile.in, tests/Makefile.in: Removed. Do not maintain
+	autogenerated files that also generate too much diff noise when
+	regenerated in git.
+
+	* build-aux/help2man, build-aux/texinfo.tex, build-aux/texi2dvi:
+	Removed. Buildenvironment must have an up to date version from
+	upstream installed.
+
+	* build-aux/config.guess, build-aux/config.sub, build-aux/depcomp,
+	build-aux/install-sh build-aux/mdate-sh build-aux/missing: Removed.
+	Do not maintain a copy of automake files in git. Release tarballs
+	must use an up to date version.
+
+	* lightningize.in, doc/lightningize.1: Removed. Do not encourage
+	bundling lightning in other packages. It should use a system package
+	or a proper thirdy part subdirectory.
+
+	* INSTALL: Removed. Autoreconf removes it and creates a symlink
+	when regenerating files, so, avoid conflicts in git and let
+	automake create the symlink.
+
+	* .gitignore: Add INSTALL and autogenerated files.
+
+	* configure.ac, Makefile.am: Update for removal of opcode subdir,
+	auto generated files and lightningize.
+
+	* tests/Makefile.am, tests/3to2.c, tests/add.c, tests/bp.c,
+	tests/fib.c, tests/fibdelay.c, tests/fibit.c, tests/funcfp.c,
+	tests/incr.c, tests/printf.c, tests/rpn.c, tests/rpnfp.c,
+	tests/sete.c, tests/testfp.c: Update for removal of opcode subdir.
+
+	* doc/Makefile.am: Update for removal of lightningize.
+
+	* configure.ac, lightning/ppc/funcs.h, lightning/sparc/funcs.h,
+	lightning/i386/fp.h, lightning/i386/core.h, lightning/i386/asm.h,
+	tests/3to2.c, tests/add.c, tests/bp.c, tests/fib.c, tests/fibdelay.c,
+	tests/fibit.c, tests/funcfp.c, tests/incr.c, tests/printf.c,
+	tests/rpn.c, tests/rpnfp.c, tests/sete.c, tests/testfp.c:
+	Remove LIGHTNING_CROSS, it is half supported and incomplete.
+
+	* tests/3to2.c, tests/funcfp.c, tests/rpnfp.c: Remove preprocessor
+	check on JIT_FPR. If no hardware registers are available, the backend
+	must provide an alternative for software float.
+
+	* lightning/ppc/core.h, lightning/sparc/core.h, tests/Makefile.am:
+	Remove JIT_NEED_PUSH_POP. It is absolutely not trivial to implement
+	properly on some backends due to stack alignment constraints, and
+	whenever it is required, using jit_allocai and using a properly
+	aligned stack vector, or a heap buffer, is better.
+
+	* tests/push-pop.c, tests/push-pop.ok: Removed due to
+	JIT_NEED_PUSH_POP no longer available.
+
+2011-02-28  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Add jit_add{c,x}{i,r}_l, jit_mulr_{l,ul}_,
+	fix jit_mul{i,r}_{l,ul}.
+
+2010-08-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-64.h: Return patch address from jit_bXYr_{f,d}.
+	Reported by Paulo César Pereira de Andrade.
+	* lightning/ppc/fp.h: Likewise.
+	* lightning/sparc/fp.h: Implement FP branches.
+
+2010-08-18  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-64.h: Fix jp in jit_bner_{f,d}.
+
+2010-08-18  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-32.h: Fix -D_ASM_SAFETY compilation.
+	Reported by Paulo César Pereira de Andrade.
+
+2010-08-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/ldst.c: Update.
+	* tests/Makefile.am: Use -ffloat-store to compile it.
+
+2010-08-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h (jit_ldr_c, jit_ldxr_c, jit_ldr_s,
+	jit_ldxr_s): Move...
+	* lightning/i386/core-32.h: ... here.
+	* lightning/i386/core-64.h (jit_ldr_c, jit_ldxr_c, jit_ldr_s,
+	Use movsbq and movswq.
+
+2010-08-10  Paulo César Pereira de Andrade <pcpa@mandriva.com.br>
+
+	* lightning/i386/core-32.h (jit_replace): Use MOVLrr, not MOVLir.
+	(jit_movbrm): Check index register as well.
+	* lightning/i386/fp-64.h: Add jit_extr_f_d and jit_extr_d_f.
+	* lightning/fp-common.h: Add jit_extr_f_d and jit_extr_d_f.
+
+2010-07-28  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/Makefile.am: Add ldst test.
+	* tests/Makefile.in: Regenerate.
+	* tests/ldst.c: New.
+	* tests/ldst.ok: New.
+
+2010-07-28  Paolo Bonzini  <bonzini@gnu.org>
+
+	* THANKS: Add Paulo Cesar Pereira de Andrade.
+	* doc/porting.texi: Fix ordering of arguments in jit_stxi.
+	* lightning/i386/core-32.h (jit_replace): Remove cmp argument.
+	* lightning/i386/fp-64.h (jit_movi_f): Fix.
+
+2010-07-26  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-32.h (jit_replace): Move here (removed
+	2009-03-01).
+
+2010-07-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* build-aux/lightning.m4: Always set and replace lightning_frag.
+	* Makefile.in: Regenerate.
+	* aclocal.m4: Regenerate.
+	* config.h.in: Regenerate.
+	* configure: Regenerate.
+	* doc/Makefile.in: Regenerate.
+	* doc/lightningize.1: Regenerate.
+	* doc/version.texi: Regenerate.
+	* lightning/Makefile.in: Regenerate.
+	* opcode/Makefile.in: Regenerate.
+	* tests/Makefile.in: Regenerate.
+
+2009-03-01  Paolo Bonzini  <bonzini@gnu.org>
+
+        * lightning/i386/core-64.h: Use Mike's macros for x86-64 too.
+        * lightning/i386/core.h: Remove jit_replace.
+
+	2009-02-27  Mike Spivey  <mike@comlab.ox.ac.uk>
+
+        * lightning/i386/core.h: Rewrite shift-handling macros.
+        * lightning/fp-common.h: Fix jit_extr_{f_d,d_f}.
+
+2009-02-17  Mike Spivey  <mike@comlab.ox.ac.uk>
+
+	* lightning/i386/core.h: Fix blunder in operand order.
+
+2009-02-17  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-32.h: Another fix to jit_fp_btest.
+
+2009-02-17  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/fp-common.h: Define double branches if missing.
+	* lightning/i386/asm.h: Define JC and JNC mnemonics.
+	* lightning/i386/fp-32.h: Fix jit_fp_btest.  All reported
+	by Mike Spivey.
+
+2008-10-09  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h (jit_flush_code): Subtract 1 from end.
+	Reported by Eli Barzilay and Matthew Flatt.
+
+2008-08-23  Nix  <nix@esperi.org.uk>
+
+	* lightning/i386/Makefile.frag: fp-32.h and fp-64.h are target files.
+
+2008-07-02  Laurent Michel  <ldm@engr.uconn.edu>
+
+	* lightning/ppc/funcs.h (jit_flush_code): modified the computation
+	of start/end. The pointer arithmetic was done without casting. It
+	prevented compilation with recent gcc versions. 
+	* lightning/ppc/core.h (jit_pushr_i): The offset for the store was
+	incorrect. Should have been 4 bytes below SP (not above).
+	* lightning/ppc/core.h (jit_popr_i): The offset for the load was 
+	incorrect. Should have been 0 (not +8). 
+
+2008-06-17  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-64.h: Forward IMULQir to IMULQirr,
+	fix REXQ order for IMULQirr.
+
+2008-06-17  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: Fix _rN vs. _rR.
+
+2008-06-16  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: Use jit_save in jit_replace.  Move JIT_R
+	definition...
+	* lightning/i386/core-32.h: ... here; define jit_save so that
+	the core.h has no effect on the 32-bit backend.
+	* lightning/i386/core-64.h: Place JIT_R1/JIT_R2 in R10/R11,
+	place outgoing arguments in the right spot from the beginning,
+	define jit_save, fix jit_reg8/jit_reg16.
+
+2008-06-15  Paolo Bonzini  <bonzini@gnu.org>
+
+        * lightning/i386/core-64.h: Rewrite argument passing to
+	support up to 6 arguments and generate less code.
+
+2008-06-14  Laurent Michel  <ldm@thorgal.homelinux.org>
+
+	* lightning/i386/core-64.h (jit_movi_l): When the operand is 0,
+	the XOR should be on a quadword.
+	* lightning/i386/core-64.h (jit_prolog): Keep 16-byte stack
+	alignment.
+	(jit_ret): Always use LEAVE.
+
+2008-06-13  Laurent Michel  <ldm@thorgal.homelinux.org>
+
+	* lightning/i386/core-64.h: Add (void) casts for C++ compatibility.
+	* lightning/i386/asm.h: Likewise.
+
+2008-06-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: Move JIT_V definition...
+	* lightning/i386/core-32.h: ... here.
+	* lightning/i386/core-64.h: ... and here.  Avoid dancing between
+	RSI/RDI and R12/R13, and place JIT_V1/JIT_V2 in R12/R13.
+
+2008-06-11  Paolo Bonzini  <bonzini@gnu.org>
+
+	* build-aux/lightning.m4: Adjust LIGHTNING_BACKENDS, don't
+	use suffix support to distinguish i386/x86_64.
+	* lightning/i386/Makefile.frag: Use LIGHTNING_TARGET_FILES
+	to distribute *-32.h and *-64.h files now.
+	* lightning/i386/asm-i386: Moved to...
+	* lightning/i386/asm.h: Include the appropriate subtarget file.
+	* lightning/i386/core-i386: Moved to...
+	* lightning/i386/core.h: Include the appropriate subtarget file.
+	* lightning/i386/fp.h: New, include the appropriate subtarget file.
+	* lightning/i386/asm-32: Do not include asm-i386.h.
+	* lightning/i386/asm-64.h: Likewise.
+	* lightning/i386/core-32: Do not include core-i386.h.
+	* lightning/i386/core-64.h: Likewise.
+	* lightning/Makefile.am: Adjust for renamed files.
+
+	* configure.ac: Define LIGHTNING_TARGET here.
+	* opcode/disass.c: Change list of valid LIGHTNING_TARGET values.
+
+	* lightningize.in: Robustify against missing subtarget files.
+
+2008-06-11  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-32.h: Use MOVLir instead of jit_movi_l
+	to implement jit_movi_p.
+
+2008-06-11  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-32.h: Use separate __APPLE__ and SysV
+	prolog/ret macros.  Subtract 12 bytes in __APPLE__ case to
+	keep stack aligned, and always use LEAVE in the epilog.
+
+2008-06-11  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-i386.h: Fix C++ incompatibility.
+
+2008-06-10  Laurent Michel  <ldm@engr.uconn.edu>
+
+	* lightning/i386/core-i386.h: Fix jit_replace8 for
+	case when one of the operands is _EAX.
+
+2008-05-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/run-test: Avoid CRLF issues on mingw.
+
+2008-03-21  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Fix jit_{ld,st}{,x}i_{i,l}.
+	Remove jit_ld{,x}i_ul.
+	* lightning/core-common.h: Make jit_ld{,x}{i,r}_ul
+	always a synonym of the _l variant.
+	* doc/porting.texi: Document this.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Fix uses of jit_qop_.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Add boolean operations.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-64.h: Add LEAQmr.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Misc bugfixes.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-i386.c: Remove jit_ldr_i, jit_ldxr_i.
+	* lightning/i386/core-32.h: Add jit_ldr_i, jit_ldxr_i.
+	* lightning/i386/core-64.h: Add jit_ld{r,xr,i,xi}_{ui,l,ul};
+	move jit_ldr_i, jit_ldxr_i, jit_str_l, jit_stxr_l with others.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/asm-common.h: Add _s32P.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Implement long mul/div/mod.
+
+2008-03-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Cast memory address to long for JCCim.
+
+2008-03-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/asm-common.h: Add underscores around __unused__
+	attribute.
+
+2008-03-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/core.h: Avoid some "value computed is not used"
+	warnings.
+	* lightnings/tests/allocai.c: Silence other warnings.
+
+2008-03-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightningize.in: Fix some problems (not all).
+
+2008-03-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-32.h: Avoid some "value computed is not used"
+	warnings; reported by Sam Steingold.
+
+2008-03-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-32.h: Fix stxr_c(_EAX, _EBX, _ESI).
+
+2008-02-13  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-32.h: Avoid redefinition of _r1, reported by
+	Sam Steingold.
+	* lightning/i386/asm-64.h: Likewise.
+
+2008-02-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Don't define _VOID, reported
+	by Reini Urban.
+
+2008-02-03  Paolo Bonzini  <bonzini@gnu.org>
+
+	* build-aux/lightning.m4: Add --with-lightning-prefix option, suggested
+	by Sam Steingold.
+
+2008-01-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-64.h: Use CALLsr, not CALLLsr.
+
+2008-01-13  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-i386.h: Move jit_calli and jit_callr...
+	* lightning/i386/core-32.h: ... here.
+	* lightning/i386/core-64.h: Redefine them.
+
+2008-01-05  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-32.h: Fix sub(a,0,a).
+	* lightning/tests/3to2.c: Add new testcases.
+	* lightning/tests/3to2.ok: Add new testcases.
+
+2008-01-02  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp-32.h: Fix sub(a,b,a) with a ~= JIT_FPR0.
+	* lightning/tests/3to2.c: New.
+	* lightning/tests/3to2.ok: New.
+
+2007-11-07  Paolo Bonzini  <bonzini@gnu.org>
+
+	* opcode/Makefile.am: Fix AM_CPPFLAGS.
+
+2007-08-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-i386.h: Improve encoding of set* instructions.
+	* lightning/i386/core-64.h: Fix jit_bra_l.
+	* tests/sete.c: New.
+	* tests/sete.ok: New.
+
+2007-06-29  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/bp.c: Upgrade to GPL/LGPLv3.
+	* lightning/i386/asm-32.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/asm-64.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/core-32.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/core-64.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/fp-64.h: Upgrade to GPL/LGPLv3.
+	* lightning/sparc/asm.h: Upgrade to GPL/LGPLv3.
+	* lightning/sparc/core.h: Upgrade to GPL/LGPLv3.
+	* lightning/sparc/fp.h: Upgrade to GPL/LGPLv3.
+	* lightning/sparc/funcs.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/asm-i386.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/core-i386.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/fp-32.h: Upgrade to GPL/LGPLv3.
+	* lightning/i386/funcs.h: Upgrade to GPL/LGPLv3.
+	* lightning/ppc/asm.h: Upgrade to GPL/LGPLv3.
+	* lightning/ppc/core.h: Upgrade to GPL/LGPLv3.
+	* lightning/ppc/fp.h: Upgrade to GPL/LGPLv3.
+	* lightning/ppc/funcs.h: Upgrade to GPL/LGPLv3.
+	* lightning.h: Upgrade to GPL/LGPLv3.
+	* tests/add.c: Upgrade to GPL/LGPLv3.
+	* tests/fib.c: Upgrade to GPL/LGPLv3.
+	* tests/testfp.c: Upgrade to GPL/LGPLv3.
+	* tests/fibdelay.c: Upgrade to GPL/LGPLv3.
+	* tests/fibit.c: Upgrade to GPL/LGPLv3.
+	* tests/funcfp.c: Upgrade to GPL/LGPLv3.
+	* tests/incr.c: Upgrade to GPL/LGPLv3.
+	* tests/printf.c: Upgrade to GPL/LGPLv3.
+	* tests/printf2.c: Upgrade to GPL/LGPLv3.
+	* tests/rpn.c: Upgrade to GPL/LGPLv3.
+	* tests/rpnfp.c: Upgrade to GPL/LGPLv3.
+	* lightning/asm-common.h: Upgrade to GPL/LGPLv3.
+	* lightning/core-common.h: Upgrade to GPL/LGPLv3.
+	* lightning/fp-common.h: Upgrade to GPL/LGPLv3.
+	* lightning/funcs-common.h: Upgrade to GPL/LGPLv3.
+	* opcode/dis-buf.c: Upgrade to GPL/LGPLv3.
+	* opcode/disass.c: Upgrade to GPL/LGPLv3.
+	* opcode/i386-dis.c: Upgrade to GPL/LGPLv3.
+	* opcode/sparc-dis.c: Upgrade to GPL/LGPLv3.
+	* opcode/sparc-opc.c: Upgrade to GPL/LGPLv3.
+	* lightningize.in: Upgrade to GPL/LGPLv3.
+	* opcode/bfd.h: Upgrade to GPL/LGPLv3.
+	* opcode/i386.h: Upgrade to GPL/LGPLv3.
+	* opcode/sparc.h: Upgrade to GPL/LGPLv3.
+
+2007-01-26  Thomas Girard  <thomas.g.girard@free.fr>
+
+	* lightning/Makefile.am: Add clean-local target.
+
+2006-12-02  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Add CVTTS?2SIL.
+	* lightning/i386/asm-64.h: Add CVTTS?2SIQ.
+	* lightning/i386/fp-64.h: Use it.
+
+	* lightning/Makefile.am: Place files in nodist_lightning_HEADERS.
+
+2006-11-23  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/core-common.h: Add casts in "*i_p" variants.
+	* lightning/i386/asm-32.h: Add _r1.
+	* lightning/i386/asm-64.h: Likewise, and add SSE instructions.
+	* lightning/i386/asm-i386.h: Merge SSE instructions from Gwenole.
+	Use short form for 16-bit AX instructions.  Remove _r1
+	* lightning/i386/core-64.h: Add FP ABI support in its infancy.
+	* lightning/i386/core-i386.h: Move jit_arg_f and jit_arg_d...
+	* lightning/i386/core-32.h: ... and jit_prepare_f and jit_prepare_d...
+	* lightning/i386/fp-32.h: ... here.
+	* lightning/i386/fp-64.h: Write the code.
+	* lightning/sparc/fp.h: Fix jit_extr_{f_d,d_f} register order.
+	
+2006-11-22  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Move x86-64 instructions...
+	* lightning/i386/asm-64.h: ... here.
+	* lightning/i386/fp-32.h: Fix bugfixes worked around in froofyJIT.
+	Add JIT_FPRET.
+	* lightning/sparc/fp.h: Likewise.
+	* lightning/ppc/fp.h: Likewise.
+	* lightning/fp-common.h: Adjust for JIT_FPRET.
+	* tests/funcfp.c: Adjust for JIT_FPRET.
+	* tests/rpnfp.c: Adjust for JIT_FPRET.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h:  Add an underscore to macros without
+	a parameter.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core-i386.h: Move jit_movip, jit_check8, jit_reg8,
+	jit_reg16, jit_movbrm...
+	* lightning/i386/core-32.h: ... here.
+	* lightning/i386/core-64.h: Redefine them.  Fix other bugs.
+
+	* tests/printf.c: Do not do a varargs call.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Check in rewrite from Basilisk II.
+	* lightning/i386/asm-32.h: Adjust.
+	* lightning/i386/asm-64.h: Adjust.
+	* lightning/i386/fp-32.h: Adjust.
+
+	* lightning/i386/core-32.h: Adjust.  Add jit_{ld,ldx,st,stx}i*.
+	* lightning/i386/core-64.h: Adjust.  Add jit_{ld,ldx,st,stx}i*.
+	* lightning/i386/core-i386.h: Adjust. Remove these patterns.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm-i386.h: Merge 64-bit cleanliness changes from
+	mzscheme.
+	Add SSE.
+	* lightning/i386/asm-64.h: Likewise.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+	    Ludovic Courtes  <ludo@chbouib.org>
+
+	* lightning/i386/core-32.h: Disable jit_push and jit_pop if stack not
+	needed.
+	* lightning/i386/core-64.h: Disable jit_push and jit_pop if stack not
+	needed.
+	* lightning/sparc/core.h: Merge final implementation of jit_pushr and
+	jit_popr.
+	* lightning/ppc/core.h: Fix implementation of jit_pushr and jit_popr to
+	work (more or less) across function calls.
+
+	* tests/push-pop.c, tests/push-pop.ok: New test.
+	* tests/Makefile.am: Run it.
+
+2006-11-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/asm-common.h: Make 64-bit safe.
+	* lightning/i386/funcs.h: Make 64-bit safe.
+
+	* lightning/i386/asm-64.h: More merge from mzscheme.
+	* lightning/i386/asm-i386.h: More merge from mzscheme.
+	* lightning/i386/core-32.h: More merge from mzscheme.
+	* lightning/i386/core-64.h: More merge from mzscheme.
+	* lightning/i386/core-i386.h: More merge from mzscheme.
+
+	* tests/rpnfp.c, tests/testfp.c, tests/funcfp.c: Skip if no
+	floating-point support.
+
+2006-11-04  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/rpn.c: Remove pushr/popr.
+
+2006-11-04  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/core.h: Implement jit_allocai, define JIT_FP to be R1.
+	* lightning/ppc/funcs.h: Store frame size into _jitl.  Store R1 before
+	the STMW, so that the offset is unchanged when we patch the STMW.
+	* lightning/i386/core.h: Define JIT_FP to be EBP.
+	* lightning/i386/core-32.h: Implement jit_allocai, put LEAVE in the
+	epilog if jit_allocai was used.
+	* lightning/i386/core-64.h: Implement jit_allocai, put LEAVE in the
+	epilog if jit_allocai was used.
+
+2006-11-04  Ludovic Courtes  <ludo@chbouib.org>
+
+	* lightning/sparc/core.h: Implement jit_allocai.
+	* tests/allocai.c: New.
+	* tests/Makefile.am: Point to new tests.
+
+2006-11-03  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/core.h: Fix jit_bms using BNE rather than BGT.
+	"AND." does signed comparisons.
+
+2006-10-31  Paolo Bonzini  <bonzini@gnu.org>
+
+	* doc/porting.texi: Rename JIT_FP to JIT_AP.
+	* lightning/core-common.h: Likewise.
+	* lightning/i386/core-i386.h: Likewise.
+	* lightning/fp-common.h: Provide default versions of jit_getarg_[fd].
+	* lightning/i386/fp-32.h: Don't provide jit_getarg_[fd].
+	* lightning/ppc/fp.h: Likewise.
+
+2006-10-31  Ludovic Courtes  <ludo@chbouib.org>
+
+        * doc/using.texi (The instruction set): Clarified the use of `JIT_RET' and
+        documented `jit_retval'.
+        * tests/ret.c (generate_function_proxy): After `jit_finish', use
+        `jit_retval_i' to move FUNC's return value into the correct register.
+
+2006-10-31  Paolo Bonzini  <bonzini@gnu.org>
+	    Ludovic Courtes  <ludo@chbouib.org>
+
+	* tests/divi.c, tests/divi.ok, tests/movi.c, tests/movi.ok: New.
+	* tests/ldxi.c: Ensure large pointer is generated.
+	* tests/Makefile.am: Point to new tests.
+	* lightning.h: Include funcs-common.h before funcs.h.
+	* lightning/sparc/core.h: Fix bugs in modi/divi.
+
+2006-10-30  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/Makefile.am: Use "ln -sf".
+	* lightning/core-common.h: Define jit_negr_l if necessary.
+
+2006-10-30  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm.h (MOVS*, MOVZ*): Use correct _r[124] macros.
+
+2006-10-29  Paolo Bonzini  <bonzini@gnu.org>
+
+	* configure.ac: Use lightning.m4 macros.
+	* lightning.m4: Refactor to use common code in configure.ac.  Move...
+	* build-aux/lightning.m4: ... here.
+	* lightningize.in: Support suffixes.
+	* opcode/disass.in: Adapt to changes in configure.ac.
+
+	* lightning/ppc/funcs.h: Use __APPLE__ instead of _CALL_DARWIN.
+	* lightning/i386/core-32.h: Likewise.
+
+2006-10-26  Paolo Bonzini  <bonzini@gnu.org>
+
+	* configure.ac: Fix compilation test.
+	* lightning/Makefile.am: Symlink LIGHTNING_TARGET_FILES in
+	non-distribution mode.
+	* lightning/i386/Makefile.frag: Use LIGHTNING_TARGET_FILES.
+
+2006-10-26  Paolo Bonzini  <bonzini@gnu.org>
+
+	* configure.ac: Subst cpu.
+	* lightning/core-common.h: Make tests pass on i386.
+	* lightning/i386/asm-32.h: Make tests pass on i386.
+	* lightning/i386/asm-64.h: Make tests pass on i386.
+	* lightning/i386/asm-i386.h: Make tests pass on i386.
+	* lightning/i386/core-32.h: Make tests pass on i386.
+	* lightning/i386/core-64.h: Make tests pass on i386.
+	* lightning/i386/core-i386.h: Make tests pass on i386.
+	* tests/Makefile.am: Include files from cpu directory.
+
+2006-10-26  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm.h: Move to asm-i386.h
+	* lightning/i386/asm-32.h: New, from Matthew Flatt.
+	* lightning/i386/asm-64.h: New, from Matthew Flatt.
+	* lightning/i386/core.h: Move to core-i386.h
+	* lightning/i386/core-32.h: New, from Matthew Flatt.
+	* lightning/i386/core-64.h: New, from Matthew Flatt.
+	* lightning/i386/fp.h: Move to fp-32.h
+	* lightning/i386/fp-64.h: New, dummy.
+	* lightning/i386/Makefile.frag: New.
+	* lightning/Makefile.am: Support per-target Makefile fragments.
+	* configure.ac: Support per-target Makefile fragments and CPU suffixes.
+
+2006-10-16  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/i386.h (jit_flush_code): Fix syntax error. :-(
+
+2006-07-06  Paolo Bonzini  <bonzini@gnu.org>
+	    Ludovic Courtes  <ludovic.courtes@laas.fr>
+
+	* doc/using.texi: Clarify "Using autoconf" section
+	and rename it to "Bundling lightning"
+	* lightning.m4: Work also if lightning is not bundled.
+
+2006-07-06  Paolo Bonzini  <bonzini@gnu.org>
+	    Ludovic Courtes  <ludovic.courtes@laas.fr>
+
+	* lightning/ppc/core.h (_jit_mod): Replace with...
+	(_jit_mod_big, _jit_mod_small): ... these.
+	(jit_modi_i, jit_modi_ui): Rewrite.
+	* tests/modi.c, tests/modi.ok: New tests.
+
+2006-05-18  Matthew Flatt  <mflatt@cs.utah.edu>
+
+	* lightning/i386/asm.h: Fix test for extending the mprotect area
+	towards lower addresses.
+
+2006-05-16  Bruno Haible  <bruno@clisp.org>
+
+	* lightning/asm-common.h: Don't use __func__ nor __FUNCTION__ if
+	not compiling with GNU C.
+
+2006-02-16  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/core.h: Fix jit_ldxi_* with big displacement.
+
+2006-01-23  Paolo Bonzini  <bonzini@gnu.org>
+
+	* configure.ac: Fix comments in config.h.in.
+	
+2005-11-25  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/sparc/fp.h: Fix header comment.
+	* lightning/ppc/fp.h: Fix header comment.
+
+2005-04-27  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/asm.h (JCm, JCSm, JNCm, JNCSm): New.
+
+2004-11-26  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h (_jit_epilog): Remove unused variable.
+
+2004-11-13  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/funcs.h [__linux__]: Include sys/mman.h.
+
+2004-11-09  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/sparc/fp.h: Fix fp-to-integer conversions.
+	* lightning/ppc/testfp.c: Test fp-to-integer conversions
+	of integer numbers.
+	* lightning/ppc/testfp.ok: Adjust for the above.
+
+2004-11-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/testfp.c: Always flush code before
+	testing it.
+
+2004-11-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/fp.h: Do not clobber f31.
+
+2004-11-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning.h: New name of...
+	* lightning-inst.h: ... this file.
+	* lightning.h.in: Removed.
+
+	* opcodes/disass.c: Include config.h.
+	* tests/add.c: Include config.h.
+	* tests/bp.c: Include config.h.
+	* tests/fib.c: Include config.h.
+	* tests/fibdelay.c: Include config.h.
+	* tests/fibit.c: Include config.h.
+	* tests/funcfp.c: Include config.h.
+	* tests/incr.c: Include config.h.
+	* tests/printf.c: Include config.h.
+	* tests/printf2.c: Include config.h.
+	* tests/rpn.c: Include config.h.
+	* tests/rpnfp.c: Include config.h.
+	* tests/testfp.c: Include config.h.
+
+2004-10-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp.h: Fix bugs in conditional branches.
+
+2004-10-10  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/funcs.h: Fix pasto in jit_flush_code.
+
+2004-10-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/fp.h: Optimized conditional branches.
+
+2004-09-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/asm.h: Fix more typos.
+
+2004-09-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/asm.h: Fix typos, replace `26' with JIT_AUX.
+
+2004-09-20  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/fp.h: Added conditional branches.
+
+2004-09-18  Laurent Michel  <ldm@thorgal.homelinux.org>
+
+	* lightning/ppc/fp.h (jit_unler_d, jit_unltr_d, jit_unger_d,
+	jit_ungtr_d, jit_ltgt_d, jit_uneq_d): Implemented missing tests
+	to fully support testfp.
+	(jit_floorr_d_i, jit_ceilr_d_i, jit_roundr_d_i, jit_truncr_d_i):
+	New macros.
+	* lightning/ppc/asm.h: Added missing opcodes FCTIWZ and MTFSFI.
+	* lightning/ppc/funcs.h (_jit_prolog): Fixed minor mistake in
+	the initialization of _jitl.nextarg_geti, relying on the
+	JIT_AUX macro as well to get the register offset.
+
+2004-09-07  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h: Fix typo.
+
+2004-09-06  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/funcfp.c: Use %g.  Remove C99 variable declarations.
+	* tests/testfp.c: Don't use __builtin_nan.
+
+	* lightning/ppc/core.h: Add three V registers.
+	* lightning/ppc/funcs.h: Adjust.
+
+	* lightning/sparc/core.h: Some fixes related to FP argument passing.
+	Move R0 to %g2, use %o7 for JIT_BIG2.
+	* lightning/sparc/fp.h: Some fixes related to FP argument passing.
+
+2004-09-02  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/sparc/core.h: Add another V register,
+	move R0 to %o7.
+
+2004-07-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/funcs.h: Implement jit_flush_code,
+	in order to support Fedora's exec-shield.
+
+2004-07-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/core-common.h: Add more jit_extr_*_* macros.
+	* lightning/doc/using.texi: Be clearer about the order
+	of arguments in jit_extr_*_*.
+	* lightning/doc/porting.texi: Add more jit_extr_*_* macros.
+	* lightning/i386/fp.h: Fix typo in jit_extr_i_d.
+
+2004-07-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h: Adjust offset of LR into
+	stack frame if running under the Darwin ABI.
+
+2004-07-13  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp.h: Rename jit_exti_d to jit_extr_i_d.
+
+2004-07-13  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/core.h: Fix thinko.
+
+	* lightning/i386/core.h: Fix jit_lti_ui.
+	* lightning/core-common.h: Add missing macros.
+
+	* lightning/ppc/fp.h: Rename jit_neg_* to jit_negr_*.
+	* lightning/i386/fp.h: Rename jit_neg_* to jit_negr_*.
+	* lightning/sparc/fp.h: Rename jit_neg_* to jit_negr_*.
+	* lightning/fp-common.h: Rename jit_neg_* to jit_negr_*.
+	* doc/porting.texi: Add undocumented macros.
+
+2004-07-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* doc/porting.texi: Add missing macros.
+
+2004-07-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h: Don't generate trampolines.
+	Separate prolog and epilog generation.
+	* lightning/ppc/core.h: Generate epilog explicitly.
+	Don't reserve r31 anymore.
+	* lightning/core-common.h: Remove call to jit_setup_code.
+
+2004-07-09  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/lightning.h.in: Avoid preprocessor warnings.
+	* lightning/lightning-inst.h: Likewise.
+
+	* lightning/i386/core.h: Define JIT_R, JIT_R_NUM, JIT_V,
+	JIT_V_NUM.
+	* lightning/ppc/core.h: Likewise.
+	* lightning/sparc/core.h: Likewise.
+	* lightning/i386/fp.h: Define JIT_FPR, JIT_FPR_NUM.
+	* lightning/ppc/fp.h: Likewise.
+	* lightning/sparc/fp.h: Likewise.
+	* lightning/core-common.h: Define fixed register names.
+	* lightning/fp-common.h: Likewise for FP regs.
+
+2004-07-09  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/ppc/funcs.h: Fix location where return address
+	is stored.
+	* lightning/i386/asm.h: Add a trailing _ to opcodes without
+	any parameter.
+	* lightning/i386/core.h: Adjust for the above.
+
+2004-04-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/fp.h: Change "and" to "_and"
+	to satisfy C++ compilers.
+
+2004-04-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/sparc/fp.h: Use memcpy to implement jit_movi.
+	* lightning/ppc/fp.h: Use memcpy to implement jit_movi.
+	Move floating-point opcodes...
+	* lightning/ppc/asm.h: ... here.
+
+2004-04-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/core-common.h: Add jit_finishr.
+	* lightning/ppc/core.h: Add jit_callr and jit_finishr.
+	* lightning/i386/core.h: Add jit_callr.
+	* lightning/sparc/core.h: Add jit_callr.  Fix typo.
+
+2004-04-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: Fix pasto in jit_b*_ui.
+
+2004-03-30  Laurent Michel
+
+	* lightning/ppc: Implement PowerPC floating point
+	(ChangeLog entry missing).
+
+2004-03-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/fp-common.h: Load/store macros are not the
+	same for floats and doubles anywhere, but jit_retval may be.
+	* lightning/i386/asm.h: Fix = mistaken for == in ESCrri.
+	* lightning/i386/core.h: Fix typo in jit_prepare_[fd].
+	* lightning/i386/fp.h: Rewritten.
+	* tests/testfp.c: Add tests for unordered comparisons.
+	* tests/testfp.ok: Add results.
+
+2004-03-15  Paolo Bonzini  <bonzini@gnu.org>
+
+	Merge changes from Laurent Michel.
+
+	* lightning/asm-common.h: Add _jit_I_noinc.
+	* lightning/core-common.h: Support jit_init,
+	jit_setup_code, jit_patch_at.  Return patchable IP from
+	jit_movi_p.
+	* lightning/funcs-common.h: Provide defaults
+	for jit_setup_code, jit_start_pfx, jit_end_pfx
+	* lightning/i386/core.h: Add jit_patch_at, jit_patch_movi.
+	* lightning/ppc/core.h: Likewise.
+	* lightning/sparc/core.h: Likewise.
+	* lightning/ppc/asm.h: Fix generation of branch destination
+	displacements in _FB and _BB
+	* lightning/ppc/core.h: Generate trampolines in the user
+	area.
+	* lightning/ppc/funcs.h: Add a few casts.
+	* tests/bc.c: New testcase.
+
+	* lightning/i386/asm.h: Wrap into #ifndef LIGHTNING_DEBUG.
+	* lightning/ppc/asm.h: Wrap into #ifndef LIGHTNING_DEBUG.
+	* lightning/sparc/asm.h: Wrap into #ifndef LIGHTNING_DEBUG.
+
+
+2004-03-09  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/sparc/fp.h: Rewrite.  Move macros for
+	FP code generation...
+	* lightning/sparc/asm.h: ... here.
+	* lightning/sparc/core.h: Rename jit_prepare to
+	jit_prepare_i, jit_retval to jit_retval_i.
+	* lightning/ppc/core.h: Rename jit_prepare to
+	jit_prepare_i, jit_retval to jit_retval_i.
+	* lightning/i386/core.h: Rename jit_prepare to
+	jit_prepare_i, jit_retval to jit_retval_i.
+	* lightning/core-common.h: Provide backwards
+	compatible synonyms for the above.
+	* lightning/fp-common.h: Rewrite.
+	* lightning-inst.h: Include fp unconditionally.
+	* lightning.h.in: Include fp unconditionally.
+	* tests/Makefile.am: Enable fp tests.
+	* tests/fib.c: Use jit_retval_i.
+	* tests/fibit.c: Cast codeBuffer to char *.
+	* tests/funcfp.c: Use new fp macros.
+	* tests/printf.c: Use jit_retval_i.
+	* tests/rpnfp.c: Use new fp macros.
+	* tests/testfp.c: Use new fp macros.
+
+2004-03-02  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: generate correct code when
+	doing lt/le/ge/etc. on ESI and EDI.  Use MOVZX/MOVSX
+	where possible.
+	* lightning/i386/asm.h: Add macros for MOVZX/MOVSX.
+	Move macros for x87 here, and add many of them.
+	* lightning/i386/fp.h: Use new macros for x87.
+
+2004-02-06  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: avoid generating MOV reg, reg.
+	* lightning/sparc/core.h: fix several bugs.
+	* lightning/ppc/core.h: fix several bugs.
+	* tests/rpn.c: rewritten.
+
+2004-01-08  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/rpnfp.c: new example, suggested by Basile
+	Starynkevitch.
+	* tests/rpnfp.ok: new example.
+
+2003-12-12  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/add.c: new test, suggested by Steve Dekorte.
+	* tests/add.c: new test.
+
+2003-11-14  Paolo Bonzini  <bonzini@gnu.org>
+	    John Redford <eirenik@hotmail.com>
+
+	* lightning/asm-common.h: change the 'pc' field of _jit to
+	be a union of various data types, because ISO C99 doesn't
+	permit using ++ on a = cast.  Change the incremented casts of
+	_jit.pc to be _jit.x.uc_pc, _jit.x.us_pc, etc.
+	* all files: change all non-cast instances of _jit.pc to be
+	_jit.x.pc.
+	* lightning/i386/core.h: remove casts from jit_might.
+
+2003-05-25  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: use JITSORRY in jit_replace
+	* lightning/asm-common.h: define JITSORRY
+
+2003-05-14  Paolo Bonzini  <bonzini@gnu.org>
+
+	* lightning/i386/core.h: fix missing comma in several
+	load/store macros.
+	* lightning/core-common.h: fix long/unsigned long/pointer
+	jit_pushr/jit_popr.
+	* lightning/ppc/funcs.h: correctly align stack pointer
+
+No changelogs for the assemblers (lightning directory) until 1.0
+	
+2003-03-27  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/printf2.c: new test
+
+2001-05-03  Paolo Bonzini  <bonzini@gnu.org>
+
+	* tests/printf.c: made the message platform independent
+
+2001-01-19  Paolo Bonzini  <bonzini@gnu.org>
+
+	* configure.in: support cross-assembling
+	
+	* disass/bfd.h, disass/dis-asm.h, disass/dis-buf.c,
+	disass/i386-dis.c, disass/i386.h, disass/ppc-dis.c,
+	disass/ppc.h, disass/ppc-opc.c, disass/sparc-dis.c,
+	disass/sparc.h, disass/sparc-opc.c: new files, from GDB
+
+	* disass/disass.c, disass/Makefile.am: new files
+
+	* tests/fib.c, tests/fibit.c, tests/incr.c, tests/printf.c,
+	tests/rpn.c, tests/testfp.c, tests/Makefile.am: support
+	disassembling
diff --git a/libguile/lightening/NEWS b/libguile/lightening/NEWS
new file mode 100644
index 000000000..f56dd7908
--- /dev/null
+++ b/libguile/lightening/NEWS
@@ -0,0 +1,199 @@
+NEWS FROM 1.99 TO 1.99a
+
+o   Lightning now builds and pass all test cases on AIX 7.1 powerpc,
+    HP-UX 11iv2 hppa, HP-UX 11iv3 ia64, Solaris 10 Sparc, Solaris 11
+    x86_64, and Irix 6.5.30 mips (using n32 abi).
+
+NEWS FROM VERSION 1.3 TO 1.99
+
+o   The 1.99 version is a major lightning redesign and an
+    alpha version.
+
+o   Unless for some special power users usage, the major
+    difference in the rework is that now function calls push
+    arguments from left to right, what is both, more natural for
+    programers, and also more natural to implement for architectures
+    that pass arguments in registers and have alignment constraints,
+    usually for 64 bit double arguments.
+
+o   Add mips backend, implementing the o32 abi.
+
+o   Added arm backend implementing all combinations of software float,
+    vfp, neon, arm and thumb instruction sets, softfp and hardp abis,
+    armv5, armv6, and armv7.
+
+o   Added sse2+ code generation for the 32 bit x86 backend.
+
+o   Added sse3 and sse4.x optional code generation for the 64 bit
+    x86 backend, code generation based on detected cpu.
+
+o   Reworked and added full lightning instruction set to ppc 32;
+    tested on ppc64 hardware and Darwin 32 operating system.
+
+o   Added ppc64 backend, built and tested on Fedora ppc.
+
+o   Reworked the sparc backend, built and tested on Debian sparc.
+
+o   Added an ia64 backend, built and tested on Debian ia64.
+
+o   Added an hppa backend, built and tested on Debian hppa.
+
+---
+
+NEWS FROM VERSION 1.2 TO 1.3
+
+o   Initial support for x86-64 back-end (mostly untested).
+
+o   lightning is more strict on casts from integer to pointer.
+    Be sure to use the _p variants when your immediates are
+    of pointer type.  This was done to ease 64-bit cleanliness
+    tests.
+
+o   Many bug fixes.
+
+o   JIT_FPRET is used as JIT_RET to move return values.
+    jit_retval_[fd] is used to retrieve return values.
+
+o   jit_pushr/jit_popr are deprecated, you need to #define
+    JIT_NEED_PUSH_POP prior to including lightning.h if you
+    want to use them.
+
+o   Support for stack-allocated variables.  Because of this,
+    backends defining JIT_FP should now rename it to JIT_AP.
+    JIT_FP is now a user-visible register used in ldxi/ldxr
+    to access stack-allocated variables.
+
+
+---
+
+NEWS FROM VERSION 1.1.2 TO 1.2
+
+o   Floating-point interface rewritten, uses a register file
+    architecture rather than a stack.
+
+o   Many bug fixes.
+
+o   jit_prepare and jit_retval are now jit_prepare_i and
+    jit_retval_i.
+
+o   Support for Fedora Core 1's exec-shield feature.
+
+o   PPC supports both SysV and Darwin ABIs.
+
+o   More (and more complete) examples provided.
+
+---
+
+NEWS FROM VERSION 1.1.1 TO 1.1.2
+
+o   This release fixes the bugs in PowerPC cache flushing and in
+    SPARC testing.
+
+---
+
+NEWS FROM VERSION 1.1 TO 1.1.1
+
+o   Merge changes from Debian
+
+This version was released to have a distributable version of lightning
+after the recent crack of the GNU FTP machines.  It does not fix
+outstanding bugs; I apologize for the inconvenience.
+
+---
+
+NEWS FROM VERSION 1.0 TO 1.1
+
+o   Several bug fixes
+
+o   improved infrastructure for embedding GNU lightning (lightningize
+    script)
+    
+---
+
+NEWS FROM VERSION 0.99 TO 1.0
+
+o   SPARC backend tested on GNU Smalltalk
+
+
+---
+
+NEWS FROM VERSION 0.98 TO 0.99
+
+o   Added floating point function support (thanks to Laurent Michel);
+    unfortunately this broke even more the PPC and SPARC floating point
+    stuff :-(
+
+---
+
+NEWS FROM VERSION 0.97 to 0.98
+
+o   PPC backend tested on GNU Smalltalk
+
+o   switched to autoconf 2.50
+
+o   new (much faster) PPC cache flushing code by John McIntosh
+
+---
+
+NEWS FROM VERSION 0.96 to 0.97
+
+o   support for cross-assembling and for disassembling the code that the tests
+    generate
+
+o   PPC microtests pass (tested directly by me), SPARC was said to work
+
+---
+
+NEWS FROM VERSION 0.95 to 0.96
+
+o   fixed implementation of delay slots to be coherent with the manual
+
+---
+
+NEWS FROM VERSION 0.94 to 0.95
+
+o   adc/sbc replaced with addc/addx/subc/subx to allow for more optimization
+    (inspired by the PPC instruction set).
+
+o   A few fixes and much less warnings from the compiler
+
+o   Automake-ized everything
+
+o   i386 backend generates smaller code for bms/bmc/or/xor by using byte
+    or word versions if possible
+
+o   Moved backends to separate directories
+
+---
+
+NEWS FROM VERSION 0.93 to 0.94
+
+o   Manual builds as DVI file.
+
+---
+
+NEWS FROM VERSION 0.92 to 0.93
+
+o   Floating-point front-end (began supporting PPC & SPARC).
+
+---
+
+NEWS FROM VERSION 0.91 to 0.92
+
+o   Floating-point front-end (only x86 supported).
+
+---
+
+NEWS FROM VERSION 0.9 to 0.91
+
+o   Carrying supported in addition/subtraction.
+
+o   insn type changed to jit_insn.
+
+o   Misc bug fixes.
+
+o   Reentrancy supported.
+
+o   SPARC run-time assembler rewritten.
+
+o   The run-time assembler can be disabled for debugging purposes.
diff --git a/libguile/lightening/README.md b/libguile/lightening/README.md
new file mode 100644
index 000000000..515c3ee06
--- /dev/null
+++ b/libguile/lightening/README.md
@@ -0,0 +1,57 @@
+# Lightening
+
+Lightening is a just-in-time code generation library derived from GNU
+Lightning, adapted to the purposes of the GNU Guile project.
+
+## Use
+
+```
+gcc -flto -O2 -g -o lightening.o -c lightening/lightening.c
+gcc -flto -O2 -g -o my-program lightening.o my-program.c
+```
+
+See the GNU Lightning manual for more on how to program against
+Lightening (much of the details are the same).
+
+## What's the difference with GNU Lightning?
+
+This project is called Lightening because it's lighter-weight than GNU
+Lightning.  When you go to generate code at run-time with GNU Lightning,
+what happens is that you build up a graph of nodes which GNU Lightning
+"optimizes" before finally emitting machine code.  These optimizations
+can improve register allocation around call sites.  However they are not
+helpful from a Guile perspective, as they get in the way of register
+allocation that we need to do; and they actually prevent access to all
+the registers that we would like to have.
+
+Guile needs a simple, light-weight code generation library.  The GNU
+Lightning architecture-specific backends provide the bulk of this
+functionality, and Lightening wraps it all in a lightweight API.
+
+## Supported targets
+
+Lightening can generate code for the x86-64, i686, ARMv7, and AArch64
+architectures.  It supports the calling conventions of MS Windows,
+GNU/Linux, and Mac OS.
+
+On i686, Lightening requires SSE support.  On ARMv7, we require hardware
+floating-point support (the VFP instructions), as well as the UDIV/SDIV
+instructions.
+
+Lightening is automatically tested using GitLab's continuous integration
+for under the supported architectures, for GNU/Linux; for a list of
+recent jobs, see [the CI
+page](https://gitlab.com/wingo/lightening/-/jobs).
+
+## Future targets
+
+Lightening has some inherited code from GNU Lightning for MIPS, PPC64,
+and s390.  Patches to adapt this code to the Lightening code structure
+are quite welcome.
+
+RISC-V support would be fun too.
+
+## Status
+
+Lightening is used in GNU Guile since version 2.9.2 and seems to work
+well.
diff --git a/libguile/lightening/THANKS b/libguile/lightening/THANKS
new file mode 100644
index 000000000..42bbfc631
--- /dev/null
+++ b/libguile/lightening/THANKS
@@ -0,0 +1,19 @@
+Thanks to all the following people for their help in
+improving GNU lightning:
+
+Paolo Bonzini                   <bonzini@gnu.org>
+Eli Barzilay                    <eli@barzilay.org>
+Ludovic Courtes                 <ludo@chbouib.org>
+Matthew Flatt			<mflatt@cs.utah.edu>
+Laurent Michel                  <ldm@thorgal.homelinux.org>
+Paulo Cesar Pereira de Andrade  <pcpa@gnu.org>
+Mike Spivey                     <mike@comlab.ox.ac.uk>
+Basile Starynkevitch            <basile@starynkevitch.net>
+Sam Steingold			<sds@gnu.org>
+Jens Troeger                    <savage@light-speed.de>
+Tom Tromey                      <tromey@redhat.com>
+Trent Nelson                    <trent@snakebite.org>
+Vitaly Magerya                  <vmagerya@gmail.com>
+Brandon Invergo                 <brandon@gnu.org>
+Holger Hans Peter Freyther      <holger@moiji-mobile.com>
+Jon Arintok                     <jon.arintok@gmail.com>
diff --git a/libguile/lightening/lightening.am b/libguile/lightening/lightening.am
new file mode 100644
index 000000000..2c9089ead
--- /dev/null
+++ b/libguile/lightening/lightening.am
@@ -0,0 +1,58 @@
+# Copyright 2019 Free Software Foundation, Inc.
+#
+# This file is part of Lightening.
+#
+# Lightening is free software; you can redistribute it and/or modify it
+# under the terms of the GNU Lesser General Public License as published
+# by the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# Lightening is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+# License for more details.
+#
+
+lightening = $(srcdir)/lightening
+
+lightening_c_files = 					\
+	$(lightening)/lightening/lightening.c
+
+lightening_extra_files =				\
+	$(lightening)/AUTHORS				\
+	$(lightening)/ChangeLog				\
+	$(lightening)/ChangeLog.lightning		\
+	$(lightening)/COPYING				\
+	$(lightening)/COPYING.DOC			\
+	$(lightening)/COPYING.LESSER			\
+	$(lightening)/lightening.am			\
+	$(lightening)/lightning.texi			\
+	$(lightening)/NEWS				\
+	$(lightening)/README.md				\
+	$(lightening)/THANKS				\
+							\
+	$(lightening)/lightening.h			\
+							\
+	$(lightening)/lightening/endian.h		\
+							\
+	$(lightening)/lightening/aarch64.h		\
+	$(lightening)/lightening/arm.h			\
+	$(lightening)/lightening/mips.h			\
+	$(lightening)/lightening/ppc.h			\
+	$(lightening)/lightening/x86.h			\
+							\
+	$(lightening)/lightening/aarch64.c		\
+	$(lightening)/lightening/aarch64-cpu.c		\
+	$(lightening)/lightening/aarch64-fpu.c		\
+	$(lightening)/lightening/arm.c			\
+	$(lightening)/lightening/arm-cpu.c		\
+	$(lightening)/lightening/arm-vfp.c		\
+	$(lightening)/lightening/mips.c			\
+	$(lightening)/lightening/mips-cpu.c		\
+	$(lightening)/lightening/mips-fpu.c		\
+	$(lightening)/lightening/ppc.c			\
+	$(lightening)/lightening/ppc-cpu.c		\
+	$(lightening)/lightening/ppc-fpu.c		\
+	$(lightening)/lightening/x86.c			\
+	$(lightening)/lightening/x86-cpu.c		\
+	$(lightening)/lightening/x86-sse.c
diff --git a/libguile/lightening/lightening.h b/libguile/lightening/lightening.h
new file mode 100644
index 000000000..bcf2032fa
--- /dev/null
+++ b/libguile/lightening/lightening.h
@@ -0,0 +1,662 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ *	Andy Wingo
+ */
+
+#ifndef _jit_h
+#define _jit_h
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+#include <stddef.h>
+
+#include "lightening/endian.h"
+
+CHOOSE_32_64(typedef int32_t jit_word_t,
+             typedef int64_t jit_word_t);
+CHOOSE_32_64(typedef uint32_t jit_uword_t,
+             typedef uint64_t jit_uword_t);
+typedef float		jit_float32_t;
+typedef double		jit_float64_t;
+typedef void*		jit_pointer_t;
+typedef int		jit_bool_t;
+
+typedef void*		jit_addr_t;
+typedef ptrdiff_t	jit_off_t;
+typedef intptr_t	jit_imm_t;
+typedef uintptr_t	jit_uimm_t;
+
+typedef struct jit_gpr { uint8_t regno; } jit_gpr_t;
+typedef struct jit_fpr { uint8_t regno; } jit_fpr_t;
+
+// Precondition: regno between 0 and 63, inclusive.
+#define JIT_GPR(regno) ((jit_gpr_t) { regno })
+#define JIT_FPR(regno) ((jit_fpr_t) { regno })
+
+static inline uint8_t jit_gpr_regno (jit_gpr_t reg) { return reg.regno; }
+static inline uint8_t jit_fpr_regno (jit_fpr_t reg) { return reg.regno; }
+
+static inline jit_bool_t
+jit_same_gprs (jit_gpr_t a, jit_gpr_t b)
+{
+  return jit_gpr_regno (a) == jit_gpr_regno (b);
+}
+
+static inline jit_bool_t
+jit_same_fprs (jit_fpr_t a, jit_fpr_t b)
+{
+  return jit_fpr_regno (a) == jit_fpr_regno (b);
+}
+
+#if defined(__i386__) || defined(__x86_64__)
+#  include "lightening/x86.h"
+#elif defined(__mips__)
+#  include "lightening/mips.h"
+#elif defined(__arm__)
+#  include "lightening/arm.h"
+#elif defined(__ppc__) || defined(__powerpc__)
+#  include "lightening/ppc.h"
+#elif defined(__aarch64__)
+#  include "lightening/aarch64.h"
+#elif defined(__s390__) || defined(__s390x__)
+#  include "lightening/s390.h"
+#endif
+
+enum jit_reloc_kind
+{
+  JIT_RELOC_ABSOLUTE,
+  JIT_RELOC_REL8,
+  JIT_RELOC_REL16,
+  JIT_RELOC_REL32,
+  JIT_RELOC_REL64,
+#ifdef JIT_NEEDS_LITERAL_POOL
+  JIT_RELOC_JMP_WITH_VENEER,
+  JIT_RELOC_JCC_WITH_VENEER,
+  JIT_RELOC_LOAD_FROM_POOL,
+#endif
+};
+
+typedef struct jit_reloc
+{
+  uint8_t kind;
+  uint8_t inst_start_offset;
+  uint8_t pc_base_offset;
+  uint8_t rsh;
+  uint32_t offset;
+} jit_reloc_t;
+
+#if defined(__GNUC__) && (__GNUC__ >= 4)
+#  define JIT_API		extern __attribute__ ((__visibility__("hidden")))
+#else
+#  define JIT_API		extern
+#endif
+
+typedef struct jit_state	jit_state_t;
+
+enum jit_operand_abi
+{
+  JIT_OPERAND_ABI_UINT8,
+  JIT_OPERAND_ABI_INT8,
+  JIT_OPERAND_ABI_UINT16,
+  JIT_OPERAND_ABI_INT16,
+  JIT_OPERAND_ABI_UINT32,
+  JIT_OPERAND_ABI_INT32,
+  JIT_OPERAND_ABI_UINT64,
+  JIT_OPERAND_ABI_INT64,
+  JIT_OPERAND_ABI_POINTER,
+  JIT_OPERAND_ABI_FLOAT,
+  JIT_OPERAND_ABI_DOUBLE,
+  JIT_OPERAND_ABI_WORD = CHOOSE_32_64(JIT_OPERAND_ABI_INT32,
+                                      JIT_OPERAND_ABI_INT64)
+};
+
+enum jit_operand_kind
+{
+  JIT_OPERAND_KIND_IMM,
+  JIT_OPERAND_KIND_GPR,
+  JIT_OPERAND_KIND_FPR,
+  JIT_OPERAND_KIND_MEM
+};
+
+typedef struct jit_operand
+{
+  enum jit_operand_abi abi;
+  enum jit_operand_kind kind;
+  union
+  {
+    intptr_t imm;
+    struct { jit_gpr_t gpr; ptrdiff_t addend; } gpr;
+    jit_fpr_t fpr;
+    struct { jit_gpr_t base; ptrdiff_t offset; ptrdiff_t addend; } mem;
+  } loc;
+} jit_operand_t;
+
+static inline jit_operand_t
+jit_operand_imm (enum jit_operand_abi abi, intptr_t imm)
+{
+  return (jit_operand_t){ abi, JIT_OPERAND_KIND_IMM, { .imm = imm } };
+}
+
+static inline jit_operand_t
+jit_operand_gpr_with_addend (enum jit_operand_abi abi, jit_gpr_t gpr,
+                             ptrdiff_t addend)
+{
+  return (jit_operand_t){ abi, JIT_OPERAND_KIND_GPR,
+      { .gpr = { gpr, addend } } };
+}
+
+static inline jit_operand_t
+jit_operand_gpr (enum jit_operand_abi abi, jit_gpr_t gpr)
+{
+  return jit_operand_gpr_with_addend (abi, gpr, 0);
+}
+
+static inline jit_operand_t
+jit_operand_fpr (enum jit_operand_abi abi, jit_fpr_t fpr)
+{
+  return (jit_operand_t){ abi, JIT_OPERAND_KIND_FPR, { .fpr = fpr } };
+}
+
+static inline jit_operand_t
+jit_operand_mem_with_addend (enum jit_operand_abi abi, jit_gpr_t base,
+                             ptrdiff_t offset, ptrdiff_t addend)
+{
+  return (jit_operand_t){ abi, JIT_OPERAND_KIND_MEM,
+      { .mem = { base, offset, addend } } };
+}
+
+static inline jit_operand_t
+jit_operand_mem (enum jit_operand_abi abi, jit_gpr_t base, ptrdiff_t offset)
+{
+  return jit_operand_mem_with_addend (abi, base, offset, 0);
+}
+
+static inline jit_operand_t
+jit_operand_addi (jit_operand_t op, ptrdiff_t addend)
+{
+  switch (op.kind) {
+  case JIT_OPERAND_KIND_GPR:
+    return jit_operand_gpr_with_addend (op.abi, op.loc.gpr.gpr,
+                                        op.loc.gpr.addend + addend);
+  case JIT_OPERAND_KIND_MEM:
+    return jit_operand_mem_with_addend (op.abi, op.loc.mem.base,
+                                        op.loc.mem.offset,
+                                        op.loc.mem.addend + addend);
+  default:
+    abort ();
+  }
+}
+
+JIT_API jit_bool_t init_jit(void);
+
+JIT_API jit_state_t *jit_new_state(void* (*alloc_fn)(size_t),
+                                   void (*free_fn)(void*));
+JIT_API void jit_destroy_state(jit_state_t*);
+
+JIT_API void jit_begin(jit_state_t*, uint8_t*, size_t);
+JIT_API jit_bool_t jit_has_overflow(jit_state_t*);
+JIT_API void jit_reset(jit_state_t*);
+JIT_API void* jit_end(jit_state_t*, size_t*);
+
+JIT_API void jit_align(jit_state_t*, unsigned);
+
+JIT_API jit_pointer_t jit_address(jit_state_t*);
+typedef void (*jit_function_pointer_t)();
+JIT_API jit_function_pointer_t jit_address_to_function_pointer(jit_pointer_t);
+JIT_API void jit_patch_here(jit_state_t*, jit_reloc_t);
+JIT_API void jit_patch_there(jit_state_t*, jit_reloc_t, jit_pointer_t);
+
+JIT_API void jit_move_operands (jit_state_t *_jit, jit_operand_t *dst,
+                                jit_operand_t *src, size_t argc);
+
+JIT_API size_t jit_align_stack (jit_state_t *_jit, size_t expand);
+JIT_API void jit_shrink_stack (jit_state_t *_jit, size_t diff);
+
+JIT_API size_t jit_enter_jit_abi (jit_state_t *_jit,
+                                  size_t v, size_t vf, size_t frame_size);
+JIT_API void jit_leave_jit_abi (jit_state_t *_jit,
+                                size_t v, size_t vf, size_t frame_size);
+
+/* Note that all functions that take jit_operand_t args[] use the args
+   as scratch space while shuffling values into position.  */
+JIT_API void jit_calli(jit_state_t *, jit_pointer_t f,
+                       size_t argc, jit_operand_t args[]);
+JIT_API void jit_callr(jit_state_t *, jit_gpr_t f,
+                       size_t argc, jit_operand_t args[]);
+JIT_API void jit_locate_args(jit_state_t*, size_t argc, jit_operand_t args[]);
+JIT_API void jit_load_args(jit_state_t*, size_t argc, jit_operand_t dst[]);
+
+static inline void
+jit_calli_0(jit_state_t *_jit, jit_pointer_t f)
+{
+  return jit_calli(_jit, f, 0, NULL);
+}
+
+static inline void
+jit_calli_1(jit_state_t *_jit, jit_pointer_t f, jit_operand_t arg)
+{
+  jit_operand_t args[] = { arg };
+  return jit_calli(_jit, f, 1, args);
+}
+
+static inline void
+jit_calli_2(jit_state_t *_jit, jit_pointer_t f, jit_operand_t a,
+            jit_operand_t b)
+{
+  jit_operand_t args[] = { a, b };
+  return jit_calli(_jit, f, 2, args);
+}
+
+static inline void
+jit_calli_3(jit_state_t *_jit, jit_pointer_t f, jit_operand_t a,
+            jit_operand_t b, jit_operand_t c)
+{
+  jit_operand_t args[] = { a, b, c };
+  return jit_calli(_jit, f, 3, args);
+}
+
+static inline void
+jit_callr_0(jit_state_t *_jit, jit_gpr_t f)
+{
+  return jit_callr(_jit, f, 0, NULL);
+}
+
+static inline void
+jit_callr_1(jit_state_t *_jit, jit_gpr_t f, jit_operand_t arg)
+{
+  jit_operand_t args[] = { arg };
+  return jit_callr(_jit, f, 1, args);
+}
+
+static inline void
+jit_callr_2(jit_state_t *_jit, jit_gpr_t f, jit_operand_t a, jit_operand_t b)
+{
+  jit_operand_t args[] = { a, b };
+  return jit_callr(_jit, f, 2, args);
+}
+
+static inline void
+jit_callr_3(jit_state_t *_jit, jit_gpr_t f, jit_operand_t a, jit_operand_t b,
+            jit_operand_t c)
+{
+  jit_operand_t args[] = { a, b, c };
+  return jit_callr(_jit, f, 3, args);
+}
+
+static inline void
+jit_load_args_1(jit_state_t *_jit, jit_operand_t a)
+{
+  jit_operand_t args[] = { a };
+  return jit_load_args(_jit, 1, args);
+}
+
+static inline void
+jit_load_args_2(jit_state_t *_jit, jit_operand_t a, jit_operand_t b)
+{
+  jit_operand_t args[] = { a, b };
+  return jit_load_args(_jit, 2, args);
+}
+
+static inline void
+jit_load_args_3(jit_state_t *_jit, jit_operand_t a, jit_operand_t b,
+                jit_operand_t c)
+{
+  jit_operand_t args[] = { a, b, c };
+  return jit_load_args(_jit, 3, args);
+}
+
+#define JIT_PROTO_0(stem, ret) \
+  ret jit_##stem (jit_state_t* _jit)
+#define JIT_PROTO_1(stem, ret, ta) \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a)
+#define JIT_PROTO_2(stem, ret, ta, tb) \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b)
+#define JIT_PROTO_3(stem, ret, ta, tb, tc) \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b, jit_##tc##_t c)
+#define JIT_PROTO_4(stem, ret, ta, tb, tc, td) \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b, jit_##tc##_t c, jit_##td##_t d)
+
+#define JIT_PROTO_RFF__(stem) JIT_PROTO_2(stem, jit_reloc_t, fpr, fpr)
+#define JIT_PROTO_RGG__(stem) JIT_PROTO_2(stem, jit_reloc_t, gpr, gpr)
+#define JIT_PROTO_RG___(stem) JIT_PROTO_1(stem, jit_reloc_t, gpr)
+#define JIT_PROTO_RGi__(stem) JIT_PROTO_2(stem, jit_reloc_t, gpr, imm)
+#define JIT_PROTO_RGu__(stem) JIT_PROTO_2(stem, jit_reloc_t, gpr, uimm)
+#define JIT_PROTO_R____(stem) JIT_PROTO_0(stem, jit_reloc_t)
+#define JIT_PROTO__FFF_(stem) JIT_PROTO_3(stem, void, fpr, fpr, fpr)
+#define JIT_PROTO__FF__(stem) JIT_PROTO_2(stem, void, fpr, fpr)
+#define JIT_PROTO__FGG_(stem) JIT_PROTO_3(stem, void, fpr, gpr, gpr)
+#define JIT_PROTO__FG__(stem) JIT_PROTO_2(stem, void, fpr, gpr)
+#define JIT_PROTO__FGo_(stem) JIT_PROTO_3(stem, void, fpr, gpr, off)
+#define JIT_PROTO__F___(stem) JIT_PROTO_1(stem, void, fpr)
+#define JIT_PROTO__Fd__(stem) JIT_PROTO_2(stem, void, fpr, float64)
+#define JIT_PROTO__Ff__(stem) JIT_PROTO_2(stem, void, fpr, float32)
+#define JIT_PROTO__Fp__(stem) JIT_PROTO_2(stem, void, fpr, pointer)
+#define JIT_PROTO__GF__(stem) JIT_PROTO_2(stem, void, gpr, fpr)
+#define JIT_PROTO__GGF_(stem) JIT_PROTO_3(stem, void, gpr, gpr, fpr)
+#define JIT_PROTO__GGGG(stem) JIT_PROTO_4(stem, void, gpr, gpr, gpr, gpr)
+#define JIT_PROTO__GGG_(stem) JIT_PROTO_3(stem, void, gpr, gpr, gpr)
+#define JIT_PROTO__GGGi(stem) JIT_PROTO_4(stem, void, gpr, gpr, gpr, imm)
+#define JIT_PROTO__GGGu(stem) JIT_PROTO_4(stem, void, gpr, gpr, gpr, uimm)
+#define JIT_PROTO__GG__(stem) JIT_PROTO_2(stem, void, gpr, gpr)
+#define JIT_PROTO__GGi_(stem) JIT_PROTO_3(stem, void, gpr, gpr, imm)
+#define JIT_PROTO__GGo_(stem) JIT_PROTO_3(stem, void, gpr, gpr, off)
+#define JIT_PROTO__GGu_(stem) JIT_PROTO_3(stem, void, gpr, gpr, uimm)
+#define JIT_PROTO__G___(stem) JIT_PROTO_1(stem, void, gpr)
+#define JIT_PROTO__Gi__(stem) JIT_PROTO_2(stem, void, gpr, imm)
+#define JIT_PROTO__Gp__(stem) JIT_PROTO_2(stem, void, gpr, pointer)
+#define JIT_PROTO______(stem) JIT_PROTO_0(stem, void)
+#define JIT_PROTO__i___(stem) JIT_PROTO_1(stem, void, imm)
+#define JIT_PROTO__oGF_(stem) JIT_PROTO_3(stem, void, off, gpr, fpr)
+#define JIT_PROTO__oGG_(stem) JIT_PROTO_3(stem, void, off, gpr, gpr)
+#define JIT_PROTO__pF__(stem) JIT_PROTO_2(stem, void, pointer, fpr)
+#define JIT_PROTO__pG__(stem) JIT_PROTO_2(stem, void, pointer, gpr)
+#define JIT_PROTO__p___(stem) JIT_PROTO_1(stem, void, pointer)
+
+#define FOR_EACH_INSTRUCTION(M)		\
+          M(_GGG_, addr)		\
+          M(_FFF_, addr_f)		\
+          M(_FFF_, addr_d)		\
+          M(_GGi_, addi)		\
+          M(_GGG_, addcr)		\
+          M(_GGi_, addci)		\
+          M(_GGG_, addxr)		\
+          M(_GGi_, addxi)		\
+          M(_GGG_, subr)		\
+          M(_FFF_, subr_f)		\
+          M(_FFF_, subr_d)		\
+          M(_GGi_, subi)		\
+          M(_GGG_, subcr)		\
+          M(_GGi_, subci)		\
+          M(_GGG_, subxr)		\
+          M(_GGi_, subxi)		\
+          M(_GGG_, mulr)		\
+          M(_FFF_, mulr_f)		\
+          M(_FFF_, mulr_d)		\
+          M(_GGi_, muli)		\
+          M(_GGGG, qmulr)		\
+          M(_GGGi, qmuli)		\
+          M(_GGGG, qmulr_u)		\
+          M(_GGGu, qmuli_u)		\
+          M(_GGG_, divr)		\
+          M(_FFF_, divr_f)		\
+          M(_FFF_, divr_d)		\
+          M(_GGi_, divi)		\
+          M(_GGG_, divr_u)		\
+          M(_GGu_, divi_u)		\
+          M(_GGGG, qdivr)		\
+          M(_GGGi, qdivi)		\
+          M(_GGGG, qdivr_u)		\
+          M(_GGGu, qdivi_u)		\
+          M(_GGG_, remr)		\
+          M(_GGi_, remi)		\
+          M(_GGG_, remr_u)		\
+          M(_GGu_, remi_u)		\
+  					\
+          M(_GGG_, andr)		\
+          M(_GGu_, andi)		\
+          M(_GGG_, orr)			\
+          M(_GGu_, ori)			\
+          M(_GGG_, xorr)		\
+          M(_GGu_, xori)		\
+  					\
+          M(_GGG_, lshr)		\
+          M(_GGu_, lshi)		\
+          M(_GGG_, rshr)		\
+          M(_GGu_, rshi)		\
+          M(_GGG_, rshr_u)		\
+          M(_GGu_, rshi_u)		\
+  					\
+          M(_GG__, negr)		\
+          M(_GG__, comr)		\
+  					\
+          M(_GG__, movr)		\
+          M(_Gi__, movi)		\
+          M(RG___, mov_addr)		\
+          M(_GG__, extr_c)		\
+          M(_GG__, extr_uc)		\
+          M(_GG__, extr_s)		\
+          M(_GG__, extr_us)		\
+  WHEN_64(M(_GG__, extr_i))		\
+  WHEN_64(M(_GG__, extr_ui))		\
+  					\
+          M(_GG__, bswapr_us)		\
+          M(_GG__, bswapr_ui)		\
+  WHEN_64(M(_GG__, bswapr_ul))		\
+  					\
+          M(_GG__, ldr_c)		\
+          M(_Gp__, ldi_c)		\
+          M(_GG__, ldr_uc)		\
+          M(_Gp__, ldi_uc)		\
+          M(_GG__, ldr_s)		\
+          M(_Gp__, ldi_s)		\
+          M(_GG__, ldr_us)		\
+          M(_Gp__, ldi_us)		\
+          M(_GG__, ldr_i)		\
+          M(_Gp__, ldi_i)		\
+  WHEN_64(M(_GG__, ldr_ui))		\
+  WHEN_64(M(_Gp__, ldi_ui))		\
+  WHEN_64(M(_GG__, ldr_l))		\
+  WHEN_64(M(_Gp__, ldi_l))		\
+          M(_FG__, ldr_f)		\
+          M(_Fp__, ldi_f)		\
+          M(_FG__, ldr_d)		\
+          M(_Fp__, ldi_d)		\
+  					\
+          M(_GGG_, ldxr_c)		\
+          M(_GGo_, ldxi_c)		\
+          M(_GGG_, ldxr_uc)		\
+          M(_GGo_, ldxi_uc)		\
+          M(_GGG_, ldxr_s)		\
+          M(_GGo_, ldxi_s)		\
+          M(_GGG_, ldxr_us)		\
+          M(_GGo_, ldxi_us)		\
+          M(_GGG_, ldxr_i)		\
+          M(_GGo_, ldxi_i)		\
+  WHEN_64(M(_GGG_, ldxr_ui))		\
+  WHEN_64(M(_GGo_, ldxi_ui))		\
+  WHEN_64(M(_GGG_, ldxr_l))		\
+  WHEN_64(M(_GGo_, ldxi_l))		\
+          M(_FGG_, ldxr_f)		\
+          M(_FGo_, ldxi_f)		\
+          M(_FGG_, ldxr_d)		\
+          M(_FGo_, ldxi_d)		\
+					\
+          M(_GG__, ldr_atomic)		\
+          M(_GG__, str_atomic)		\
+          M(_GGG_, swap_atomic)		\
+          M(_GGGG, cas_atomic)		\
+  					\
+          M(_GG__, str_c)		\
+          M(_pG__, sti_c)		\
+          M(_GG__, str_s)		\
+          M(_pG__, sti_s)		\
+          M(_GG__, str_i)		\
+          M(_pG__, sti_i)		\
+  WHEN_64(M(_GG__, str_l))		\
+  WHEN_64(M(_pG__, sti_l))		\
+          M(_GF__, str_f)		\
+          M(_pF__, sti_f)		\
+          M(_GF__, str_d)		\
+          M(_pF__, sti_d)		\
+  					\
+          M(_GGG_, stxr_c)		\
+          M(_oGG_, stxi_c)		\
+          M(_GGG_, stxr_s)		\
+          M(_oGG_, stxi_s)		\
+          M(_GGG_, stxr_i)		\
+          M(_oGG_, stxi_i)		\
+  WHEN_64(M(_GGG_, stxr_l))		\
+  WHEN_64(M(_oGG_, stxi_l))		\
+          M(_GGF_, stxr_f)		\
+          M(_oGF_, stxi_f)		\
+          M(_GGF_, stxr_d)		\
+          M(_oGF_, stxi_d)		\
+  					\
+          M(RGG__, bltr)		\
+          M(RFF__, bltr_f)		\
+          M(RFF__, bltr_d)		\
+          M(RGi__, blti)		\
+          M(RGG__, bltr_u)		\
+          M(RGu__, blti_u)		\
+          M(RGG__, bler)		\
+          M(RFF__, bler_f)		\
+          M(RFF__, bler_d)		\
+          M(RGi__, blei)		\
+          M(RGG__, bler_u)		\
+          M(RGu__, blei_u)		\
+          M(RGG__, beqr)		\
+          M(RFF__, beqr_f)		\
+          M(RFF__, beqr_d)		\
+          M(RGi__, beqi)		\
+          M(RGG__, bger)		\
+          M(RFF__, bger_f)		\
+          M(RFF__, bger_d)		\
+          M(RGi__, bgei)		\
+          M(RGG__, bger_u)		\
+          M(RGu__, bgei_u)		\
+          M(RGG__, bgtr)		\
+          M(RFF__, bgtr_f)		\
+          M(RFF__, bgtr_d)		\
+          M(RGi__, bgti)		\
+          M(RGG__, bgtr_u)		\
+          M(RGu__, bgti_u)		\
+          M(RGG__, bner)		\
+          M(RFF__, bner_f)		\
+          M(RFF__, bner_d)		\
+          M(RGi__, bnei)		\
+  					\
+          M(RFF__, bunltr_f)		\
+          M(RFF__, bunltr_d)		\
+          M(RFF__, bunler_f)		\
+          M(RFF__, bunler_d)		\
+          M(RFF__, buneqr_f)		\
+          M(RFF__, buneqr_d)		\
+          M(RFF__, bunger_f)		\
+          M(RFF__, bunger_d)		\
+          M(RFF__, bungtr_f)		\
+          M(RFF__, bungtr_d)		\
+          M(RFF__, bltgtr_f)		\
+          M(RFF__, bltgtr_d)		\
+          M(RFF__, bordr_f)		\
+          M(RFF__, bordr_d)		\
+          M(RFF__, bunordr_f)		\
+          M(RFF__, bunordr_d)		\
+  					\
+          M(RGG__, bmsr)		\
+          M(RGu__, bmsi)		\
+          M(RGG__, bmcr)		\
+          M(RGu__, bmci)		\
+  					\
+          M(RGG__, boaddr)		\
+          M(RGi__, boaddi)		\
+          M(RGG__, boaddr_u)		\
+          M(RGu__, boaddi_u)		\
+          M(RGG__, bxaddr)		\
+          M(RGi__, bxaddi)		\
+          M(RGG__, bxaddr_u)		\
+          M(RGu__, bxaddi_u)		\
+          M(RGG__, bosubr)		\
+          M(RGi__, bosubi)		\
+          M(RGG__, bosubr_u)		\
+          M(RGu__, bosubi_u)		\
+          M(RGG__, bxsubr)		\
+          M(RGi__, bxsubi)		\
+          M(RGG__, bxsubr_u)		\
+          M(RGu__, bxsubi_u)		\
+  					\
+          M(_G___, jmpr)		\
+          M(_p___, jmpi)		\
+          M(R____, jmp)			\
+					\
+          M(_p___, jmpi_with_link)	\
+          M(_____, pop_link_register)	\
+          M(_____, push_link_register)	\
+  					\
+          M(_____, ret)			\
+          M(_G___, retr)		\
+          M(_F___, retr_f)		\
+          M(_F___, retr_d)		\
+          M(_i___, reti)		\
+          M(_G___, retval_c)		\
+          M(_G___, retval_uc)		\
+          M(_G___, retval_s)		\
+          M(_G___, retval_us)		\
+          M(_G___, retval_i)		\
+  WHEN_64(M(_G___, retval_ui))		\
+  WHEN_64(M(_G___, retval_l))		\
+          M(_F___, retval_f)		\
+          M(_F___, retval_d)		\
+  					\
+          M(_____, breakpoint)		\
+  					\
+          M(_FF__, negr_f)		\
+          M(_FF__, negr_d)		\
+          M(_FF__, absr_f)		\
+          M(_FF__, absr_d)		\
+          M(_FF__, sqrtr_f)		\
+          M(_FF__, sqrtr_d)		\
+  					\
+          M(_GF__, truncr_f_i)		\
+          M(_FG__, extr_f)		\
+          M(_FG__, extr_d)		\
+          M(_FF__, extr_d_f)		\
+          M(_FF__, extr_f_d)		\
+          M(_FF__, movr_f)		\
+          M(_FF__, movr_d)		\
+          M(_Ff__, movi_f)		\
+          M(_Fd__, movi_d)		\
+          M(_GF__, truncr_d_i)		\
+  WHEN_64(M(_GF__, truncr_f_l))		\
+  WHEN_64(M(_GF__, truncr_d_l))		\
+          /* EOL */
+
+#define DECLARE_INSTRUCTION(kind, stem) JIT_API JIT_PROTO_##kind(stem);
+FOR_EACH_INSTRUCTION(DECLARE_INSTRUCTION)
+#undef DECLARE_INSTRUCTION
+
+#if __WORDSIZE == 32
+#  define jit_ldr(j,u,v)	jit_ldr_i(j,u,v)
+#  define jit_ldi(j,u,v)	jit_ldi_i(j,u,v)
+#  define jit_ldxr(j,u,v,w)	jit_ldxr_i(j,u,v,w)
+#  define jit_ldxi(j,u,v,w)	jit_ldxi_i(j,u,v,w)
+#  define jit_str(j,u,v)	jit_str_i(j,u,v)
+#  define jit_sti(j,u,v)	jit_sti_i(j,u,v)
+#  define jit_stxr(j,u,v,w)	jit_stxr_i(j,u,v,w)
+#  define jit_stxi(j,u,v,w)	jit_stxi_i(j,u,v,w)
+#  define jit_retval(j,u)	jit_retval_i(j,u)
+#  define jit_bswapr(j,u,v)	jit_bswapr_ui(j,u,v)
+#  define jit_truncr_d(j,u,v)	jit_truncr_d_i(j,u,v)
+#  define jit_truncr_f(j,u,v)	jit_truncr_f_i(j,u,v)
+#else
+#  define jit_ldr(j,u,v)	jit_ldr_l(j,u,v)
+#  define jit_ldi(j,u,v)	jit_ldi_l(j,u,v)
+#  define jit_ldxr(j,u,v,w)	jit_ldxr_l(j,u,v,w)
+#  define jit_ldxi(j,u,v,w)	jit_ldxi_l(j,u,v,w)
+#  define jit_str(j,u,v)	jit_str_l(j,u,v)
+#  define jit_sti(j,u,v)	jit_sti_l(j,u,v)
+#  define jit_stxr(j,u,v,w)	jit_stxr_l(j,u,v,w)
+#  define jit_stxi(j,u,v,w)	jit_stxi_l(j,u,v,w)
+#  define jit_retval(j,u)	jit_retval_l(j,u)
+#  define jit_bswapr(j,u,v)	jit_bswapr_ul(j,u,v)
+#  define jit_truncr_d(j,u,v)	jit_truncr_d_l(j,u,v)
+#  define jit_truncr_f(j,u,v)	jit_truncr_f_l(j,u,v)
+#endif
+
+#endif /* _jit_h */
diff --git a/libguile/lightening/lightening/aarch64-cpu.c b/libguile/lightening/lightening/aarch64-cpu.c
new file mode 100644
index 000000000..13aa351e9
--- /dev/null
+++ b/libguile/lightening/lightening/aarch64-cpu.c
@@ -0,0 +1,2571 @@
+/*
+ * Copyright (C) 2013-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#if __BYTE_ORDER != __LITTLE_ENDIAN
+#error AArch64 requires little-endian host
+#endif
+
+static int32_t
+logical_immediate(jit_word_t imm)
+{
+  /* There are 5334 possible immediate values, but to avoid the
+   * need of either too complex code or large lookup tables,
+   * only check for (simply) encodable common/small values */
+  switch (imm) {
+  case -16:       return 0xf3b;
+  case -15:       return 0xf3c;
+  case -13:       return 0xf3d;
+  case -9:        return 0xf3e;
+  case -8:        return 0xf7c;
+  case -7:        return 0xf7d;
+  case -5:        return 0xf7e;
+  case -4:        return 0xfbd;
+  case -3:        return 0xfbe;
+  case -2:        return 0xffe;
+  case 1:         return 0x000;
+  case 2:         return 0xfc0;
+  case 3:         return 0x001;
+  case 4:         return 0xf80;
+  case 6:         return 0xfc1;
+  case 7:         return 0x002;
+  case 8:         return 0xf40;
+  case 12:        return 0xf81;
+  case 14:        return 0xfc2;
+  case 15:        return 0x003;
+  case 16:        return 0xf00;
+  default:        return -1;
+  }
+}
+
+static void
+oxxx(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_Rm_bitfield(inst, Rm);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+oxxi(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Rn, int32_t Imm12)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_imm12_bitfield(inst, Imm12);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+oxx9(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Rn, int32_t Simm9)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_simm9_bitfield(inst, Simm9);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static uint32_t
+encode_ox19(int32_t Op, int32_t Rd)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  return inst;
+}
+
+static uint32_t
+encode_oc19(int32_t Op, int32_t Cc)
+{
+  uint32_t inst = Op;
+  inst = write_cond2_bitfield(inst, Cc);
+  return inst;
+}
+
+static uint32_t
+encode_o26(int32_t Op)
+{
+  uint32_t inst = Op;
+  return inst;
+}
+
+static void
+ox_x(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Rm)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rm_bitfield(inst, Rm);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+o_xx(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Rn)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+oxx_(jit_state_t *_jit, int32_t Op, int32_t Rn, int32_t Rm)
+{
+  uint32_t inst = Op;
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_Rm_bitfield(inst, Rm);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+o_x_(jit_state_t *_jit, int32_t Op, int32_t Rn)
+{
+  uint32_t inst = Op;
+  inst = write_Rn_bitfield(inst, Rn);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+ox_h(jit_state_t *_jit, int32_t Op, int32_t Rd, int32_t Imm16)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_imm16_bitfield(inst, Imm16);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+oxxrs(jit_state_t *_jit, int32_t Op,
+      int32_t Rd, int32_t Rn, int32_t R, int32_t S)
+{
+  uint32_t inst = Op;
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_immr_bitfield(inst, R);
+  inst = write_imms_bitfield(inst, S);
+  emit_u32_with_pool(_jit, inst);
+}
+
+#define XZR_REGNO                     0x1f
+#define WZR_REGNO                     XZR_REGNO
+#define LSL_12                        0x00400000
+#define MOVI_LSL_16                   0x00200000
+#define MOVI_LSL_32                   0x00400000
+#define MOVI_LSL_48                   0x00600000
+#define XS                            0x80000000      /* Wn -> Xn */
+#define BCC_EQ                        0x0
+#define BCC_NE                        0x1
+#define BCC_CS                        0x2
+#define BCC_HS                        BCC_CS
+#define BCC_CC                        0x3
+#define BCC_LO                        BCC_CC
+#define BCC_MI                        0x4
+#define BCC_PL                        0x5
+#define BCC_VS                        0x6
+#define BCC_VC                        0x7
+#define BCC_HI                        0x8
+#define BCC_LS                        0x9
+#define BCC_GE                        0xa
+#define BCC_LT                        0xb
+#define BCC_GT                        0xc
+#define BCC_LE                        0xd
+#define BCC_AL                        0xe
+#define BCC_NV                        0xf
+/* adapted and cut down to only tested and required by lightening,
+ * from data in binutils/aarch64-tbl.h */
+#define A64_ADCS                      0x3a000000
+#define A64_SBCS                      0x7a000000
+#define A64_ADDI                      0x11000000
+#define A64_ADDSI                     0xb1000000
+#define A64_SUBI                      0x51000000
+#define A64_SUBSI                     0x71000000
+#define A64_ADD                       0x0b000000
+#define A64_ADDS                      0x2b000000
+#define A64_SUB                       0x4b000000
+#define A64_NEG                       0x4b0003e0
+#define A64_SUBS                      0x6b000000
+#define A64_CMP                       0x6b00001f
+#define A64_SBFM                      0x93400000
+#define A64_UBFM                      0x53400000
+#define A64_UBFX                      0x53000000
+#define A64_B                         0x14000000
+#define A64_BL                        0x94000000
+#define A64_BR                        0xd61f0000
+#define A64_BLR                       0xd63f0000
+#define A64_RET                       0xd65f0000
+#define A64_CBZ                       0x34000000
+#define A64_CBNZ                      0x35000000
+#define A64_B_C                       0x54000000
+#define A64_REV                       0xdac00c00
+#define A64_UDIV                      0x1ac00800
+#define A64_SDIV                      0x1ac00c00
+#define A64_LSL                       0x1ac02000
+#define A64_LSR                       0x1ac02400
+#define A64_ASR                       0x1ac02800
+#define A64_MUL                       0x1b007c00
+#define A64_SMULH                     0x9b407c00
+#define A64_UMULH                     0x9bc07c00
+#define A64_LDAR                      0xc8dffc00
+#define A64_STLR                      0xc89ffc00
+#define A64_LDAXR                     0xc85ffc00
+#define A64_STLXR                     0xc800fc00
+#define A64_STRBI                     0x39000000
+#define A64_LDRBI                     0x39400000
+#define A64_LDRSBI                    0x39800000
+#define A64_STRI                      0xf9000000
+#define A64_LDRI                      0xf9400000
+#define A64_LDRI_LITERAL              0x58000000
+#define A64_STRHI                     0x79000000
+#define A64_LDRHI                     0x79400000
+#define A64_LDRSHI                    0x79800000
+#define A64_STRWI                     0xb9000000
+#define A64_LDRWI                     0xb9400000
+#define A64_LDRSWI                    0xb9800000
+#define A64_STRB                      0x38206800
+#define A64_LDRB                      0x38606800
+#define A64_LDRSB                     0x38e06800
+#define A64_STR                       0xf8206800
+#define A64_LDR                       0xf8606800
+#define A64_STRH                      0x78206800
+#define A64_LDRH                      0x78606800
+#define A64_LDRSH                     0x78a06800
+#define A64_STRW                      0xb8206800
+#define A64_LDRW                      0xb8606800
+#define A64_LDRSW                     0xb8a06800
+#define A64_STURB                     0x38000000
+#define A64_LDURB                     0x38400000
+#define A64_LDURSB                    0x38800000
+#define A64_STUR                      0xf8000000
+#define A64_LDUR                      0xf8400000
+#define A64_STURH                     0x78000000
+#define A64_LDURH                     0x78400000
+#define A64_LDURSH                    0x78800000
+#define A64_STURW                     0xb8000000
+#define A64_LDURW                     0xb8400000
+#define A64_LDURSW                    0xb8800000
+#define A64_ANDI                      0x12400000
+#define A64_ORRI                      0x32400000
+#define A64_EORI                      0x52400000
+#define A64_ANDSI                     0x72000000
+#define A64_AND                       0x0a000000
+#define A64_ORR                       0x2a000000
+#define A64_MOV                       0x2a0003e0      /* AKA orr Rd,xzr,Rm */
+#define A64_MVN                       0x2a2003e0
+#define A64_UXTW                      0x2a0003e0      /* AKA MOV */
+#define A64_EOR                       0x4a000000
+#define A64_ANDS                      0x6a000000
+#define A64_MOVN                      0x12800000
+#define A64_MOVZ                      0x52800000
+#define A64_MOVK                      0x72800000
+#define A64_BRK                       0xd4200000
+
+static void
+SBFM(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t ImmR, int32_t ImmS) 
+{
+  return oxxrs(_jit, A64_SBFM|XS,Rd,Rn,ImmR,ImmS);
+}
+
+static void
+UBFM(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t ImmR, int32_t ImmS) 
+{
+  return oxxrs(_jit, A64_UBFM|XS,Rd,Rn,ImmR,ImmS);
+}
+
+static void
+UBFX(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t ImmR, int32_t ImmS) 
+{
+  return oxxrs(_jit, A64_UBFX,Rd,Rn,ImmR,ImmS);
+}
+
+static void
+CMP(jit_state_t *_jit, int32_t Rn, int32_t Rm) 
+{
+  return oxx_(_jit, A64_CMP|XS,Rn,Rm);
+}
+
+static void
+CMPI(jit_state_t *_jit, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBSI|XS,XZR_REGNO,Rn,Imm12);
+}
+
+static void
+CMPI_12(jit_state_t *_jit, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBSI|XS|LSL_12,XZR_REGNO,Rn,Imm12);
+}
+
+static void
+CMNI(jit_state_t *_jit, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDSI|XS,XZR_REGNO,Rn,Imm12);
+}
+
+static void
+CMNI_12(jit_state_t *_jit, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDSI|XS|LSL_12,XZR_REGNO,Rn,Imm12);
+}
+
+static void
+TST(jit_state_t *_jit, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ANDS|XS,XZR_REGNO,Rn,Rm);
+}
+
+/* actually should use oxxrs but logical_immediate returns proper encoding */
+static void
+TSTI(jit_state_t *_jit, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ANDSI,XZR_REGNO,Rn,Imm12);
+}
+
+static void
+MOV(jit_state_t *_jit, int32_t Rd, int32_t Rm) 
+{
+  return ox_x(_jit, A64_MOV|XS,Rd,Rm);
+}
+
+static void
+MVN(jit_state_t *_jit, int32_t Rd, int32_t Rm) 
+{
+  return ox_x(_jit, A64_MVN|XS,Rd,Rm);
+}
+
+static void
+NEG(jit_state_t *_jit, int32_t Rd, int32_t Rm) 
+{
+  return ox_x(_jit, A64_NEG|XS,Rd,Rm);
+}
+
+static void
+MOVN(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVN|XS,Rd,Imm16);
+}
+
+static void
+MOVN_16(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVN|XS|MOVI_LSL_16,Rd,Imm16);
+}
+
+static void
+MOVN_32(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVN|XS|MOVI_LSL_32,Rd,Imm16);
+}
+
+static void
+MOVN_48(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVN|XS|MOVI_LSL_48,Rd,Imm16);
+}
+
+static void
+MOVZ(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVZ|XS,Rd,Imm16);
+}
+
+static void
+MOVZ_16(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVZ|XS|MOVI_LSL_16,Rd,Imm16);
+}
+
+static void
+MOVZ_32(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVZ|XS|MOVI_LSL_32,Rd,Imm16);
+}
+
+static void
+MOVZ_48(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVZ|XS|MOVI_LSL_48,Rd,Imm16);
+}
+
+static void
+MOVK_16(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVK|XS|MOVI_LSL_16,Rd,Imm16);
+}
+
+static void
+MOVK_32(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVK|XS|MOVI_LSL_32,Rd,Imm16);
+}
+
+static void
+MOVK_48(jit_state_t *_jit, int32_t Rd, int32_t Imm16) 
+{
+  return ox_h(_jit, A64_MOVK|XS|MOVI_LSL_48,Rd,Imm16);
+}
+
+static void
+ADD(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ADD|XS,Rd,Rn,Rm);
+}
+
+static void
+ADDI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDI|XS,Rd,Rn,Imm12);
+}
+
+static void
+ADDI_12(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDI|XS|LSL_12,Rd,Rn,Imm12);
+}
+
+static void
+ADDS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ADDS|XS,Rd,Rn,Rm);
+}
+
+static void
+ADDSI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDSI|XS,Rd,Rn,Imm12);
+}
+
+static void
+ADDSI_12(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ADDSI|XS|LSL_12,Rd,Rn,Imm12);
+}
+
+static void
+ADCS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ADCS|XS,Rd,Rn,Rm);
+}
+
+static void
+SUB(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_SUB|XS,Rd,Rn,Rm);
+}
+
+static void
+SUBI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBI|XS,Rd,Rn,Imm12);
+}
+
+static void
+SUBI_12(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBI|XS|LSL_12,Rd,Rn,Imm12);
+}
+
+static void
+SUBS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_SUBS|XS,Rd,Rn,Rm);
+}
+
+static void
+SUBSI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBSI|XS,Rd,Rn,Imm12);
+}
+
+static void
+SUBSI_12(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_SUBSI|XS|LSL_12,Rd,Rn,Imm12);
+}
+
+static void
+SBCS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_SBCS|XS,Rd,Rn,Rm);
+}
+
+static void
+MUL(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_MUL|XS,Rd,Rn,Rm);
+}
+
+static void
+SMULH(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_SMULH,Rd,Rn,Rm);
+}
+
+static void
+UMULH(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_UMULH,Rd,Rn,Rm);
+}
+
+static void
+SDIV(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_SDIV|XS,Rd,Rn,Rm);
+}
+
+static void
+UDIV(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_UDIV|XS,Rd,Rn,Rm);
+}
+
+static void
+LSL(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LSL|XS,Rd,Rn,Rm);
+}
+
+static void
+LSLI(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0) 
+{
+  return UBFM(_jit, r0,r1,(64-i0)&63,63-i0);
+}
+
+static void
+ASR(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ASR|XS,Rd,Rn,Rm);
+}
+
+static void
+ASRI(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0) 
+{
+  return SBFM(_jit, r0,r1,i0,63);
+}
+
+static void
+LSR(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LSR|XS,Rd,Rn,Rm);
+}
+
+static void
+LSRI(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0) 
+{
+  return UBFM(_jit, r0,r1,i0,63);
+}
+
+static void
+AND(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_AND|XS,Rd,Rn,Rm);
+}
+
+/* actually should use oxxrs but logical_immediate returns proper encoding */;
+static void
+ANDI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ANDI|XS,Rd,Rn,Imm12);
+}
+
+static void
+ORR(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_ORR|XS,Rd,Rn,Rm);
+}
+
+/* actually should use oxxrs but logical_immediate returns proper encoding */
+static void
+ORRI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_ORRI|XS,Rd,Rn,Imm12);
+}
+
+static void
+EOR(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_EOR|XS,Rd,Rn,Rm);
+}
+
+/* actually should use oxxrs but logical_immediate returns proper encoding */
+static void
+EORI(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_EORI|XS,Rd,Rn,Imm12);
+}
+
+static void
+SXTB(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return SBFM(_jit, Rd,Rn,0,7);
+}
+
+static void
+SXTH(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return SBFM(_jit, Rd,Rn,0,15);
+}
+
+static void
+SXTW(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return SBFM(_jit, Rd,Rn,0,31);
+}
+
+static void
+UXTB(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return UBFX(_jit, Rd,Rn,0,7);
+}
+
+static void
+UXTH(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return UBFX(_jit, Rd,Rn,0,15);
+}
+
+static void
+UXTW(jit_state_t *_jit, int32_t Rd, int32_t Rm) 
+{
+  return ox_x(_jit, A64_UXTW,Rd,Rm);
+}
+
+static void
+REV(jit_state_t *_jit, int32_t Rd, int32_t Rn) 
+{
+  return o_xx(_jit, A64_REV,Rd,Rn);
+}
+
+static void
+LDAR(jit_state_t *_jit, int32_t Rt, int32_t Rn) 
+{
+  return o_xx(_jit, A64_LDAR, Rt, Rn);
+}
+
+static void
+STLR(jit_state_t *_jit, int32_t Rt, int32_t Rn) 
+{
+  return o_xx(_jit, A64_STLR, Rt, Rn);
+}
+
+static void
+LDAXR(jit_state_t *_jit, int32_t Rt, int32_t Rn) 
+{
+  return o_xx(_jit, A64_LDAXR, Rt, Rn);
+}
+
+static void
+STLXR(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm)
+{
+  return oxxx(_jit, A64_STLXR, Rt, Rn, Rm);
+}
+
+static void
+LDRSB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRSB,Rt,Rn,Rm);
+}
+
+static void
+LDRSBI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRSBI,Rt,Rn,Imm12);
+}
+
+static void
+LDURSB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURSB,Rt,Rn,Imm9);
+}
+
+static void
+LDRB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRB,Rt,Rn,Rm);
+}
+
+static void
+LDRBI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRBI,Rt,Rn,Imm12);
+}
+
+static void
+LDURB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURB,Rt,Rn,Imm9);
+}
+
+static void
+LDRSH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRSH,Rt,Rn,Rm);
+}
+
+static void
+LDRSHI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRSHI,Rt,Rn,Imm12);
+}
+
+static void
+LDURSH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURSH,Rt,Rn,Imm9);
+}
+
+static void
+LDRH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRH,Rt,Rn,Rm);
+}
+
+static void
+LDRHI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRHI,Rt,Rn,Imm12);
+}
+
+static void
+LDURH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURH,Rt,Rn,Imm9);
+}
+
+static void
+LDRSW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRSW,Rt,Rn,Rm);
+}
+
+static void
+LDRSWI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRSWI,Rt,Rn,Imm12);
+}
+
+static void
+LDURSW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURSW,Rt,Rn,Imm9);
+}
+
+static void
+LDRW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDRW,Rt,Rn,Rm);
+}
+
+static void
+LDRWI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRWI,Rt,Rn,Imm12);
+}
+
+static void
+LDURW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDURW,Rt,Rn,Imm9);
+}
+
+static void
+LDR(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_LDR,Rt,Rn,Rm);
+}
+
+static void
+LDRI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_LDRI,Rt,Rn,Imm12);
+}
+
+static void
+LDUR(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_LDUR,Rt,Rn,Imm9);
+}
+
+static void
+STRB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_STRB,Rt,Rn,Rm);
+}
+
+static void
+STRBI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_STRBI,Rt,Rn,Imm12);
+}
+
+static void
+STURB(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_STURB,Rt,Rn,Imm9);
+}
+
+static void
+STRH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_STRH,Rt,Rn,Rm);
+}
+
+static void
+STRHI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_STRHI,Rt,Rn,Imm12);
+}
+
+static void
+STURH(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_STURH,Rt,Rn,Imm9);
+}
+
+static void
+STRW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_STRW,Rt,Rn,Rm);
+}
+
+static void
+STRWI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_STRWI,Rt,Rn,Imm12);
+}
+
+static void
+STURW(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_STURW,Rt,Rn,Imm9);
+}
+
+static void
+STR(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Rm) 
+{
+  return oxxx(_jit, A64_STR,Rt,Rn,Rm);
+}
+
+static void
+STRI(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm12) 
+{
+  return oxxi(_jit, A64_STRI,Rt,Rn,Imm12);
+}
+
+static void
+STUR(jit_state_t *_jit, int32_t Rt, int32_t Rn, int32_t Imm9) 
+{
+  return oxx9(_jit, A64_STUR,Rt,Rn,Imm9);
+}
+
+static jit_reloc_t
+B(jit_state_t *_jit)
+{
+  return emit_jmp(_jit, encode_o26(A64_B));
+}
+
+static jit_reloc_t
+BL(jit_state_t *_jit)
+{
+  return emit_jmp(_jit, encode_o26(A64_BL));
+}
+
+static void
+BR(jit_state_t *_jit, int32_t Rn) 
+{
+  return o_x_(_jit, A64_BR,Rn);
+}
+
+static void
+BLR(jit_state_t *_jit, int32_t Rn)
+{
+  return o_x_(_jit, A64_BLR,Rn);
+}
+
+static void
+RET(jit_state_t *_jit)
+{
+  return o_x_(_jit, A64_RET,jit_gpr_regno(_LR));
+}
+
+static jit_reloc_t
+B_C(jit_state_t *_jit, int32_t Cc) 
+{
+  return emit_jcc(_jit, encode_oc19(A64_B_C, Cc));
+}
+
+static jit_reloc_t
+CBZ(jit_state_t *_jit, int32_t Rd) 
+{
+  return emit_jcc(_jit, encode_ox19(A64_CBZ|XS,Rd));
+}
+
+static jit_reloc_t
+CBNZ(jit_state_t *_jit, int32_t Rd) 
+{
+  return emit_jcc(_jit, encode_ox19(A64_CBNZ|XS,Rd));
+}
+
+static void
+NOP(jit_state_t *_jit)
+{
+  return emit_u32_with_pool(_jit, 0xd503201f);
+}
+
+static void
+BRK(jit_state_t *_jit)
+{
+  emit_u32_with_pool(_jit, A64_BRK);
+}
+
+static jit_reloc_t
+movi_from_pool(jit_state_t *_jit, int32_t Rt)
+{
+  return emit_load_from_pool(_jit, encode_ox19(A64_LDRI_LITERAL, Rt));
+}
+
+static void
+emit_veneer(jit_state_t *_jit, jit_pointer_t target)
+{
+  jit_gpr_t tmp = get_temp_gpr(_jit);
+  uint32_t ldr = encode_ox19(A64_LDRI_LITERAL, jit_gpr_regno(tmp));
+  uint32_t br = write_Rn_bitfield(A64_BR, jit_gpr_regno(tmp));
+  uint32_t *loc = _jit->pc.ui;
+  emit_u32(_jit, ldr);
+  emit_u32(_jit, br);
+  unget_temp_gpr(_jit);
+  if (_jit->overflow)
+    return;
+  // Patch load to here, divided by 4.
+  patch_load_from_pool_offset(loc, _jit->pc.ui - loc);
+  emit_u64(_jit, (uint64_t) target);
+}
+
+static void
+movr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    MOV(_jit, r0, r1);
+}
+
+static void
+addr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return ADD(_jit,r0,r1,r2);
+}
+
+static void
+addcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return ADDS(_jit,r0,r1,r2);
+}
+
+static void
+addxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return ADCS(_jit,r0,r1,r2);
+}
+
+static void
+subr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return SUB(_jit,r0,r1,r2);
+}
+
+static void
+subcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return SUBS(_jit,r0,r1,r2);
+}
+
+static void
+subxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return SBCS(_jit,r0,r1,r2);
+}
+
+static void
+mulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return MUL(_jit,r0,r1,r2);
+}
+
+static void
+divr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return SDIV(_jit,r0,r1,r2);
+}
+
+static void
+divr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return UDIV(_jit,r0,r1,r2);
+}
+
+static void
+iqdivr(jit_state_t *_jit, jit_bool_t sign,
+       int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  int32_t rg0, rg1;
+  if (r0 == r2 || r0 == r3) {
+    rg0 = jit_gpr_regno(get_temp_gpr(_jit));
+  } else {
+    rg0 = r0;
+  }
+  if (r1 == r2 || r1 == r3) {
+    rg1 = jit_gpr_regno(get_temp_gpr(_jit));
+  } else {
+    rg1 = r1;
+  }
+  if (sign)
+    divr(_jit, rg0, r2, r3);
+  else
+    divr_u(_jit, rg0, r2, r3);
+  mulr(_jit, rg1, r3, rg0);
+  subr(_jit, rg1, r2, rg1);
+  if (rg0 != r0) {
+    movr(_jit, r0, rg0);
+    unget_temp_gpr(_jit);
+  }
+  if (rg1 != r1) {
+    movr(_jit, r1, rg1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+qdivr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit,1,r0,r1,r2,r3);
+}
+
+static void
+qdivr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit,0,r0,r1,r2,r3);
+}
+
+static void
+lshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return LSL(_jit,r0,r1,r2);
+}
+
+static void
+rshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return ASR(_jit,r0,r1,r2);
+}
+
+static void
+rshr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return LSR(_jit,r0,r1,r2);
+}
+
+static void
+negr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return NEG(_jit,r0,r1);
+}
+
+static void
+comr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return MVN(_jit,r0,r1);
+}
+
+static void
+andr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return AND(_jit,r0,r1,r2);
+}
+
+static void
+orr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return ORR(_jit,r0,r1,r2);
+}
+
+static void
+xorr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return EOR(_jit,r0,r1,r2);
+}
+
+static void
+ldr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return LDRSBI(_jit,r0,r1,0);
+}
+
+static void
+ldr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return LDRSHI(_jit,r0,r1,0);
+}
+
+static void
+ldr_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return LDRSWI(_jit,r0,r1,0);
+}
+
+static void
+ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return LDRSH(_jit,r0,r1,r2);
+}
+
+static void
+ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return LDRSW(_jit,r0,r1,r2);
+}
+
+static void
+ldxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return LDR(_jit,r0,r1,r2);
+}
+
+static void
+str_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return STRBI(_jit,r1,r0,0);
+}
+
+static void
+str_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return STRHI(_jit,r1,r0,0);
+}
+
+static void
+str_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return STRWI(_jit,r1,r0,0);
+}
+
+static void
+str_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return STRI(_jit,r1,r0,0);
+}
+
+static void
+stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return STRB(_jit,r2,r1,r0);
+}
+
+static void
+stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return STRH(_jit,r2,r1,r0);
+}
+
+static void
+stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return STRW(_jit,r2,r1,r0);
+}
+
+static void
+stxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return STR(_jit,r2,r1,r0);
+}
+
+static void
+bswapr_ul(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return REV(_jit,r0,r1);
+}
+
+static void
+extr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return SXTB(_jit,r0,r1);
+}
+
+static void
+extr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return UXTB(_jit,r0,r1);
+}
+
+static void
+extr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return SXTH(_jit,r0,r1);
+}
+
+static void
+extr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return UXTH(_jit,r0,r1);
+}
+
+static void
+extr_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return SXTW(_jit,r0,r1);
+}
+
+static void
+extr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return UXTW(_jit,r0,r1);
+}
+
+static void
+movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_word_t n0 = ~i0, ibit = 0, nbit = 0;
+  if (i0 & 0x000000000000ffffL)       ibit |= 1;
+  if (i0 & 0x00000000ffff0000L)       ibit |= 2;
+  if (i0 & 0x0000ffff00000000L)       ibit |= 4;
+  if (i0 & 0xffff000000000000L)       ibit |= 8;
+  if (n0 & 0x000000000000ffffL)       nbit |= 1;
+  if (n0 & 0x00000000ffff0000L)       nbit |= 2;
+  if (n0 & 0x0000ffff00000000L)       nbit |= 4;
+  if (n0 & 0xffff000000000000L)       nbit |= 8;
+  switch (ibit) {
+  case 0:
+    MOVZ   (_jit, r0,  0);
+    break;
+  case 1:
+    MOVZ   (_jit, r0,  i0        & 0xffff);
+    break;
+  case 2:
+    MOVZ_16(_jit, r0, (i0 >> 16) & 0xffff);
+    break;
+  case 3:
+    MOVZ   (_jit, r0,  i0        & 0xffff);
+    MOVK_16(_jit, r0, (i0 >> 16) & 0xffff);
+    break;
+  case 4:
+    MOVZ_32(_jit, r0, (i0 >> 32) & 0xffff);
+    break;
+  case 5:
+    MOVZ   (_jit, r0,  i0        & 0xffff);
+    MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+    break;
+  case 6:
+    MOVZ_16(_jit, r0, (i0 >> 16) & 0xffff);
+    MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+    break;
+  case 7:
+    if (nbit == 8) {
+      MOVN_48(_jit, r0, (n0 >> 48) & 0xffff);
+    } else {
+      MOVZ   (_jit, r0,  i0        & 0xffff);
+      MOVK_16(_jit, r0, (i0 >> 16) & 0xffff);
+      MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+    }
+    break;
+  case 8:
+    MOVZ_48(_jit, r0, (i0 >> 48) & 0xffff);
+    break;
+  case 9:
+    MOVZ   (_jit, r0,  i0        & 0xffff);
+    MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    break;
+  case 10:
+    MOVZ_16(_jit, r0, (i0 >> 16) & 0xffff);
+    MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    break;
+  case 11:
+    if (nbit == 4) {
+      MOVN_32(_jit, r0, (n0 >> 32) & 0xffff);
+    } else {
+      MOVZ   (_jit, r0,  i0        & 0xffff);
+      MOVK_16(_jit, r0, (i0 >> 16) & 0xffff);
+      MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    }
+    break;
+  case 12:
+    MOVZ_32(_jit, r0, (i0 >> 32) & 0xffff);
+    MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    break;
+  case 13:
+    if (nbit == 2) {
+      MOVN_16(_jit, r0, (n0 >> 16) & 0xffff);
+    } else {
+      MOVZ   (_jit, r0,  i0        & 0xffff);
+      MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+      MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    }
+    break;
+  case 14:
+    if (nbit == 1) {
+      MOVN   (_jit, r0, (n0)       & 0xffff);
+    } else {
+      MOVZ_16(_jit, r0, (i0 >> 16) & 0xffff);
+      MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+      MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    }
+    break;
+  case 15:
+    if (nbit == 0) {
+      MOVN   (_jit, r0,  0);
+    } else if (nbit == 1) {
+      MOVN   (_jit, r0,  n0        & 0xffff);
+    } else if (nbit == 8) {
+      MOVN_48(_jit, r0, (n0 >> 48) & 0xffff);
+    } else {
+      MOVZ   (_jit, r0,  i0        & 0xffff);
+      MOVK_16(_jit, r0, (i0 >> 16) & 0xffff);
+      MOVK_32(_jit, r0, (i0 >> 32) & 0xffff);
+      MOVK_48(_jit, r0, (i0 >> 48) & 0xffff);
+    }
+    break;
+  default:
+    abort();
+  }
+}
+
+static jit_reloc_t
+bccr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  CMP(_jit, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bcci(jit_state_t *_jit, int32_t cc, int32_t r0, jit_word_t i1)
+{
+  jit_word_t          is =  i1 >> 12;
+  jit_word_t          in = -i1;
+  jit_word_t          iS =  in >> 12;
+  if (      i1 >= 0 && i1 <= 0xfff) {
+    CMPI   (_jit, r0, i1);
+  } else if ((is << 12) == i1 && is >= 0 && is <= 0xfff) {
+    CMPI_12(_jit, r0, is);
+  } else if ( in >= 0 && in <= 0xfff) {
+    CMNI   (_jit, r0, in);
+  } else if ((iS << 12) == is && iS >= 0 && iS <= 0xfff) {
+    CMNI_12(_jit, r0, iS);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    CMP(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bltr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_LT,r0,r1);
+}
+
+static jit_reloc_t
+blti(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_LT,r0,i1);
+}
+
+static jit_reloc_t
+bltr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_CC,r0,r1);
+}
+
+static jit_reloc_t
+blti_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_CC,r0,i1);
+}
+
+static jit_reloc_t
+bler(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_LE,r0,r1);
+}
+
+static jit_reloc_t
+blei(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_LE,r0,i1);
+}
+
+static jit_reloc_t
+bler_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_LS,r0,r1);
+}
+
+static jit_reloc_t
+blei_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_LS,r0,i1);
+}
+
+static jit_reloc_t
+beqr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_EQ,r0,r1);
+}
+
+static jit_reloc_t
+bger(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_GE,r0,r1);
+}
+
+static jit_reloc_t
+bgei(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_GE,r0,i1);
+}
+
+static jit_reloc_t
+bger_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_CS,r0,r1);
+}
+
+static jit_reloc_t
+bgei_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_CS,r0,i1);
+}
+
+static jit_reloc_t
+bgtr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_GT,r0,r1);
+}
+
+static jit_reloc_t
+bgti(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_GT,r0,i1);
+}
+
+static jit_reloc_t
+bgtr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_HI,r0,r1);
+}
+
+static jit_reloc_t
+bgti_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit,BCC_HI,r0,i1);
+}
+
+static jit_reloc_t
+bner(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit,BCC_NE,r0,r1);
+}
+
+static void
+addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_word_t          is =  i0 >> 12;
+  jit_word_t          in = -i0;
+  jit_word_t          iS =  in >> 12;
+  if (      i0 >= 0 && i0 <= 0xfff) {
+    ADDI   (_jit, r0, r1, i0);
+  } else if ((is << 12) == i0 && is >= 0 && is <= 0xfff) {
+    ADDI_12(_jit, r0, r1, is);
+  } else if ( in >= 0 && in <= 0xfff) {
+    SUBI   (_jit, r0, r1, in);
+  } else if ((iS << 12) == is && iS >= 0 && iS <= 0xfff) {
+    SUBI_12(_jit, r0, r1, iS);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    addr(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_word_t          is =  i0 >> 12;
+  jit_word_t          in = -i0;
+  jit_word_t          iS =  in >> 12;
+  if (      i0 >= 0 && i0 <= 0xfff) {
+    ADDSI   (_jit, r0, r1, i0);
+  } else if ((is << 12) == i0 && is >= 0 && is <= 0xfff) {
+    ADDSI_12(_jit, r0, r1, is);
+  } else if ( in >= 0 && in <= 0xfff) {
+    SUBSI   (_jit, r0, r1, in);
+  } else if ((iS << 12) == is && iS >= 0 && iS <= 0xfff) {
+    SUBSI_12(_jit, r0, r1, iS);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    addcr(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+  movi(_jit, r2, i0);
+  addxr(_jit, r0, r1, r2);
+  if (r0 == r1)
+    unget_temp_gpr(_jit);
+}
+
+static void
+subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_word_t          is = i0 >> 12;
+  if (      i0 >= 0 && i0 <= 0xfff) {
+    SUBI   (_jit, r0, r1, i0);
+  } else if ((is << 12) == i0 && is >= 0 && is <= 0xfff) {
+    SUBI_12(_jit, r0, r1, is);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    subr(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_word_t          is = i0 >> 12;
+  if (      i0 >= 0 && i0 <= 0xfff) {
+    SUBSI   (_jit, r0, r1, i0);
+  } else if ((is << 12) == i0 && is >= 0 && is <= 0xfff) {
+    SUBSI_12(_jit, r0, r1, is);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    subcr(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+  movi(_jit, r2, i0);
+  subxr(_jit, r0, r1, r2);
+  if (r0 == r1)
+    unget_temp_gpr(_jit);
+}
+
+static jit_reloc_t
+baddr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  addcr(_jit, r0, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+baddi(jit_state_t *_jit, int32_t cc, int32_t r0, jit_word_t i1)
+{
+  addci(_jit, r0, r0, i1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+boaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit,BCC_VS,r0,r1);
+}
+
+static jit_reloc_t
+boaddi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit,BCC_VS,r0,i1);
+}
+
+static jit_reloc_t
+boaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit,BCC_HS,r0,r1);
+}
+
+static jit_reloc_t
+boaddi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit,BCC_HS,r0,i1);
+}
+
+static jit_reloc_t
+bxaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit,BCC_VC,r0,r1);
+}
+
+static jit_reloc_t
+bxaddi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit,BCC_VC,r0,i1);
+}
+
+static jit_reloc_t
+bxaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit,BCC_LO,r0,r1);
+}
+
+static jit_reloc_t
+bxaddi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit,BCC_LO,r0,i1);
+}
+
+static jit_reloc_t
+bsubr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  subcr(_jit, r0, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bsubi(jit_state_t *_jit, int32_t cc, int32_t r0, jit_word_t i1)
+{
+  subci(_jit, r0, r0, i1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bosubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit,BCC_VS,r0,r1);
+}
+
+static jit_reloc_t
+bosubi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit,BCC_VS,r0,i1);
+}
+
+static jit_reloc_t
+bosubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit,BCC_LO,r0,r1);
+}
+
+static jit_reloc_t
+bosubi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit,BCC_LO,r0,i1);
+}
+
+static jit_reloc_t
+bxsubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit,BCC_VC,r0,r1);
+}
+
+static jit_reloc_t
+bxsubi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit,BCC_VC,r0,i1);
+}
+
+static jit_reloc_t
+bxsubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit,BCC_HS,r0,r1);
+}
+
+static jit_reloc_t
+bxsubi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit,BCC_HS,r0,i1);
+}
+
+static jit_reloc_t
+bmxr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  TST(_jit, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bmxi(jit_state_t *_jit, int32_t cc, int32_t r0, jit_word_t i1)
+{
+  int32_t             imm;
+  imm = logical_immediate(i1);
+  if (imm != -1) {
+    TSTI(_jit, r0, imm);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    TST(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bmsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bmxr(_jit,BCC_NE,r0,r1);
+}
+
+static jit_reloc_t
+bmsi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bmxi(_jit,BCC_NE,r0,i1);
+}
+
+static jit_reloc_t
+bmcr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bmxr(_jit,BCC_EQ,r0,r1);
+}
+
+static jit_reloc_t
+bmci(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bmxi(_jit,BCC_EQ,r0,i1);
+}
+
+static void
+jmpr(jit_state_t *_jit, int32_t r0)
+{
+  return BR(_jit, r0);
+}
+
+static void
+callr(jit_state_t *_jit, int32_t r0)
+{
+  return BLR(_jit,r0);
+}
+
+static void
+nop(jit_state_t *_jit, int32_t i0)
+{
+  for (; i0 > 0; i0 -= 4)
+    NOP(_jit);
+  ASSERT(i0 == 0);
+}
+
+static void
+muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+  movi(_jit, r2, i0);
+  mulr(_jit, r0, r1, r2);
+  if (r0 == r1)
+    unget_temp_gpr(_jit);
+}
+
+static void
+qmulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  jit_gpr_t reg;
+  if (r0 == r2 || r0 == r3) {
+    reg = get_temp_gpr(_jit);
+    mulr(_jit, jit_gpr_regno(reg), r2, r3);
+  } else {
+    mulr(_jit, r0, r2, r3);
+  }
+  SMULH(_jit, r1, r2, r3);
+  if (r0 == r2 || r0 == r3) {
+    movr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+qmuli(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  qmulr(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+qmulr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  jit_gpr_t reg;
+  if (r0 == r2 || r0 == r3) {
+    reg = get_temp_gpr(_jit);
+    mulr(_jit, jit_gpr_regno(reg), r2, r3);
+  } else {
+    mulr(_jit, r0, r2, r3);
+  }
+  UMULH(_jit, r1, r2, r3);
+  if (r0 == r2 || r0 == r3) {
+    movr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+qmuli_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  qmulr_u(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+  movi(_jit, r2, i0);
+  divr(_jit, r0, r1, r2);
+  if (r0 == r1)
+    unget_temp_gpr(_jit);
+}
+
+static void
+divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+  movi(_jit, r2, i0);
+  divr_u(_jit, r0, r1, r2);
+  if (r0 == r1)
+    unget_temp_gpr(_jit);
+}
+
+static void
+qdivi(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  qdivr(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+qdivi_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  qdivr_u(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1 || r0 == r2) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    divr(_jit, jit_gpr_regno(reg), r1, r2);
+    mulr(_jit, jit_gpr_regno(reg), r2, jit_gpr_regno(reg));
+    subr(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    divr(_jit, r0, r1, r2);
+    mulr(_jit, r0, r2, r0);
+    subr(_jit, r0, r1, r0);
+  }
+}
+
+static void
+remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  remr(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1 || r0 == r2) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    divr_u(_jit, jit_gpr_regno(reg), r1, r2);
+    mulr(_jit, jit_gpr_regno(reg), r2, jit_gpr_regno(reg));
+    subr(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    divr_u(_jit, r0, r1, r2);
+    mulr(_jit, r0, r2, r0);
+    subr(_jit, r0, r1, r0);
+  }
+}
+
+static void
+remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  remr_u(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0) {
+    movr(_jit, r0, r1);
+  } else {
+    ASSERT(i0 > 0 && i0 < 64);
+    LSLI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+rshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0) {
+    movr(_jit, r0, r1);
+  } else {
+    ASSERT(i0 > 0 && i0 < 64);
+    ASRI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0) {
+    movr(_jit, r0, r1);
+  } else {
+    ASSERT(i0 > 0 && i0 < 64);
+    LSRI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t             imm;
+  if (i0 == 0) {
+    movi(_jit, r0, 0);
+  } else if (i0 == -1){
+    movr(_jit, r0, r1);
+  } else {
+    imm = logical_immediate(i0);
+    if (imm != -1) {
+      ANDI(_jit, r0, r1, imm);
+    } else {
+      int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+      movi(_jit, r2, i0);
+      andr(_jit, r0, r1, r2);
+      if (r0 == r1)
+        unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t             imm;
+  if (i0 == 0) {
+    movr(_jit, r0, r1);
+  } else if (i0 == -1) {
+    movi(_jit, r0, -1);
+  } else {
+    imm = logical_immediate(i0);
+    if (imm != -1) {
+      ORRI(_jit, r0, r1, imm);
+    } else {
+      int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+      movi(_jit, r2, i0);
+      orr(_jit, r0, r1, r2);
+      if (r0 == r1)
+        unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int32_t             imm;
+  if (i0 == 0) {
+    movr(_jit, r0, r1);
+  } else if (i0 == -1) {
+    comr(_jit, r0, r1);
+  } else {
+    imm = logical_immediate(i0);
+    if (imm != -1) {
+      EORI(_jit, r0, r1, imm);
+    } else {
+      int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+      movi(_jit, r2, i0);
+      xorr(_jit, r0, r1, r2);
+      if (r0 == r1)
+        unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+bswapr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  bswapr_ul(_jit, r0, r1);
+  rshi_u(_jit, r0, r0, 48);
+}
+
+static void
+bswapr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  bswapr_ul(_jit, r0, r1);
+  rshi_u(_jit, r0, r0, 32);
+}
+
+static void
+ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_c(_jit, r0, r0);
+}
+
+static void
+ldr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  LDRBI(_jit, r0, r1, 0);
+#if 0
+  extr_uc(_jit, r0, r0);
+#endif
+}
+
+static void
+ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_uc(_jit, r0, r0);
+}
+
+static void
+ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_s(_jit, r0, r0);
+}
+
+static void
+ldr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  LDRHI(_jit, r0, r1, 0);
+#if 0
+  extr_us(_jit, r0, r0);
+#endif
+}
+
+static void
+ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_us(_jit, r0, r0);
+}
+
+static void
+ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_i(_jit, r0, r0);
+}
+
+static void
+ldr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  LDRWI(_jit, r0, r1, 0);
+#if 0
+  extr_ui(_jit, r0, r0);
+#endif
+}
+
+static void
+ldi_ui(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_ui(_jit, r0, r0);
+}
+
+static void
+ldr_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  LDRI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_l(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  movi(_jit, r0, i0);
+  ldr_l(_jit, r0, r0);
+}
+
+static void
+ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  LDRSB(_jit, r0, r1, r2);
+  extr_c(_jit, r0, r0);
+}
+
+static void
+ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 >= 0 && i0 <= 4095) {
+    LDRSBI(_jit, r0, r1, i0);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURSB(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    LDRSB(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+  extr_c(_jit, r0, r0);
+}
+
+static void
+ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  LDRB(_jit, r0, r1, r2);
+#if 0
+  extr_uc(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 >= 0 && i0 <= 4095) {
+    LDRBI(_jit, r0, r1, i0);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURB(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    addi(_jit, r2, r1, i0);
+    ldr_uc(_jit, r0, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+#if 0
+  extr_uc(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(!(i0 & 1));
+  if (i0 >= 0 && i0 <= 8191) {
+    LDRSHI(_jit, r0, r1, i0 >> 1);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURSH(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    LDRSH(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  LDRH(_jit, r0, r1, r2);
+#if 0
+  extr_us(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(!(i0 & 1));
+  if (i0 >= 0 && i0 <= 8191) {
+    LDRHI(_jit, r0, r1, i0 >> 1);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURH(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    LDRH(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+#if 0
+  extr_us(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(!(i0 & 3));
+  if (i0 >= 0 && i0 <= 16383) {
+    LDRSWI(_jit, r0, r1, i0 >> 2);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURSW(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    addi(_jit, r2, r1, i0);
+    ldr_i(_jit, r0, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_ui(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  LDRW(_jit, r0, r1, r2);
+#if 0
+  extr_ui(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_ui(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(!(i0 & 3));
+  if (i0 >= 0 && i0 <= 16383) {
+    LDRWI(_jit, r0, r1, i0 >> 2);
+  } else if (i0 > -256 && i0 < 0) {
+    LDURW(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    movi(_jit, r2, i0);
+    LDRW(_jit, r0, r1, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+#if 0
+  extr_ui(_jit, r0, r0);
+#endif
+}
+
+static void
+ldxi_l(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(!(i0 & 7));
+  if (i0 >= 0 && i0 <= 32767) {
+    LDRI(_jit, r0, r1, i0 >> 3);
+  } else if (i0 > -256 && i0 < 0) {
+    LDUR(_jit, r0, r1, i0);
+  } else {
+    int32_t r2 = (r0 == r1) ? jit_gpr_regno(get_temp_gpr(_jit)) : r0;
+    addi(_jit, r2, r1, i0);
+    ldr_l(_jit, r0, r2);
+    if (r0 == r1)
+      unget_temp_gpr(_jit);
+  }
+}
+
+static void
+sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  str_c(_jit, jit_gpr_regno(reg), r0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  str_s(_jit, jit_gpr_regno(reg), r0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  str_i(_jit, jit_gpr_regno(reg), r0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_l(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  str_l(_jit, jit_gpr_regno(reg), r0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (i0 >= 0 && i0 <= 4095) {
+    STRBI(_jit, r1, r0, i0);
+  } else if (i0 > -256 && i0 < 0) {
+    STURB(_jit, r1, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    addi(_jit, jit_gpr_regno(reg), r0, i0);
+    str_c(_jit, jit_gpr_regno(reg), r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  ASSERT(!(i0 & 1));
+  if (i0 >= 0 && i0 <= 8191) {
+    STRHI(_jit, r1, r0, i0 >> 1);
+  } else if (i0 > -256 && i0 < 0) {
+    STURH(_jit, r1, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    addi(_jit, jit_gpr_regno(reg), r0, i0);
+    str_s(_jit, jit_gpr_regno(reg), r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  ASSERT(!(i0 & 3));
+  if (i0 >= 0 && i0 <= 16383) {
+    STRWI(_jit, r1, r0, i0 >> 2);
+  } else if (i0 > -256 && i0 < 0) {
+    STURW(_jit, r1, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    addi(_jit, jit_gpr_regno(reg), r0, i0);
+    str_i(_jit, jit_gpr_regno(reg), r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxi_l(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  ASSERT(!(i0 & 7));
+  if (i0 >= 0 && i0 <= 32767) {
+    STRI(_jit, r1, r0, i0 >> 3);
+  } else if (i0 > -256 && i0 < 0) {
+    STUR(_jit, r1, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    addi(_jit, jit_gpr_regno(reg), r0, i0);
+    str_l(_jit, jit_gpr_regno(reg), r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static jit_reloc_t
+mov_addr(jit_state_t *_jit, int32_t r0)
+{
+  return movi_from_pool(_jit, r0);
+}
+
+static jit_reloc_t
+beqi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1 == 0) {
+    return CBZ(_jit, r0);
+  } else {
+    return bcci(_jit, BCC_EQ, r0, i1);
+  }
+}
+
+static jit_reloc_t
+bnei(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1 == 0) {
+    return CBNZ(_jit, r0);
+  } else {
+    return bcci(_jit, BCC_NE, r0, i1);
+  }
+}
+
+static jit_reloc_t
+jmp(jit_state_t *_jit)
+{
+  return B(_jit);
+}
+
+static void
+jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+  return jit_patch_there(_jit, jmp(_jit), (void*)i0);
+}
+
+static jit_reloc_t
+call(jit_state_t *_jit)
+{
+  return BL(_jit);
+}
+
+static void
+calli(jit_state_t *_jit, jit_word_t i0)
+{
+  return jit_patch_there(_jit, call(_jit), (void*)i0);
+}
+
+static void
+jmpi_with_link(jit_state_t *_jit, jit_word_t i0)
+{
+  return calli(_jit, i0);
+}
+
+static void
+push_link_register(jit_state_t *_jit)
+{
+}
+
+static void
+pop_link_register(jit_state_t *_jit)
+{
+}
+
+static void
+ret(jit_state_t *_jit)
+{
+  RET(_jit);
+}
+
+static void
+retr(jit_state_t *_jit, int32_t r)
+{
+  movr(_jit, jit_gpr_regno(_X0), r);
+  ret(_jit);
+}
+
+static void
+reti(jit_state_t *_jit, int32_t i)
+{
+  movi(_jit, jit_gpr_regno(_X0), i);
+  ret(_jit);
+}
+
+static void
+retval_c(jit_state_t *_jit, int32_t r0)
+{
+  extr_c(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_uc(jit_state_t *_jit, int32_t r0)
+{
+  extr_uc(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_s(jit_state_t *_jit, int32_t r0)
+{
+  extr_s(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_us(jit_state_t *_jit, int32_t r0)
+{
+  extr_us(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_i(jit_state_t *_jit, int32_t r0)
+{
+  extr_i(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_ui(jit_state_t *_jit, int32_t r0)
+{
+  extr_ui(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static void
+retval_l(jit_state_t *_jit, int32_t r0)
+{
+  movr(_jit, r0, jit_gpr_regno(_X0));
+}
+
+static uint32_t*
+jmp_without_veneer(jit_state_t *_jit)
+{
+  uint32_t *loc = _jit->pc.ui;
+  emit_u32(_jit, encode_o26(A64_B));
+  return loc;
+}
+
+static void
+patch_jmp_without_veneer(jit_state_t *_jit, uint32_t *loc)
+{
+  patch_jmp_offset(loc, _jit->pc.ui - loc);
+}
+
+static void
+ldr_atomic(jit_state_t *_jit, int32_t dst, int32_t loc)
+{
+  LDAR(_jit, dst, loc);
+}
+
+static void
+str_atomic(jit_state_t *_jit, int32_t loc, int32_t val)
+{
+  STLR(_jit, val, loc);
+}
+
+static void
+swap_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t val)
+{
+  void *retry = jit_address(_jit);
+  int32_t result = jit_gpr_regno(get_temp_gpr(_jit));
+  int32_t val_or_tmp = dst == val ? jit_gpr_regno(get_temp_gpr(_jit)) : val;
+  movr(_jit, val_or_tmp, val);
+  LDAXR(_jit, dst, loc);
+  STLXR(_jit, val_or_tmp, loc, result);
+  jit_patch_there(_jit, bnei(_jit, result, 0), retry);
+  if (dst == val) unget_temp_gpr(_jit);
+  unget_temp_gpr(_jit);
+}
+
+static void
+cas_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t expected,
+           int32_t desired)
+{
+  int32_t dst_or_tmp;
+  if (dst == loc || dst == expected || dst == expected)
+    dst_or_tmp = jit_gpr_regno(get_temp_gpr(_jit));
+  else
+    dst_or_tmp = dst;
+  void *retry = jit_address(_jit);
+  LDAXR(_jit, dst_or_tmp, loc);
+  jit_reloc_t bad = bner(_jit, dst_or_tmp, expected);
+  int result = jit_gpr_regno(get_temp_gpr(_jit));
+  STLXR(_jit, desired, loc, result);
+  jit_patch_there(_jit, bnei(_jit, result, 0), retry);
+  unget_temp_gpr(_jit);
+  jit_patch_here(_jit, bad);
+  movr(_jit, dst, dst_or_tmp);
+  unget_temp_gpr(_jit);
+}
+
+static void
+breakpoint(jit_state_t *_jit)
+{
+  BRK(_jit);
+}
diff --git a/libguile/lightening/lightening/aarch64-fpu.c b/libguile/lightening/lightening/aarch64-fpu.c
new file mode 100644
index 000000000..629734264
--- /dev/null
+++ b/libguile/lightening/lightening/aarch64-fpu.c
@@ -0,0 +1,810 @@
+/*
+ * Copyright (C) 2013-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+static void
+osvvv(jit_state_t *_jit, int32_t Op, int32_t Sz, int32_t Rd, int32_t Rn,
+      int32_t Rm)
+{
+  uint32_t inst = Op;
+  inst = write_size_bitfield(inst, Sz);
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_Rm_bitfield(inst, Rm);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+osvv_(jit_state_t *_jit, int32_t Op, int32_t Sz, int32_t Rd, int32_t Rn)
+{
+  uint32_t inst = Op;
+  inst = write_size_bitfield(inst, Sz);
+  inst = write_Rd_bitfield(inst, Rd);
+  inst = write_Rn_bitfield(inst, Rn);
+  emit_u32_with_pool(_jit, inst);
+}
+
+static void
+os_vv(jit_state_t *_jit, int32_t Op, int32_t Sz, int32_t Rn, int32_t Rm)
+{
+  uint32_t inst = Op;
+  inst = write_size_bitfield(inst, Sz);
+  inst = write_Rn_bitfield(inst, Rn);
+  inst = write_Rm_bitfield(inst, Rm);
+  emit_u32_with_pool(_jit, inst);
+}
+
+#define A64_SCVTF                     0x1e220000
+#define A64_FMOVWV                    0x1e260000
+#define A64_FMOVVW                    0x1e270000
+#define A64_FMOVXV                    0x9e260000
+#define A64_FMOVVX                    0x9e270000
+#define A64_FCVTZS                    0x1e380000
+#define A64_FCMPE                     0x1e202010
+#define A64_FMOV                      0x1e204000
+#define A64_FABS                      0x1e20c000
+#define A64_FNEG                      0x1e214000
+#define A64_FSQRT                     0x1e21c000
+#define A64_FCVTS                     0x1e224000
+#define A64_FCVTD                     0x1e22c000
+#define A64_FMUL                      0x1e200800
+#define A64_FDIV                      0x1e201800
+#define A64_FADD                      0x1e202800
+#define A64_FSUB                      0x1e203800
+
+static void
+FCMPES(jit_state_t *_jit, int32_t Rn, int32_t Rm)
+{
+  os_vv(_jit, A64_FCMPE, 0, Rn, Rm);
+}
+
+static void
+FCMPED(jit_state_t *_jit, int32_t Rn, int32_t Rm)
+{
+  os_vv(_jit, A64_FCMPE, 1, Rn, Rm);
+}
+
+static void
+FMOVS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOV, 0, Rd, Rn);
+}
+
+static void
+FMOVD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOV, 1, Rd, Rn);
+}
+
+static void
+FMOVWS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOVWV, 0, Rd, Rn);
+}
+
+static void
+FMOVSW(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOVVW, 0, Rd, Rn);
+}
+
+static void
+FMOVXD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOVXV, 1, Rd, Rn);
+}
+
+static void
+FMOVDX(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FMOVVX, 1, Rd, Rn);
+}
+
+static void
+FCVT_SD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTS, 1, Rd, Rn);
+}
+
+static void
+FCVT_DS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTD, 0, Rd, Rn);
+}
+
+static void
+SCVTFS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_SCVTF|XS, 0, Rd, Rn);
+}
+
+static void
+SCVTFD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_SCVTF|XS, 1, Rd, Rn);
+}
+
+static void
+FCVTSZ_WS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTZS, 0, Rd, Rn);
+}
+
+static void
+FCVTSZ_WD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTZS, 1, Rd, Rn);
+}
+
+static void
+FCVTSZ_XS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTZS|XS, 0, Rd, Rn);
+}
+
+static void
+FCVTSZ_XD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FCVTZS|XS, 1, Rd, Rn);
+}
+
+static void
+FABSS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FABS, 0, Rd, Rn);
+}
+
+static void
+FABSD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FABS, 1, Rd, Rn);
+}
+
+static void
+FNEGS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FNEG, 0, Rd, Rn);
+}
+
+static void
+FNEGD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FNEG, 1, Rd, Rn);
+}
+
+static void
+FSQRTS(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FSQRT, 0, Rd, Rn);
+}
+
+static void
+FSQRTD(jit_state_t *_jit, int32_t Rd, int32_t Rn)
+{
+  osvv_(_jit, A64_FSQRT, 1, Rd, Rn);
+}
+
+static void
+FADDS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FADD, 0, Rd, Rn, Rm);
+}
+
+static void
+FADDD(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FADD, 1, Rd, Rn, Rm);
+}
+
+static void
+FSUBS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FSUB, 0, Rd, Rn, Rm);
+}
+
+static void
+FSUBD(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FSUB, 1, Rd, Rn, Rm);
+}
+
+static void
+FMULS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FMUL, 0, Rd, Rn, Rm);
+}
+
+static void
+FMULD(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FMUL, 1, Rd, Rn, Rm);
+}
+
+static void
+FDIVS(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FDIV, 0, Rd, Rn, Rm);
+}
+
+static void
+FDIVD(jit_state_t *_jit, int32_t Rd, int32_t Rn, int32_t Rm)
+{
+  osvvv(_jit, A64_FDIV, 1, Rd, Rn, Rm);
+}
+
+static void
+truncr_f_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVTSZ_XS(_jit, r0, r1);
+}
+
+static void
+truncr_d_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVTSZ_XD(_jit, r0, r1);
+}
+
+static void
+addr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FADDS(_jit, r0, r1, r2);
+}
+
+static void
+subr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FSUBS(_jit, r0, r1, r2);
+}
+
+static void
+mulr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FMULS(_jit, r0, r1, r2);
+}
+
+static void
+divr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FDIVS(_jit, r0, r1, r2);
+}
+
+static void
+absr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FABSS(_jit, r0, r1);
+}
+
+static void
+negr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FNEGS(_jit, r0, r1);
+}
+
+static void
+sqrtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FSQRTS(_jit, r0, r1);
+}
+
+static void
+extr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  SCVTFS(_jit, r0, r1);
+}
+
+static void
+extr_d_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVT_SD(_jit, r0, r1);
+}
+
+static jit_reloc_t
+fbccr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  FCMPES(_jit, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_MI,r0, r1);
+}
+
+static jit_reloc_t
+bler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_LS,r0, r1);
+}
+
+static jit_reloc_t
+beqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_EQ,r0, r1);
+}
+
+static jit_reloc_t
+bger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_GE,r0, r1);
+}
+
+static jit_reloc_t
+bgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_GT,r0, r1);
+}
+
+static jit_reloc_t
+bner_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_NE,r0, r1);
+}
+
+static jit_reloc_t
+bunltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_LT,r0, r1);
+}
+
+static jit_reloc_t
+bunler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_LE,r0, r1);
+}
+
+static jit_reloc_t
+bunger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_PL,r0, r1);
+}
+
+static jit_reloc_t
+bungtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_HI,r0, r1);
+}
+
+static jit_reloc_t
+bordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_VC,r0, r1);
+}
+
+static jit_reloc_t
+bunordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return fbccr(_jit, BCC_VS, r0, r1);
+}
+
+static void
+addr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FADDD(_jit, r0, r1, r2);
+}
+
+static void
+subr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FSUBD(_jit, r0, r1, r2);
+}
+
+static void
+mulr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FMULD(_jit, r0, r1, r2);
+}
+
+static void
+divr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  FDIVD(_jit, r0, r1, r2);
+}
+
+static void
+absr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FABSD(_jit, r0, r1);
+}
+
+static void
+negr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FNEGD(_jit, r0, r1);
+}
+
+static void
+sqrtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FSQRTD(_jit, r0, r1);
+}
+
+static void
+extr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  SCVTFD(_jit, r0, r1);
+}
+
+static void
+extr_f_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVT_DS(_jit, r0, r1);
+}
+
+static jit_reloc_t
+dbccr(jit_state_t *_jit, int32_t cc, int32_t r0, int32_t r1)
+{
+  FCMPED(_jit, r0, r1);
+  return B_C(_jit, cc);
+}
+
+static jit_reloc_t
+bltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_MI, r0, r1);
+}
+
+static jit_reloc_t
+bler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_LS, r0, r1);
+}
+
+static jit_reloc_t
+beqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_EQ, r0, r1);
+}
+
+static jit_reloc_t
+bger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bner_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bunltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_LT, r0, r1);
+}
+
+static jit_reloc_t
+bunler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_LE, r0, r1);
+}
+
+static jit_reloc_t
+bunger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_PL, r0, r1);
+}
+
+static jit_reloc_t
+bungtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_HI, r0, r1);
+}
+
+static jit_reloc_t
+bordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_VC, r0, r1);
+}
+
+static jit_reloc_t
+bunordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return dbccr(_jit, BCC_VS, r0, r1);
+}
+
+
+static void
+truncr_f_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVTSZ_WS(_jit, r0, r1);
+  extr_i(_jit, r0, r0);
+}
+
+static void
+truncr_d_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCVTSZ_WD(_jit, r0, r1);
+  extr_i(_jit, r0, r0);
+}
+
+static void
+ldr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldr_i(_jit, jit_gpr_regno(reg), r1);
+  FMOVSW(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldi_i(_jit, jit_gpr_regno(reg), i0);
+  FMOVSW(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldxr_i(_jit, jit_gpr_regno(reg), r1, r2);
+  FMOVSW(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldxi_i(_jit, jit_gpr_regno(reg), r1, i0);
+  FMOVSW(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+str_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVWS(_jit, jit_gpr_regno(reg), r1);
+  str_i(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVWS(_jit, jit_gpr_regno(reg), r0);
+  sti_i(_jit, i0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVWS(_jit, jit_gpr_regno(reg), r2);
+  stxr_i(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVWS(_jit, jit_gpr_regno(reg), r1);
+  stxi_i(_jit, i0, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+movr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    FMOVS(_jit, r0, r1);
+}
+
+static void
+movi_f(jit_state_t *_jit, int32_t r0, float i0)
+{
+  union {
+    int32_t i;
+    float   f;
+  } u;
+  u.f = i0;
+  if (u.i == 0)
+    FMOVSW(_jit, r0, WZR_REGNO);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    /* prevent generating unused top 32 bits */
+    movi(_jit, jit_gpr_regno(reg), ((jit_word_t)u.i) & 0xffffffff);
+    FMOVSW(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static jit_reloc_t
+buneqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCMPES(_jit, r0, r1);
+  jit_reloc_t unordered = B_C(_jit, BCC_VS); /* unordered satisfies condition */
+  jit_reloc_t neq = B_C(_jit, BCC_NE); /* not equal (or unordered) does not satisfy */
+  jit_patch_here(_jit, unordered);
+  jit_reloc_t ret = B(_jit);
+  jit_patch_here(_jit, neq);
+  return ret;
+}
+
+static jit_reloc_t
+bltgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCMPES(_jit, r0, r1);
+  jit_reloc_t unordered = B_C(_jit, BCC_VS); /* jump over if unordered */
+  jit_reloc_t eq = B_C(_jit, BCC_EQ); /* jump over if equal */
+  jit_reloc_t ret = B(_jit);
+  jit_patch_here(_jit, unordered);
+  jit_patch_here(_jit, eq);
+  return ret;
+}
+
+static void
+ldr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldr_l(_jit, jit_gpr_regno(reg), r1);
+  FMOVDX(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldi_l(_jit, jit_gpr_regno(reg), i0);
+  FMOVDX(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldxr_l(_jit, jit_gpr_regno(reg), r1, r2);
+  FMOVDX(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  ldxi_l(_jit, jit_gpr_regno(reg), r1, i0);
+  FMOVDX(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+str_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVXD(_jit, jit_gpr_regno(reg), r1);
+  str_l(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVXD(_jit, jit_gpr_regno(reg), r0);
+  sti_l(_jit, i0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVXD(_jit, jit_gpr_regno(reg), r2);
+  stxr_l(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  FMOVXD(_jit, jit_gpr_regno(reg), r1);
+  stxi_l(_jit, i0, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    FMOVD(_jit, r0, r1);
+}
+
+static void
+movi_d(jit_state_t *_jit, int32_t r0, double i0)
+{
+  union {
+    int64_t l;
+    double   d;
+  } u;
+  u.d = i0;
+  if (u.l == 0)
+    FMOVDX(_jit, r0, XZR_REGNO);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), u.l);
+    FMOVDX(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static jit_reloc_t
+buneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCMPED(_jit, r0, r1);
+  jit_reloc_t unordered = B_C(_jit, BCC_VS); /* unordered satisfies condition */
+  jit_reloc_t neq = B_C(_jit, BCC_NE); /* not equal (or unordered) does not satisfy */
+  jit_patch_here(_jit, unordered);
+  jit_reloc_t ret = B(_jit);
+  jit_patch_here(_jit, neq);
+  return ret;
+}
+
+static jit_reloc_t
+bltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  FCMPED(_jit, r0, r1);
+  jit_reloc_t unordered = B_C(_jit, BCC_VS); /* jump over if unordered */
+  jit_reloc_t eq = B_C(_jit, BCC_EQ); /* jump over if equal */
+  jit_reloc_t ret = B(_jit);
+  jit_patch_here(_jit, unordered);
+  jit_patch_here(_jit, eq);
+  return ret;
+}
+
+static void
+retr_d(jit_state_t *_jit, int32_t r)
+{
+  movr_d(_jit, jit_fpr_regno(_D0), r);
+  ret(_jit);
+}
+
+static void
+retr_f(jit_state_t *_jit, int32_t r)
+{
+  movr_f(_jit, jit_fpr_regno(_D0), r);
+  ret(_jit);
+}
+
+static void
+retval_f(jit_state_t *_jit, int32_t r0)
+{
+  movr_f(_jit, r0, jit_fpr_regno(_D0));
+}
+
+static void
+retval_d(jit_state_t *_jit, int32_t r0)
+{
+  movr_d(_jit, r0, jit_fpr_regno(_D0));
+}
diff --git a/libguile/lightening/lightening/aarch64.c b/libguile/lightening/lightening/aarch64.c
new file mode 100644
index 000000000..2e525166c
--- /dev/null
+++ b/libguile/lightening/lightening/aarch64.c
@@ -0,0 +1,230 @@
+/*
+ * Copyright (C) 2013-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+/* libgcc */
+extern void __clear_cache(void *, void *);
+
+
+static inline int32_t
+read_signed_bitfield(uint32_t word, uint8_t width, uint8_t shift)
+{
+  return ((int32_t)word) << (32 - width - shift) >> (32 - width);
+}
+
+static inline uint32_t
+read_unsigned_bitfield(uint32_t word, uint8_t width, uint8_t shift)
+{
+  return word << (32 - width - shift) >> (32 - width);
+}
+
+static inline int
+in_signed_range(ptrdiff_t diff, uint8_t bits)
+{
+  return (-1 << (bits - 1)) <= diff && diff < (1 << (bits - 1));
+}
+
+static inline int
+in_unsigned_range(uint32_t val, uint8_t bits)
+{
+  ASSERT(bits < __WORDSIZE);
+  return val < (1 << bits);
+}
+
+static inline uint32_t
+write_unsigned_bitfield(uint32_t word, uint32_t val, uint8_t width, uint8_t shift)
+{
+  ASSERT(read_unsigned_bitfield(word, width, shift) == 0);
+  ASSERT(in_unsigned_range(val, width));
+  return word | (val << shift);
+}
+
+static inline int32_t
+write_signed_bitfield(uint32_t word, ptrdiff_t val, uint8_t width, uint8_t shift)
+{
+  ASSERT(read_signed_bitfield(word, width, shift) == 0);
+  ASSERT(in_signed_range(val, width));
+  return word | ((val & ((1 << width) - 1)) << shift);
+}
+
+#define DEFINE_ENCODER(name, width, shift, kind, val_t)                 \
+  static const uint8_t name##_width = width;                            \
+  static const uint8_t name##_shift = shift;                            \
+  static uint32_t                                                       \
+  write_##name##_bitfield(uint32_t word, val_t val)                     \
+  {                                                                     \
+    return write_##kind##_bitfield(word, val, name##_width, name##_shift); \
+  }
+
+DEFINE_ENCODER(Rd, 5, 0, unsigned, uint32_t)
+DEFINE_ENCODER(Rm, 5, 16, unsigned, uint32_t)
+DEFINE_ENCODER(Rn, 5, 5, unsigned, uint32_t)
+DEFINE_ENCODER(cond2, 4, 0, unsigned, uint32_t)
+DEFINE_ENCODER(simm9, 9, 12, signed, ptrdiff_t)
+DEFINE_ENCODER(imm12, 12, 10, unsigned, uint32_t)
+DEFINE_ENCODER(imm16, 16, 5, unsigned, uint32_t)
+DEFINE_ENCODER(simm19, 19, 5, signed, ptrdiff_t)
+DEFINE_ENCODER(simm26, 26, 0, signed, ptrdiff_t)
+DEFINE_ENCODER(immr, 6, 16, unsigned, uint32_t)
+DEFINE_ENCODER(imms, 6, 10, unsigned, uint32_t)
+DEFINE_ENCODER(size, 2, 22, unsigned, uint32_t)
+
+#define DEFINE_PATCHABLE_INSTRUCTION(name, kind, RELOC, rsh)            \
+  static int32_t                                                        \
+  read_##name##_offset(uint32_t *loc)                                   \
+  {                                                                     \
+    return read_signed_bitfield(*loc, kind##_width, kind##_shift);      \
+  }                                                                     \
+  static int offset_in_##name##_range(ptrdiff_t diff) maybe_unused;     \
+  static int                                                            \
+  offset_in_##name##_range(ptrdiff_t diff)                              \
+  {                                                                     \
+    return in_signed_range(diff, kind##_width);                         \
+  }                                                                     \
+  static void                                                           \
+  patch_##name##_offset(uint32_t *loc, ptrdiff_t diff)                  \
+  {                                                                     \
+    *loc = write_##kind##_bitfield(*loc, diff);                         \
+  }                                                                     \
+  static jit_reloc_t                                                    \
+  emit_##name(jit_state_t *_jit, uint32_t inst)                         \
+  {                                                                     \
+    while (1) {                                                         \
+      jit_reloc_t ret = jit_reloc (_jit, JIT_RELOC_##RELOC, 0,          \
+                                   _jit->pc.uc, _jit->pc.uc, rsh);      \
+      if (add_pending_literal(_jit, ret, kind##_width - 1)) {           \
+        emit_u32(_jit, inst);                                           \
+        return ret;                                                     \
+      }                                                                 \
+    }                                                                   \
+  }
+
+DEFINE_PATCHABLE_INSTRUCTION(jmp, simm26, JMP_WITH_VENEER, 2);
+DEFINE_PATCHABLE_INSTRUCTION(jcc, simm19, JCC_WITH_VENEER, 2);
+DEFINE_PATCHABLE_INSTRUCTION(load_from_pool, simm19, LOAD_FROM_POOL, 2);
+
+struct veneer
+{
+  uint32_t ldr;
+  uint32_t br;
+  uint64_t addr;
+};
+
+static void
+patch_veneer(uint32_t *loc, jit_pointer_t addr)
+{
+  struct veneer *v = (struct veneer*) v;
+  v->addr = (uint64_t) addr;
+}
+
+#include "aarch64-cpu.c"
+#include "aarch64-fpu.c"
+
+static const jit_gpr_t abi_gpr_args[] = {
+  _X0, _X1, _X2, _X3, _X4, _X5, _X6, _X7
+};
+
+static const jit_fpr_t abi_fpr_args[] = {
+  _D0, _D1, _D2, _D3, _D4, _D5, _D6, _D7
+};
+
+static const int abi_gpr_arg_count = sizeof(abi_gpr_args) / sizeof(abi_gpr_args[0]);
+static const int abi_fpr_arg_count = sizeof(abi_fpr_args) / sizeof(abi_fpr_args[0]);
+
+struct abi_arg_iterator
+{
+  const jit_operand_t *args;
+  size_t argc;
+
+  size_t arg_idx;
+  size_t gpr_idx;
+  size_t fpr_idx;
+  size_t stack_size;
+  size_t stack_padding;
+};
+
+static size_t page_size;
+
+jit_bool_t
+jit_get_cpu(void)
+{
+  page_size = sysconf(_SC_PAGE_SIZE);
+  return 1;
+}
+
+jit_bool_t
+jit_init(jit_state_t *_jit)
+{
+  return 1;
+}
+
+static size_t
+jit_initial_frame_size (void)
+{
+  return 0;
+}
+
+static void
+reset_abi_arg_iterator(struct abi_arg_iterator *iter, size_t argc,
+                       const jit_operand_t *args)
+{
+  memset(iter, 0, sizeof *iter);
+  iter->argc = argc;
+  iter->args = args;
+}
+
+static void
+next_abi_arg(struct abi_arg_iterator *iter, jit_operand_t *arg)
+{
+  ASSERT(iter->arg_idx < iter->argc);
+  enum jit_operand_abi abi = iter->args[iter->arg_idx].abi;
+  if (is_gpr_arg(abi) && iter->gpr_idx < abi_gpr_arg_count) {
+    *arg = jit_operand_gpr (abi, abi_gpr_args[iter->gpr_idx++]);
+  } else if (is_fpr_arg(abi) && iter->fpr_idx < abi_fpr_arg_count) {
+    *arg = jit_operand_fpr (abi, abi_fpr_args[iter->fpr_idx++]);
+  } else {
+    *arg = jit_operand_mem (abi, JIT_SP, iter->stack_size);
+    iter->stack_size += 8;
+  }
+  iter->arg_idx++;
+}
+
+static void
+jit_flush(void *fptr, void *tptr)
+{
+  jit_word_t f = (jit_word_t)fptr & -page_size;
+  jit_word_t t = (((jit_word_t)tptr) + page_size - 1) & -page_size;
+  __clear_cache((void *)f, (void *)t);
+}
+
+static inline size_t
+jit_stack_alignment(void)
+{
+  return 16;
+}
+
+static void
+jit_try_shorten(jit_state_t *_jit, jit_reloc_t reloc, jit_pointer_t addr)
+{
+}
+
+static void*
+bless_function_pointer(void *ptr)
+{
+  return ptr;
+}
diff --git a/libguile/lightening/lightening/aarch64.h b/libguile/lightening/lightening/aarch64.h
new file mode 100644
index 000000000..5c99f6303
--- /dev/null
+++ b/libguile/lightening/lightening/aarch64.h
@@ -0,0 +1,168 @@
+/*
+ * Copyright (C) 2013-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_aarch64_h
+#define _jit_aarch64_h
+
+
+#define JIT_NEEDS_LITERAL_POOL 1
+
+#define _X0     JIT_GPR(0)
+#define _X1     JIT_GPR(1)
+#define _X2     JIT_GPR(2)
+#define _X3     JIT_GPR(3)
+#define _X4     JIT_GPR(4)
+#define _X5     JIT_GPR(5)
+#define _X6     JIT_GPR(6)
+#define _X7     JIT_GPR(7)
+#define _X8     JIT_GPR(8)
+#define _X9     JIT_GPR(9)
+#define _X10    JIT_GPR(10)
+#define _X11    JIT_GPR(11)
+#define _X12    JIT_GPR(12)
+#define _X13    JIT_GPR(13)
+#define _X14    JIT_GPR(14)
+#define _X15    JIT_GPR(15)
+#define _X16    JIT_GPR(16)
+#define _X17    JIT_GPR(17)
+#define _X18    JIT_GPR(18)
+#define _X19    JIT_GPR(19)
+#define _X20    JIT_GPR(20)
+#define _X21    JIT_GPR(21)
+#define _X22    JIT_GPR(22)
+#define _X23    JIT_GPR(23)
+#define _X24    JIT_GPR(24)
+#define _X25    JIT_GPR(25)
+#define _X26    JIT_GPR(26)
+#define _X27    JIT_GPR(27)
+#define _X28    JIT_GPR(28)
+#define _X29    JIT_GPR(29)
+#define _X30    JIT_GPR(30)
+#define _X31    JIT_GPR(31)
+
+#define _D0     JIT_FPR(0)
+#define _D1     JIT_FPR(1)
+#define _D2     JIT_FPR(2)
+#define _D3     JIT_FPR(3)
+#define _D4     JIT_FPR(4)
+#define _D5     JIT_FPR(5)
+#define _D6     JIT_FPR(6)
+#define _D7     JIT_FPR(7)
+#define _D8     JIT_FPR(8)
+#define _D9     JIT_FPR(9)
+#define _D10    JIT_FPR(10)
+#define _D11    JIT_FPR(11)
+#define _D12    JIT_FPR(12)
+#define _D13    JIT_FPR(13)
+#define _D14    JIT_FPR(14)
+#define _D15    JIT_FPR(15)
+#define _D16    JIT_FPR(16)
+#define _D17    JIT_FPR(17)
+#define _D18    JIT_FPR(18)
+#define _D19    JIT_FPR(19)
+#define _D20    JIT_FPR(20)
+#define _D21    JIT_FPR(21)
+#define _D22    JIT_FPR(22)
+#define _D23    JIT_FPR(23)
+#define _D24    JIT_FPR(24)
+#define _D25    JIT_FPR(25)
+#define _D26    JIT_FPR(26)
+#define _D27    JIT_FPR(27)
+#define _D28    JIT_FPR(28)
+#define _D29    JIT_FPR(29)
+#define _D30    JIT_FPR(30)
+#define _D31    JIT_FPR(31)
+
+#define JIT_R0    _X0
+#define JIT_R1    _X1
+#define JIT_R2    _X2
+#define JIT_R3    _X3
+#define JIT_R4    _X4
+#define JIT_R5    _X5
+#define JIT_R6    _X6
+#define JIT_R7    _X7
+#define JIT_R8    _X8
+#define JIT_R9    _X9
+#define JIT_R10   _X10
+#define JIT_R11   _X11
+#define JIT_R12   _X12
+#define JIT_R13   _X13
+#define JIT_R14   _X14
+#define JIT_R15   _X15
+#define JIT_TMP0  _X16
+#define JIT_TMP1  _X17
+// x18 is reserved by the platform.
+#define JIT_V0    _X19
+#define JIT_V1    _X20
+#define JIT_V2    _X21
+#define JIT_V3    _X22
+#define JIT_V4    _X23
+#define JIT_V5    _X24
+#define JIT_V6    _X25
+#define JIT_V7    _X26
+#define JIT_V8    _X27
+#define JIT_V9    _X28
+
+// x29 is frame pointer; x30 is link register.
+#define JIT_PLATFORM_CALLEE_SAVE_GPRS _X29, _X30
+
+// x31 is stack pointer.
+#define JIT_LR    _X30
+#define JIT_SP    _X31
+
+#define JIT_F0  _D0
+#define JIT_F1  _D1
+#define JIT_F2  _D2
+#define JIT_F3  _D3
+#define JIT_F4  _D4
+#define JIT_F5  _D5
+#define JIT_F6  _D6
+#define JIT_F7  _D7
+#define JIT_F8  _D16
+#define JIT_F9  _D17
+#define JIT_F10 _D18
+#define JIT_F11 _D19
+#define JIT_F12 _D20
+#define JIT_F13 _D21
+#define JIT_F14 _D22
+#define JIT_F15 _D23
+#define JIT_F16 _D24
+#define JIT_F17 _D25
+#define JIT_F18 _D26
+#define JIT_F19 _D27
+#define JIT_F20 _D28
+#define JIT_F21 _D29
+#define JIT_F22 _D30
+#define JIT_FTMP _D31
+
+#define JIT_VF0  _D8
+#define JIT_VF1  _D9
+#define JIT_VF2 _D10
+#define JIT_VF3 _D11
+#define JIT_VF4 _D12
+#define JIT_VF5 _D13
+#define JIT_VF6 _D14
+#define JIT_VF7 _D15
+
+#define _FP _X29
+#define _LR _X30
+#define _SP _X31
+
+
+#endif /* _jit_aarch64_h */
diff --git a/libguile/lightening/lightening/arm-cpu.c b/libguile/lightening/lightening/arm-cpu.c
new file mode 100644
index 000000000..d96d57b2d
--- /dev/null
+++ b/libguile/lightening/lightening/arm-cpu.c
@@ -0,0 +1,3084 @@
+/*
+ * Copyright (C) 2012-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#define _s20P(d)                      ((d) >= -(int)0x80000 && d <= 0x7ffff)
+#define _s24P(d)                      ((d) >= -(int)0x800000 && d <= 0x7fffff)
+#define _u3(v)                        ((v) & 0x7)
+#define _u4(v)                        ((v) & 0xf)
+#define _u5(v)                        ((v) & 0x1f)
+#define _u8(v)                        ((v) & 0xff)
+#define _u12(v)                       ((v) & 0xfff)
+#define _u13(v)                       ((v) & 0x1fff)
+#define _u16(v)                       ((v) & 0xffff)
+#define _u24(v)                       ((v) & 0xffffff)
+
+#define ARM_CC_EQ                     0x00000000      /* Z=1 */
+#define ARM_CC_NE                     0x10000000      /* Z=0 */
+#define ARM_CC_HS                     0x20000000      /* C=1 */
+#define ARM_CC_LO                     0x30000000      /* C=0 */
+#define ARM_CC_MI                     0x40000000      /* N=1 */
+#define ARM_CC_VS                     0x60000000      /* V=1 */
+#define ARM_CC_VC                     0x70000000      /* V=0 */
+#define ARM_CC_HI                     0x80000000      /* C=1 && Z=0 */
+#define ARM_CC_LS                     0x90000000      /* C=0 || Z=1 */
+#define ARM_CC_GE                     0xa0000000      /* N=V */
+#define ARM_CC_LT                     0xb0000000      /* N!=V */
+#define ARM_CC_GT                     0xc0000000      /* Z=0 && N=V */
+#define ARM_CC_LE                     0xd0000000      /* Z=1 || N!=V */
+#define ARM_CC_AL                     0xe0000000      /* always */
+#define ARM_CC_NV                     0xf0000000      /* reserved */
+#define THUMB_MOV                         0x4600
+#define THUMB_MOVI                        0x2000
+#define THUMB2_MOVI                   0xf0400000
+#define THUMB2_MOVWI                  0xf2400000
+#define THUMB2_MOVTI                  0xf2c00000
+#define THUMB_MVN                         0x43c0
+#define THUMB2_MVN                    0xea600000
+#define THUMB2_MVNI                   0xf0600000
+#define ARM_S                         0x00100000 /* set flags */
+#define THUMB_ADD                         0x1800
+#define THUMB_ADDX                        0x4400
+#define THUMB2_ADD                    0xeb000000
+#define THUMB_ADDI3                       0x1c00
+#define THUMB_ADDI8                       0x3000
+#define THUMB2_ADDI                   0xf1000000
+#define THUMB2_ADDWI                  0xf2000000
+#define THUMB_ADC                         0x4140
+#define THUMB2_ADC                    0xeb400000
+#define THUMB2_ADCI                   0xf1400000
+#define THUMB_SUB                         0x1a00
+#define THUMB2_SUB                    0xeba00000
+#define THUMB_SUBI3                       0x1e00
+#define THUMB_SUBI8                       0x3800
+#define THUMB2_SUBI                   0xf1a00000
+#define THUMB2_SUBWI                  0xf2a00000
+#define THUMB_SBC                         0x4180
+#define THUMB2_SBC                    0xeb600000
+#define THUMB2_SBCI                   0xf1600000
+#define THUMB_RSBI                        0x4240
+#define THUMB2_RSBI                   0xf1c00000
+#define THUMB_MUL                         0x4340
+#define THUMB2_MUL                    0xfb00f000
+#define THUMB2_UMULL                  0xfba00000
+#define THUMB2_SMULL                  0xfb800000
+#define THUMB_MLS                     0xfb000010
+#define THUMB2_SDIV                   0xfb90f0f0
+#define THUMB2_UDIV                   0xfbb0f0f0
+#define THUMB_AND                         0x4000
+#define THUMB2_AND                    0xea000000
+#define THUMB2_ANDI                   0xf0000000
+#define THUMB2_BIC                    0xea200000
+#define THUMB2_BICI                   0xf0200000
+#define THUMB_ORR                         0x4300
+#define THUMB2_ORR                    0xea400000
+#define THUMB2_ORRI                   0xf0400000
+#define THUMB_EOR                         0x4040
+#define THUMB2_EOR                    0xea800000
+#define THUMB2_EORI                   0xf0800000
+#define THUMB_REV                         0xba00
+#define THUMB2_REV                    0xfa90f080
+#define THUMB_SXTB                        0xb240
+#define THUMB2_SXTB                   0xfa40f080
+#define THUMB_UXTB                        0xb2c0
+#define THUMB2_UXTB                   0xfa50f080
+#define THUMB_SXTH                        0xb200
+#define THUMB2_SXTH                   0xfa00f080
+#define THUMB_UXTH                        0xb280
+#define THUMB2_UXTH                   0xfa10f080
+#define ARM_LSL                       0x00000000
+#define THUMB_LSL                         0x4080
+#define THUMB2_LSL                    0xfa00f000
+#define THUMB_LSLI                        0x0000
+#define THUMB2_LSLI                   0xea4f0000
+#define ARM_LSR                       0x00000020
+#define THUMB_LSR                         0x40c0
+#define THUMB2_LSR                    0xfa20f000
+#define THUMB_LSRI                        0x0800
+#define THUMB2_LSRI                   0xea4f0010
+#define ARM_ASR                       0x00000040
+#define THUMB_ASR                         0x4100
+#define THUMB2_ASR                    0xfa40f000
+#define THUMB_ASRI                        0x1000
+#define THUMB2_ASRI                   0xea4f0020
+#define THUMB_CMP                         0x4280
+#define THUMB_CMPX                        0x4500
+#define THUMB2_CMP                    0xebb00000
+#define THUMB_CMPI                        0x2800
+#define THUMB2_CMPI                   0xf1b00000
+#define THUMB2_CMN                    0xeb100000
+#define THUMB2_CMNI                   0xf1100000
+#define THUMB_TST                         0x4200
+#define THUMB2_TST                    0xea100000
+#define THUMB2_TSTI                   0xf0100000
+#define THUMB_BLX                         0x4780
+#define THUMB_BX                          0x4700
+#define THUMB_CC_B                        0xd000
+#define THUMB_B                           0xe000
+#define THUMB2_CC_B                   0xf0008000
+#define THUMB2_B                      0xf0009000
+#define THUMB2_BLI                    0xf000d000
+#define THUMB2_BLXI                   0xf000c000
+#define THUMB2_P                      0x00000400
+#define THUMB2_U                      0x00000200
+#define THUMB_LDRSB                       0x5600
+#define THUMB2_LDRSB                  0xf9100000
+#define THUMB2_LDRSBI                 0xf9100c00
+#define THUMB2_LDRSBWI                0xf9900000
+#define THUMB_LDRB                        0x5c00
+#define THUMB2_LDRB                   0xf8100000
+#define THUMB_LDRBI                       0x7800
+#define THUMB2_LDRBI                  0xf8100c00
+#define THUMB2_LDRBWI                 0xf8900000
+#define THUMB_LDRSH                       0x5e00
+#define THUMB2_LDRSH                  0xf9300000
+#define THUMB2_LDRSHI                 0xf9300c00
+#define THUMB2_LDRSHWI                0xf9b00000
+#define THUMB_LDRH                        0x5a00
+#define THUMB2_LDRH                   0xf8300000
+#define THUMB_LDRHI                       0x8800
+#define THUMB2_LDRHI                  0xf8300c00
+#define THUMB2_LDRHWI                 0xf8b00000
+#define THUMB_LDR                         0x5800
+#define THUMB2_LDR                    0xf8500000
+#define THUMB2_LDRP                   0xf85f0000
+#define THUMB_LDRI                        0x6800
+#define THUMB_LDRISP                      0x9800
+#define THUMB2_LDRI                   0xf8500c00
+#define THUMB2_LDRWI                  0xf8d00000
+#define THUMB_STRB                        0x5400
+#define THUMB2_STRB                   0xf8000000
+#define THUMB_STRBI                       0x7000
+#define THUMB2_STRBI                  0xf8000c00
+#define THUMB2_STRBWI                 0xf8800000
+#define THUMB_STRH                        0x5200
+#define THUMB2_STRH                   0xf8200000
+#define THUMB_STRHI                       0x8000
+#define THUMB2_STRHI                  0xf8200c00
+#define THUMB2_STRHWI                 0xf8a00000
+#define THUMB_STR                         0x5000
+#define THUMB2_STR                    0xf8400000
+#define THUMB_STRI                        0x6000
+#define THUMB2_STRWI                   0xf8c00000
+#define THUMB_STRISP                      0x9000
+#define THUMB2_STRI                   0xf8400c00
+#define THUMB2_LDM_W                  0x00200000
+#define THUMB2_PUSH                   0xe92d0000
+#define THUMB_DMB                     0xf3bf8f50
+#define THUMB_LDREX                   0xe8500f00
+#define THUMB_STREX                   0xe8400000
+#define THUMB_BRK                         0xbe00
+
+#define _NOREG (jit_gpr_regno(_PC))
+
+static void
+emit_wide_thumb(jit_state_t *_jit, uint32_t inst)
+{
+  emit_u16(_jit, inst >> 16);
+  emit_u16_with_pool(_jit, inst & 0xffff);
+}
+
+/* from binutils */
+#  define rotate_left(v, n)     (v << n | v >> (32 - n))
+static int
+encode_arm_immediate(unsigned int v)
+{
+  unsigned int        a, i;
+
+  for (i = 0; i < 32; i += 2)
+    if ((a = rotate_left(v, i)) <= 0xff)
+      return (a | (i << 7));
+
+  return (-1);
+}
+
+static int
+encode_thumb_immediate(unsigned int v)
+{
+  int                 i;
+  unsigned int        m;
+  unsigned int        n;
+  /* 00000000 00000000 00000000 abcdefgh */
+  if ((v & 0xff) == v)
+    return (v);
+  /* 00000000 abcdefgh 00000000 abcdefgh */
+  if ((v & 0xff00ff) == v && ((v & 0xff0000) >> 16) == (v & 0xff))
+    return ((v & 0xff) | (1 << 12));
+  /* abcdefgh 00000000 abcdefgh 00000000 */
+  if (((v & 0xffff0000) >> 16) == (v & 0xffff) && (v & 0xff) == 0)
+    return ((v & 0x000000ff) | (2 << 12));
+  /* abcdefgh abcdefgh abcdefgh abcdefgh */
+  if ( (v &    0xff)        == ((v &     0xff00) >>  8) &&
+       ((v &   0xff00) >> 8) == ((v &   0xff0000) >> 16) &&
+       ((v & 0xff0000) << 8) ==  (v & 0xff000000))
+    return ((v & 0xff) | (3 << 12));
+  /* 1bcdefgh << 24 ... 1bcdefgh << 1 */
+  for (i = 8, m = 0xff000000, n = 0x80000000;
+       i < 23; i++, m >>= 1,  n >>= 1) {
+    if ((v & m) == v && (v & n)) {
+      v >>= 32 - i;
+      if (!(i & 1))
+        v &= 0x7f;
+      i >>= 1;
+      return (((i & 7) << 12) | ((i & 8) << 23) | v);
+    }
+  }
+  return (-1);
+}
+
+static int
+encode_thumb_word_immediate(unsigned int v)
+{
+  if ((v & 0xfffff000) == 0)
+    return (((v & 0x800) << 15) | ((v & 0x700) << 4) | (v & 0xff));
+  return (-1);
+}
+
+static uint32_t
+read_wide_thumb(uint32_t *loc)
+{
+  uint16_t *sloc = (uint16_t*)loc;
+  return (sloc[0] << 16) | sloc[1];
+}
+
+static void
+write_wide_thumb(uint32_t *loc, uint32_t v)
+{
+  uint16_t *sloc = (uint16_t *)loc;
+  sloc[0] = v >> 16;
+  sloc[1] = v & 0xffff;
+}
+
+static int
+offset_in_jmp_range(int32_t offset)
+{
+  return -0x800000 <= offset && offset <= 0x7fffff;
+}
+
+static int32_t
+decode_thumb_jump(uint32_t v)
+{
+  uint32_t s  = (v >> 26) & 1;
+  uint32_t j1 = (v >> 13) & 1;
+  uint32_t j2 = (v >> 11) & 1;
+  uint32_t i1 = s ? j1 : !j1;
+  uint32_t i2 = s ? j2 : !j2;
+  uint32_t hi = (v >> 16) & 0x3ff;
+  uint32_t lo = v & 0x7ff;
+
+  int32_t ret = s << 31;
+  ret >>= 8;
+  ret |= i1 << 22;
+  ret |= i2 << 21;
+  ret |= hi << 11;
+  ret |= lo;
+  return ret;
+}
+
+static const uint32_t thumb_jump_mask = 0xf800d000;
+
+static uint32_t
+encode_thumb_jump(int32_t v)
+{
+  ASSERT(offset_in_jmp_range(v));
+  uint32_t s  = !!(v & 0x800000);
+  uint32_t i1 = !!(v & 0x400000);
+  uint32_t i2 = !!(v & 0x200000);
+  uint32_t j1 = s ? i1 : !i1;
+  uint32_t j2 = s ? i2 : !i2;
+  uint32_t ret = (s<<26)|((v&0x1ff800)<<5)|(j1<<13)|(j2<<11)|(v&0x7ff);
+  ASSERT(decode_thumb_jump(ret) == v);
+  ASSERT((ret & thumb_jump_mask) == 0);
+  return ret;
+}
+
+static uint32_t
+patch_thumb_jump(uint32_t inst, int32_t v)
+{
+  return (inst & thumb_jump_mask) | encode_thumb_jump(v);
+}
+
+static int32_t
+read_jmp_offset(uint32_t *loc)
+{
+  return decode_thumb_jump(read_wide_thumb(loc));
+}
+
+static void
+patch_jmp_offset(uint32_t *loc, int32_t v)
+{
+  write_wide_thumb(loc, patch_thumb_jump(read_wide_thumb(loc), v));
+}
+
+static jit_reloc_t
+emit_thumb_jump(jit_state_t *_jit, uint32_t inst)
+{
+  while (1) {
+    uint8_t *pc_base = _jit->pc.uc + 4;
+    uint8_t rsh = 1;
+    int32_t off = (_jit->pc.uc - pc_base) >> rsh;
+    jit_reloc_t ret =
+      jit_reloc (_jit, JIT_RELOC_JMP_WITH_VENEER, 0, _jit->pc.uc, pc_base, rsh);
+    uint8_t thumb_jump_width = 24;
+    if (add_pending_literal(_jit, ret, thumb_jump_width - 1)) {
+      emit_wide_thumb(_jit, patch_thumb_jump(inst, off));
+      return ret;
+    }
+  }
+}
+
+static int
+offset_in_jcc_range(int32_t v)
+{
+  return -0x80000 <= v && v <= 0x7ffff;
+}
+
+static int32_t
+decode_thumb_cc_jump(uint32_t v)
+{
+  uint32_t s  = (v >> 26) & 1;
+  uint32_t j1 = (v >> 13) & 1;
+  uint32_t j2 = (v >> 11) & 1;
+  uint32_t hi = (v >> 16) & 0x3f;
+  uint32_t lo = v & 0x7ff;
+
+  int32_t ret = s << 31;
+  ret >>= 12;
+  ret |= j2 << 18;
+  ret |= j1 << 17;
+  ret |= hi << 11;
+  ret |= lo;
+  return ret;
+}
+
+static const uint32_t thumb_cc_jump_mask = 0xfbc0d000;
+
+static uint32_t
+encode_thumb_cc_jump(int32_t v)
+{
+  ASSERT(offset_in_jcc_range(v));
+  uint32_t s  = !!(v & 0x80000);
+  uint32_t j2 = !!(v & 0x40000);
+  uint32_t j1 = !!(v & 0x20000);
+  uint32_t hi = (v >> 11) & 0x3f;
+  uint32_t lo = v & 0x7ff;
+  uint32_t ret = (s<<26)|(hi << 16)|(j1<<13)|(j2<<11)|lo;
+  ASSERT(decode_thumb_cc_jump(ret) == v);
+  ASSERT((ret & thumb_cc_jump_mask) == 0);
+  return ret;
+}
+
+static uint32_t
+patch_thumb_cc_jump(uint32_t inst, int32_t v)
+{
+  return (inst & thumb_cc_jump_mask) | encode_thumb_cc_jump(v);
+}
+
+static int32_t
+read_jcc_offset(uint32_t *loc)
+{
+  return decode_thumb_cc_jump(read_wide_thumb(loc));
+}
+
+static void
+patch_jcc_offset(uint32_t *loc, int32_t v)
+{
+  write_wide_thumb(loc, patch_thumb_cc_jump(read_wide_thumb(loc), v));
+}
+
+static jit_reloc_t
+emit_thumb_cc_jump(jit_state_t *_jit, uint32_t inst)
+{
+  while (1) {
+    uint8_t *pc_base = _jit->pc.uc + 4;
+    uint8_t rsh = 1;
+    int32_t off = (_jit->pc.uc - pc_base) >> rsh;
+    jit_reloc_t ret =
+      jit_reloc (_jit, JIT_RELOC_JCC_WITH_VENEER, 0, _jit->pc.uc, pc_base, rsh);
+    uint8_t thumb_cc_jump_width = 20;
+    if (add_pending_literal(_jit, ret, thumb_cc_jump_width - 1)) {
+      emit_wide_thumb(_jit, patch_thumb_cc_jump(inst, off));
+      return ret;
+    }
+  }
+}
+
+static void
+torrr(jit_state_t *_jit, int o, int rn, int rd, int rm)
+{
+  ASSERT(!(o & 0xf0f0f));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rd)<<8)|_u4(rm));
+}
+
+static void
+torxr(jit_state_t *_jit, int o, int rn, int rt, int rm)
+{
+  ASSERT(!(o & 0xf0f0f));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rt)<<12)|_u4(rm));
+}
+
+static void
+torrrr(jit_state_t *_jit, int o, int rn, int rl, int rh, int rm)
+{
+  ASSERT(!(o & 0x000fff0f));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rl)<<12)|(_u4(rh)<<8)|_u4(rm));
+}
+
+static void
+torri(jit_state_t *_jit, int o, int rn, int rd, int im)
+{
+  ASSERT(!(o  & 0x0c0f7fff));
+  ASSERT(!(im & 0xfbff8f00));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rd)<<8)|im);
+}
+
+static void
+torri8(jit_state_t *_jit, int o, int rn, int rt, int im)
+{
+  ASSERT(!(o  & 0x000ff0ff));
+  ASSERT(!(im & 0xffffff00));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rt)<<12)|im);
+}
+
+static void
+torri12(jit_state_t *_jit, int o, int rn, int rt, int im)
+{
+  ASSERT(!(o  & 0x000fffff));
+  ASSERT(!(im & 0xfffff000));
+  emit_wide_thumb(_jit, o|(_u4(rn)<<16)|(_u4(rt)<<12)|im);
+}
+
+static void
+tshift(jit_state_t *_jit, int o, int rd, int rm, int im)
+{
+  ASSERT(!(o & 0x7fcf));
+  ASSERT(im >= 0 && im < 32);
+  emit_wide_thumb(_jit, o|((im&0x1c)<<10)|(_u4(rd)<<8)|((im&3)<<6)|_u4(rm));
+}
+
+static void
+toriw(jit_state_t *_jit, int o, int rd, int im)
+{
+  ASSERT(!(im & 0xffff0000));
+  emit_wide_thumb(_jit, o|((im&0xf000)<<4)|((im&0x800)<<15)|((im&0x700)<<4)|(_u4(rd)<<8)|(im&0xff));
+}
+
+static jit_reloc_t
+tcb(jit_state_t *_jit, int cc)
+{
+  ASSERT(!(cc & 0xfffffff));
+  ASSERT(cc != ARM_CC_AL && cc != ARM_CC_NV);
+  cc = ((uint32_t)cc) >> 6;
+  return emit_thumb_cc_jump(_jit, THUMB2_CC_B|cc);
+}
+
+static jit_reloc_t
+tb(jit_state_t *_jit, int o)
+{
+  ASSERT(!(o & 0x07ff2fff));
+  return emit_thumb_jump(_jit, o);
+}
+
+static void
+T1_ORR(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_ORR|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_ORR(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_ORR,rn,rd,rm);
+}
+
+static void
+T2_ORRI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ORRI,rn,rd,im);
+}
+
+static void
+T1_EOR(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_EOR|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_EOR(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_EOR,rn,rd,rm);
+}
+
+static void
+T2_EORI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_EORI,rn,rd,im);
+}
+
+static void
+T1_MOV(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_MOV|((_u4(rd)&8)<<4)|(_u4(rm)<<3)|(rd&7));
+}
+
+static void
+T1_MOVI(jit_state_t *_jit, int32_t rd, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_MOVI|(_u3(rd)<<8)|_u8(im));
+}
+
+static void
+T2_MOVI(jit_state_t *_jit, int32_t rd, int32_t im)
+{
+  return torri(_jit, THUMB2_MOVI,_NOREG,rd,im);
+}
+
+static void
+T2_MOVWI(jit_state_t *_jit, int32_t rd, int32_t im)
+{
+  return toriw(_jit, THUMB2_MOVWI,rd,im);
+}
+
+static void
+T2_MOVTI(jit_state_t *_jit, int32_t rd, int32_t im)
+{
+  return toriw(_jit, THUMB2_MOVTI,rd,im);
+}
+
+static void
+T1_MVN(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_MVN|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_MVN(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_MVN,_NOREG,rd,rm);
+}
+
+static void
+T2_MVNI(jit_state_t *_jit, int32_t rd, int32_t im)
+{
+  return torri(_jit, THUMB2_MVNI,_NOREG,rd,im);
+}
+
+static void
+T1_NOT(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return T1_MVN(_jit, rd,rm);
+}
+
+static void
+T2_NOT(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return T2_MVN(_jit, rd,rm);
+}
+
+static void
+T1_NOP(jit_state_t *_jit)
+{
+  emit_u16_with_pool(_jit, 0xbf00);
+}
+
+static void
+T1_ADD(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_ADD|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rd));
+}
+
+static void
+T1_ADDX(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_ADDX|((_u4(rdn)&8)<<4)|(_u4(rm)<<3)|(rdn&7));
+}
+
+static void
+T2_ADD(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_ADD,rn,rd,rm);
+}
+
+static void
+T1_ADDI3(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_ADDI3|(_u3(im)<<6)|(_u3(rn)<<3)|_u3(rd));
+}
+
+static void
+T1_ADDI8(jit_state_t *_jit, int32_t rdn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_ADDI8|(_u3(rdn)<<8)|_u8(im));
+}
+
+static void
+T2_ADDI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ADDI,rn,rd,im);
+}
+
+static void
+T2_ADDWI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ADDWI,rn,rd,im);
+}
+
+static void
+T2_ADDS(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_ADD|ARM_S,rn,rd,rm);
+}
+
+static void
+T2_ADDSI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ADDI|ARM_S,rn,rd,im);
+}
+
+static void
+T1_ADC(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_ADC|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_ADCS(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_ADC|ARM_S,rn,rd,rm);
+}
+
+static void
+T2_ADCSI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ADCI|ARM_S,rn,rd,im);
+}
+
+static void
+T1_SUB(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_SUB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rd));
+}
+
+static void
+T2_SUB(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SUB,rn,rd,rm);
+}
+
+static void
+T1_SUBI3(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_SUBI3|(_u3(im)<<6)|(_u3(rn)<<3)|_u3(rd));
+}
+
+static void
+T1_SUBI8(jit_state_t *_jit, int32_t rdn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_SUBI8|(_u3(rdn)<<8)|_u8(im));
+}
+
+static void
+T2_SUBI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_SUBI,rn,rd,im);
+}
+
+static void
+T2_SUBWI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_SUBWI,rn,rd,im);
+}
+
+static void
+T2_SUBS(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SUB|ARM_S,rn,rd,rm);
+}
+
+static void
+T2_SUBSI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_SUBI|ARM_S,rn,rd,im);
+}
+
+static void
+T1_SBC(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_SBC|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_SBCS(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SBC|ARM_S,rn,rd,rm);
+}
+
+static void
+T2_SBCSI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_SBCI|ARM_S,rn,rd,im);
+}
+
+static void
+T1_RSBI(jit_state_t *_jit, int32_t rd, int32_t rn)
+{
+  emit_u16_with_pool(_jit, THUMB_RSBI|(_u3(rn)<<3)|_u3(rd));
+}
+
+static void
+T2_RSBI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_RSBI,rn,rd,im);
+}
+
+static void
+T1_MUL(jit_state_t *_jit, int32_t rdm, int32_t rn)
+{
+  emit_u16_with_pool(_jit, THUMB_MUL|(_u3(rn)<<3)|_u3(rdm));
+}
+
+static void
+T2_MUL(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_MUL,rn,rd,rm);
+}
+
+static void
+T2_SMULL(jit_state_t *_jit, int32_t rl, int32_t rh, int32_t rn, int32_t rm)
+{
+  return torrrr(_jit, THUMB2_SMULL,rn,rl,rh,rm);
+}
+
+static void
+T2_UMULL(jit_state_t *_jit, int32_t rl, int32_t rh, int32_t rn, int32_t rm)
+{
+  return torrrr(_jit, THUMB2_UMULL,rn,rl,rh,rm);
+}
+
+static void
+T2_SDIV(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SDIV,rn,rd,rm);
+}
+
+static void
+T2_UDIV(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_UDIV,rn,rd,rm);
+}
+
+static void
+T1_MLS(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm, int32_t ra)
+{
+  return torrrr(_jit, THUMB_MLS, rn, ra, rd, rm);
+}
+
+static void
+T1_AND(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_AND|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_AND(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_AND,rn,rd,rm);
+}
+
+static void
+T2_ANDI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_ANDI,rn,rd,im);
+}
+
+static void
+T2_BICI(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_BICI,rn,rd,im);
+}
+
+static void
+T1_REV(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_REV|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_REV(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_REV,rm,rd,rm);
+}
+
+static void
+T1_SXTB(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_SXTB|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_SXTB(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SXTB,_NOREG,rd,rm);
+}
+
+static void
+T1_UXTB(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_UXTB|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_UXTB(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_UXTB,_NOREG,rd,rm);
+}
+
+static void
+T1_SXTH(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_SXTH|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_SXTH(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_SXTH,_NOREG,rd,rm);
+}
+
+static void
+T1_UXTH(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_UXTH|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_UXTH(jit_state_t *_jit, int32_t rd, int32_t rm)
+{
+  return torrr(_jit, THUMB2_UXTH,_NOREG,rd,rm);
+}
+
+static void
+T1_LSL(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LSL|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_LSL(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_LSL,rn,rd,rm);
+}
+
+static void
+T1_LSLI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LSLI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_LSLI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  return tshift(_jit, THUMB2_LSLI,rd,rm,im);
+}
+
+static void
+T1_LSR(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LSR|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_LSR(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_LSR,rn,rd,rm);
+}
+
+static void
+T1_LSRI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LSRI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_LSRI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  return tshift(_jit, THUMB2_LSRI,rd,rm,im);
+}
+
+static void
+T1_ASR(jit_state_t *_jit, int32_t rdn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_ASR|(_u3(rm)<<3)|_u3(rdn));
+}
+
+static void
+T2_ASR(jit_state_t *_jit, int32_t rd, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_ASR,rn,rd,rm);
+}
+
+static void
+T1_ASRI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_ASRI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd));
+}
+
+static void
+T2_ASRI(jit_state_t *_jit, int32_t rd, int32_t rm, int32_t im)
+{
+  return tshift(_jit, THUMB2_ASRI,rd,rm,im);
+}
+
+static void
+T1_CMP(jit_state_t *_jit, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_CMP|(_u3(rm)<<3)|_u3(rn));
+}
+
+static void
+T1_CMPX(jit_state_t *_jit, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_CMPX|((_u4(rn)&8)<<4)|(_u4(rm)<<3)|(rn&7));
+}
+
+static void
+T2_CMP(jit_state_t *_jit, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_CMP,rn,_NOREG,rm);
+}
+
+static void
+T1_CMPI(jit_state_t *_jit, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_CMPI|(_u3(rn)<<8)|_u8(im));
+}
+
+static void
+T2_CMPI(jit_state_t *_jit, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_CMPI,rn,_NOREG,im);
+}
+
+static void
+T2_CMNI(jit_state_t *_jit, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_CMNI,rn,_NOREG,im);
+}
+
+static void
+T1_TST(jit_state_t *_jit, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_TST|(_u3(rm)<<3)|_u3(rn));
+}
+
+static void
+T2_TST(jit_state_t *_jit, int32_t rn, int32_t rm)
+{
+  return torrr(_jit, THUMB2_TST,rn,_NOREG,rm);
+}
+
+static void
+T2_TSTI(jit_state_t *_jit, int32_t rn, int32_t im)
+{
+  return torri(_jit, THUMB2_TSTI,rn,_NOREG,im);
+}
+
+static void
+T1_BLX(jit_state_t *_jit, int32_t r0)
+{
+  emit_u16_with_pool(_jit, THUMB_BLX|(_u4(r0)<<3));
+}
+
+static void
+T1_BX(jit_state_t *_jit, int32_t r0)
+{
+  emit_u16_with_pool(_jit, THUMB_BX|(_u4(r0)<<3));
+}
+
+static jit_reloc_t
+T2_CC_B(jit_state_t *_jit, uint32_t cc)
+{
+  return tcb(_jit, cc);
+}
+
+static jit_reloc_t
+T2_B(jit_state_t *_jit)
+{
+  return tb(_jit, THUMB2_B);
+}
+
+static jit_reloc_t
+T2_BLI(jit_state_t *_jit)
+{
+  return tb(_jit, THUMB2_BLI);
+}
+
+static jit_reloc_t
+T2_BLXI(jit_state_t *_jit)
+{
+  return tb(_jit, THUMB2_BLXI);
+}
+
+enum dmb_option { DMB_ISH = 0xb };
+static void
+T1_DMB(jit_state_t *_jit, enum dmb_option option)
+{
+  emit_wide_thumb(_jit, THUMB_DMB|_u4(option));
+}
+
+static void
+T1_LDREX(jit_state_t *_jit, int32_t rt, int32_t rn, int8_t offset)
+{
+  emit_wide_thumb(_jit, THUMB_LDREX|(_u4(rn)<<16)|(_u4(rt)<<12)|_u8(offset));
+}
+
+static void
+T1_STREX(jit_state_t *_jit, int32_t rd, int32_t rt, int32_t rn, int8_t offset)
+{
+  emit_wide_thumb
+    (_jit, THUMB_STREX|(_u4(rn)<<16)|(_u4(rt)<<12)|(_u4(rd)<<8)|_u8(offset));
+}
+
+static void
+T1_LDRSB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRSB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRSB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_LDRSB,rn,rt,rm);
+}
+
+static void
+T2_LDRSBI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRSBI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_LDRSBWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_LDRSBWI,rn,rt,im);
+}
+
+static void
+T2_LDRSBIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRSBI,rn,rt,im);
+}
+
+static void
+T1_LDRB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_LDRB,rn,rt,rm);
+}
+
+static void
+T1_LDRBI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRBI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRBI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRBI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_LDRBWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_LDRBWI,rn,rt,im);
+}
+
+static void
+T2_LDRBIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRBI,rn,rt,im);
+}
+
+static void
+T1_LDRSH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRSH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRSH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_LDRSH,rn,rt,rm);
+}
+
+static void
+T2_LDRSHI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRSHI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_LDRSHWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_LDRSHWI,rn,rt,im);
+}
+
+static void
+T2_LDRSHIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRSHI,rn,rt,im);
+}
+
+static void
+T1_LDRH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_LDRH,rn,rt,rm);
+}
+
+static void
+T1_LDRHI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRHI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDRHI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRHI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_LDRHWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_LDRHWI,rn,rt,im);
+}
+
+static void
+T2_LDRHIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRHI,rn,rt,im);
+}
+
+static void
+T1_LDR(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_LDR|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_LDR(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_LDR,rn,rt,rm);
+}
+
+static void
+T1_LDRI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T1_LDRISP(jit_state_t *_jit, int32_t rt, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_LDRISP|(_u3(rt)<<8)|_u8(im));
+}
+
+static void
+T2_LDRI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_LDRWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_LDRWI,rn,rt,im);
+}
+
+static void
+T2_LDRIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_LDRI,rn,rt,im);
+}
+
+static void
+T1_STRB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_STRB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_STRB(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_STRB,rn,rt,rm);
+}
+
+static void
+T1_STRBI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_STRBI | (_u5(im) << 6) | (_u3(rn) << 3) | _u3(rt));
+}
+
+static void
+T2_STRBI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRBI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_STRBWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_STRBWI,rn,rt,im);
+}
+
+static void
+T2_STRBIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRBI,rn,rt,im);
+}
+
+static void
+T1_STRH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_STRH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_STRH(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_STRH,rn,rt,rm);
+}
+
+static void
+T1_STRHI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_STRHI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_STRHI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRHI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_STRHWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_STRHWI,rn,rt,im);
+}
+
+static void
+T2_STRHIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRHI,rn,rt,im);
+}
+
+static void
+T1_STR(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  emit_u16_with_pool(_jit, THUMB_STR|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T2_STR(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t rm)
+{
+  return torxr(_jit, THUMB2_STR,rn,rt,rm);
+}
+
+static void
+T1_STRI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_STRI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt));
+}
+
+static void
+T1_STRISP(jit_state_t *_jit, int32_t rt, int32_t im)
+{
+  emit_u16_with_pool(_jit, THUMB_STRISP|(_u3(rt)<<8)|(_u8(im)));
+}
+
+static void
+T2_STRI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRI|THUMB2_U,rn,rt,im);
+}
+
+static void
+T2_STRWI(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri12(_jit, THUMB2_STRWI,rn,rt,im);
+}
+
+static void
+T2_STRIN(jit_state_t *_jit, int32_t rt, int32_t rn, int32_t im)
+{
+  return torri8(_jit, THUMB2_STRI,rn,rt,im);
+}
+
+static void
+T1_BRK(jit_state_t *_jit)
+{
+  emit_u16_with_pool(_jit, THUMB_BRK);
+}
+
+static void
+nop(jit_state_t *_jit, int32_t i0)
+{
+  for (; i0 > 0; i0 -= 2)
+    T1_NOP(_jit);
+    
+  ASSERT(i0 == 0);
+}
+
+static void
+movr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1) {
+    T1_MOV(_jit, r0, r1);
+  }
+}
+
+enum preserve_flags { PRESERVE_FLAGS, FLAGS_UNIMPORTANT };
+
+static void
+_movi(jit_state_t *_jit, int32_t r0, jit_word_t i0, enum preserve_flags flags)
+{
+  int                 i;
+    
+  if (flags == PRESERVE_FLAGS && r0 < 8 && !(i0 & 0xffffff80))
+    T1_MOVI(_jit, r0, i0);
+  else if (r0 < 8 && !(i0 & 0xffffff80))
+    T1_MOVI(_jit, r0, i0);
+  else if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_MOVI(_jit, r0, i);
+  else if ((i = encode_thumb_immediate(~i0)) != -1)
+    T2_MVNI(_jit, r0, i);
+  else {
+    T2_MOVWI(_jit, r0, (uint16_t)i0);
+    if (i0 & 0xffff0000)
+      T2_MOVTI(_jit, r0, (uint16_t)((unsigned)i0 >> 16));
+  }
+}
+
+static void
+movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return _movi(_jit, r0, i0, FLAGS_UNIMPORTANT);
+}
+
+static int
+offset_in_load_from_pool_range(int32_t offset)
+{
+  return -0xfff <= offset && offset <= 0xfff;
+}
+
+static int32_t
+decode_load_from_pool_offset(uint32_t inst)
+{
+  int32_t ret = inst & 0xfff;
+  return ((inst >> 23) & 1) ? ret : -ret;
+}
+
+static uint32_t
+encode_load_from_pool_offset(int32_t off)
+{
+  ASSERT(offset_in_load_from_pool_range(off));
+  uint32_t u = off >= 0;
+  uint32_t ret = ((u ? off : -off) & 0xfff) | (u << 23);
+  ASSERT(decode_load_from_pool_offset(ret) == off);
+  return ret;
+}
+
+static uint32_t
+patch_load_from_pool(uint32_t inst, int32_t off)
+{
+  uint32_t load_from_pool_mask = THUMB2_LDRP | (0xf << 12);
+  return (inst & load_from_pool_mask) | encode_load_from_pool_offset(off);
+}
+
+static int32_t
+read_load_from_pool_offset(uint32_t *loc)
+{
+  return decode_load_from_pool_offset(read_wide_thumb(loc));
+}
+
+static void
+patch_load_from_pool_offset(uint32_t *loc, int32_t v)
+{
+  write_wide_thumb(loc, patch_load_from_pool(read_wide_thumb(loc), v));
+}
+
+static jit_reloc_t
+emit_load_from_pool(jit_state_t *_jit, uint32_t inst)
+{
+  while (1) {
+    uint8_t *pc_base = (uint8_t *)((_jit->pc.w + 4) & ~3);
+    uint8_t rsh = 0;
+    int32_t off = (_jit->pc.uc - pc_base) >> rsh;
+    jit_reloc_t ret =
+      jit_reloc (_jit, JIT_RELOC_LOAD_FROM_POOL, 0, _jit->pc.uc, pc_base, rsh);
+    uint8_t load_from_pool_width = 12;
+    if (add_pending_literal(_jit, ret, load_from_pool_width)) {
+      emit_wide_thumb(_jit, patch_load_from_pool(inst, off));
+      return ret;
+    }
+  }
+}  
+
+static jit_reloc_t
+movi_from_pool(jit_state_t *_jit, int32_t Rt)
+{
+  return emit_load_from_pool(_jit, THUMB2_LDRP | (_u4(Rt) << 12));
+}
+
+static jit_reloc_t
+mov_addr(jit_state_t *_jit, int32_t r0)
+{
+  return movi_from_pool(_jit, r0);
+}
+
+static void
+comr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_NOT(_jit, r0, r1);
+  else
+    T2_NOT(_jit, r0, r1);
+}
+
+static void
+negr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_RSBI(_jit, r0, r1);
+  else
+    T2_RSBI(_jit, r0, r1, 0);
+}
+
+static void
+addr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_ADD(_jit, r0, r1, r2);
+  else if (r0 == r1 || r0 == r2)
+    T1_ADDX(_jit, r0, r0 == r1 ? r2 : r1);
+  else
+    T2_ADD(_jit, r0, r1, r2);
+}
+
+static void
+addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((r0|r1) < 8 && !(i0 & ~7))
+    T1_ADDI3(_jit, r0, r1, i0);
+  else if ((r0|r1) < 8 && !(-i0 & ~7))
+    T1_SUBI3(_jit, r0, r1, -i0);
+  else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff))
+    T1_ADDI8(_jit, r0, i0);
+  else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff))
+    T1_SUBI8(_jit, r0, -i0);
+  else if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_ADDI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(-i0)) != -1)
+    T2_SUBI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_word_immediate(i0)) != -1)
+    T2_ADDWI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_word_immediate(-i0)) != -1)
+    T2_SUBWI(_jit, r0, r1, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_ADD(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+addcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  /* thumb auto set carry if not inside IT block */
+  if ((r0|r1|r2) < 8)
+    T1_ADD(_jit, r0, r1, r2);
+  else
+    T2_ADDS(_jit, r0, r1, r2);
+}
+
+static void
+addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((r0|r1) < 8 && !(i0 & ~7))
+    T1_ADDI3(_jit, r0, r1, i0);
+  else if ((r0|r1) < 8 && !(-i0 & ~7))
+    T1_SUBI3(_jit, r0, r1, -i0);
+  else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff))
+    T1_ADDI8(_jit, r0, i0);
+  else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff))
+    T1_SUBI8(_jit, r0, -i0);
+  else if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_ADDSI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(-i0)) != -1)
+    T2_SUBSI(_jit, r0, r1, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_ADDS(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+addxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  /* keep setting carry because don't know last ADC */
+  
+  /* thumb auto set carry if not inside IT block */
+  if ((r0|r1|r2) < 8 && (r0 == r1 || r0 == r2))
+    T1_ADC(_jit, r0, r0 == r1 ? r2 : r1);
+  else
+    T2_ADCS(_jit, r0, r1, r2);
+}
+
+static void
+addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+  if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_ADCSI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(-i0)) != -1)
+    T2_SBCSI(_jit, r0, r1, i);
+  else if (r0 != r1) {
+    _movi(_jit, r0, i0, PRESERVE_FLAGS);
+    T2_ADCS(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    _movi(_jit, jit_gpr_regno(reg), i0, PRESERVE_FLAGS);
+    T2_ADCS(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_SUB(_jit, r0, r1, r2);
+  else
+    T2_SUB(_jit, r0, r1, r2);
+}
+
+static void
+subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((r0|r1) < 8 && !(i0 & ~7))
+    T1_SUBI3(_jit, r0, r1, i0);
+  else if ((r0|r1) < 8 && !(-i0 & ~7))
+    T1_ADDI3(_jit, r0, r1, -i0);
+  else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff))
+    T1_SUBI8(_jit, r0, i0);
+  else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff))
+    T1_ADDI8(_jit, r0, -i0);
+  else if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_SUBI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(-i0)) != -1)
+    T2_ADDI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_word_immediate(i0)) != -1)
+    T2_SUBWI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_word_immediate(-i0)) != -1)
+    T2_ADDWI(_jit, r0, r1, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_SUB(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  /* thumb auto set carry if not inside IT block */
+  if ((r0|r1|r2) < 8)
+    T1_SUB(_jit, r0, r1, r2);
+  else
+    T2_SUBS(_jit, r0, r1, r2);
+}
+
+static void
+subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((r0|r1) < 8 && !(i0 & ~7))
+    T1_SUBI3(_jit, r0, r1, i0);
+  else if ((r0|r1) < 8 && !(-i0 & ~7))
+    T1_ADDI3(_jit, r0, r1, -i0);
+  else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff))
+    T1_SUBI8(_jit, r0, i0);
+  else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff))
+    T1_ADDI8(_jit, r0, -i0);
+  else if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_SUBSI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(-i0)) != -1)
+    T2_ADDSI(_jit, r0, r1, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_SUBS(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  /* keep setting carry because don't know last SBC */
+  
+  /* thumb auto set carry if not inside IT block */
+  if ((r0|r1|r2) < 8 && r0 == r1)
+    T1_SBC(_jit, r0, r2);
+  else
+    T2_SBCS(_jit, r0, r1, r2);
+}
+
+static void
+subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+  if ((i = encode_arm_immediate(i0)) != -1)
+    T2_SBCSI(_jit, r0, r1, i);
+  else if ((i = encode_arm_immediate(-i0)) != -1)
+    T2_ADCSI(_jit, r0, r1, i);
+  else if (r0 != r1) {
+    _movi(_jit, r0, i0, PRESERVE_FLAGS);
+    T2_SBCS(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    _movi(_jit, jit_gpr_regno(reg), i0, PRESERVE_FLAGS);
+    T2_SBCS(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+mulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r2 && (r0|r1) < 8)
+    T1_MUL(_jit, r0, r1);
+  else if (r0 == r1 && (r0|r2) < 8)
+    T1_MUL(_jit, r0, r2);
+  else
+    T2_MUL(_jit, r0, r1, r2);
+}
+
+static void
+muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  mulr(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+iqmulr(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, int32_t r3, jit_bool_t sign)
+{
+  if (r2 == r3) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r2);
+    if (sign)
+      T2_SMULL(_jit, r0, r1, jit_gpr_regno(reg), r2);
+    else
+      T2_UMULL(_jit, r0, r1, jit_gpr_regno(reg), r2);
+    unget_temp_gpr(_jit);
+  } else if (r0 != r2 && r1 != r2) {
+    if (sign)
+      T2_SMULL(_jit, r0, r1, r2, r3);
+    else
+      T2_UMULL(_jit, r0, r1, r2, r3);
+  } else {
+    if (sign)
+      T2_SMULL(_jit, r0, r1, r3, r2);
+    else
+      T2_UMULL(_jit, r0, r1, r3, r2);
+  }
+}
+
+static void
+iqmuli(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  iqmulr(_jit, r0, r1, r2, jit_gpr_regno(reg), sign);
+  unget_temp_gpr(_jit);
+}
+
+static void
+qmulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqmulr(_jit, r0,r1,r2,r3,1);
+}
+
+static void
+qmulr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqmulr(_jit, r0,r1,r2,r3,0);
+}
+
+static void
+qmuli(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t i0)
+{
+  return iqmuli(_jit, r0,r1,r2,i0,1);
+}
+
+static void
+qmuli_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t i0)
+{
+  return iqmuli(_jit, r0,r1,r2,i0,0);
+}
+
+static void
+divr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  T2_SDIV(_jit, r0, r1, r2);
+}
+
+static void
+divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  divr(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+divr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  T2_UDIV(_jit, r0, r1, r2);
+}
+
+static void
+divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  divr_u(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+iqdivr(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, int32_t r3, jit_bool_t sign)
+{
+  int need_tmp = r0 == r2 || r0 == r3;
+  if (need_tmp) {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    if (r0 == r2) {
+      movr(_jit, tmp, r2);
+      r2 = tmp;
+    }
+    if (r0 == r3) {
+      if (r2 != r3)
+        movr(_jit, tmp, r3);
+      r3 = tmp;
+    }
+  }
+  if (sign)
+    divr(_jit, r0, r2, r3);
+  else
+    divr_u(_jit, r0, r2, r3);
+  T1_MLS(_jit, r1, r3, r0, r2);
+  if (need_tmp)
+    unget_temp_gpr(_jit);
+}
+
+static void
+iqdivi(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  iqdivr(_jit, r0, r1, r2, jit_gpr_regno(reg), sign);
+  unget_temp_gpr(_jit);
+}
+
+static void
+qdivr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit, r0,r1,r2,r3,1);
+}
+
+static void
+qdivr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit, r0,r1,r2,r3,0);
+}
+
+static void
+qdivi(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t i0)
+{
+  return iqdivi(_jit, r0,r1,r2,i0,1);
+}
+
+static void
+qdivi_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t i0)
+{
+  return iqdivi(_jit, r0,r1,r2,i0,0);
+}
+
+static void
+iremr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_bool_t sign)
+{
+  return iqdivr(_jit, r0, r0, r1, r2, sign);
+}
+
+static void
+remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return iremr(_jit, r0, r1, r2, 1);
+}
+
+static void
+remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  remr(_jit, r0, r1, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return iremr(_jit, r0, r1, r2, 0);
+}
+
+static void
+remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  remr_u(_jit, r0, r1,jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+andr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && (r0 == r1 || r0 == r2))
+    T1_AND(_jit, r0, r0 == r1 ? r2 : r1);
+  else
+    T2_AND(_jit, r0, r1, r2);
+}
+
+static void
+andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_ANDI(_jit, r0, r1, i);
+  else if ((i = encode_thumb_immediate(~i0)) != -1)
+    T2_BICI(_jit, r0, r1, i);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    T2_AND(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_AND(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+orr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && (r0 == r1 || r0 == r2))
+    T1_ORR(_jit, r0, r0 == r1 ? r2 : r1);
+  else
+    T2_ORR(_jit, r0, r1, r2);
+}
+
+static void
+ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_ORRI(_jit, r0, r1, i);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    T2_ORR(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_ORR(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+xorr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && (r0 == r1 || r0 == r2))
+    T1_EOR(_jit, r0, r0 == r1 ? r2 : r1);
+  else
+    T2_EOR(_jit, r0, r1, r2);
+}
+
+static void
+xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  int                 i;
+    
+  if ((i = encode_thumb_immediate(i0)) != -1)
+    T2_EORI(_jit, r0, r1, i);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    T2_EOR(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    T2_EOR(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+lshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && r0 == r1)
+    T1_LSL(_jit, r0, r2);
+  else
+    T2_LSL(_jit, r0, r1, r2);
+}
+
+static void
+lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(i0 >= 0 && i0 <= 31);
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else {
+    if ((r0|r1) < 8)
+      T1_LSLI(_jit, r0, r1, i0);
+    else
+      T2_LSLI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+rshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && r0 == r1)
+    T1_ASR(_jit, r0, r2);
+  else
+    T2_ASR(_jit, r0, r1, r2);
+}
+
+static void
+rshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(i0 >= 0 && i0 <= 31);
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else {
+    if ((r0|r1) < 8)
+      T1_ASRI(_jit, r0, r1, i0);
+    else
+      T2_ASRI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+rshr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8 && r0 == r1)
+    T1_LSR(_jit, r0, r2);
+  else
+    T2_LSR(_jit, r0, r1, r2);
+}
+
+static void
+rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  ASSERT(i0 >= 0 && i0 <= 31);
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else {
+    if ((r0|r1) < 8)
+      T1_LSRI(_jit, r0, r1, i0);
+    else
+      T2_LSRI(_jit, r0, r1, i0);
+  }
+}
+
+static void
+jmpr(jit_state_t *_jit, int32_t r0)
+{
+  T1_MOV(_jit, jit_gpr_regno(_PC), r0);
+}
+
+static jit_reloc_t
+jmp(jit_state_t *_jit)
+{
+  return T2_B(_jit);
+}
+
+static void
+jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+  /* Strip thumb bit, if any.  */
+  i0 &= ~1;
+  return jit_patch_there(_jit, jmp(_jit), (void*)i0);
+}
+
+static jit_reloc_t
+bccr(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_CMP(_jit, r0, r1);
+  else if ((r0&r1) & 8)
+    T1_CMPX(_jit, r0, r1);
+  else
+    T2_CMP(_jit, r0, r1);
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bcci(jit_state_t *_jit, int cc, int32_t r0, jit_word_t i1)
+{
+  int i;
+  if (r0 < 7 && !(i1 & 0xffffff00))
+    T1_CMPI(_jit, r0, i1);
+  else if ((i = encode_thumb_immediate(i1)) != -1)
+    T2_CMPI(_jit, r0, i);
+  else if ((i = encode_thumb_immediate(-i1)) != -1)
+    T2_CMNI(_jit, r0, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    T2_CMP(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bltr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_LT, r0, r1);
+}
+
+static jit_reloc_t
+blti(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_LT, r0, i1);
+}
+
+static jit_reloc_t
+bltr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_LO, r0, r1);
+}
+
+static jit_reloc_t
+blti_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_LO, r0, i1);
+}
+
+static jit_reloc_t
+bler(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_LE, r0, r1);
+}
+
+static jit_reloc_t
+blei(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_LE, r0, i1);
+}
+
+static jit_reloc_t
+bler_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_LS, r0, r1);
+}
+
+static jit_reloc_t
+blei_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_LS, r0, i1);
+}
+
+static jit_reloc_t
+beqr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_EQ, r0, r1);
+}
+
+static jit_reloc_t
+beqi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_EQ, r0, i1);
+}
+
+static jit_reloc_t
+bger(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bgei(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_GE, r0, i1);
+}
+
+static jit_reloc_t
+bger_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_HS, r0, r1);
+}
+
+static jit_reloc_t
+bgei_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_HS, r0, i1);
+}
+
+static jit_reloc_t
+bgtr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bgti(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_GT, r0, i1);
+}
+
+static jit_reloc_t
+bgtr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_HI, r0, r1);
+}
+
+static jit_reloc_t
+bgti_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_HI, r0, i1);
+}
+
+static jit_reloc_t
+bner(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bccr(_jit, ARM_CC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bnei(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bcci(_jit, ARM_CC_NE, r0, i1);
+}
+
+static jit_reloc_t
+baddr(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_ADD(_jit, r0, r0, r1);
+  else
+    T2_ADDS(_jit, r0, r0, r1);
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+baddi(jit_state_t *_jit, int cc, int32_t r0, int i1)
+{
+  int i;
+  if (r0 < 8 && !(i1 & ~7))
+    T1_ADDI3(_jit, r0, r0, i1);
+  else if (r0 < 8 && !(-i1 & ~7))
+    T1_SUBI3(_jit, r0, r0, -i1);
+  else if (r0 < 8 && !(i1 & ~0xff))
+    T1_ADDI8(_jit, r0, i1);
+  else if (r0 < 8 && !(-i1 & ~0xff))
+    T1_SUBI8(_jit, r0, -i1);
+  else if ((i = encode_thumb_immediate(i1)) != -1)
+    T2_ADDSI(_jit, r0, r0, i);
+  else if ((i = encode_thumb_immediate(-i1)) != -1)
+    T2_SUBSI(_jit, r0, r0, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    T2_ADDS(_jit, r0, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+boaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit, ARM_CC_VS, r0, r1);
+}
+
+static jit_reloc_t
+boaddi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit, ARM_CC_VS, r0, i1);
+}
+
+static jit_reloc_t
+boaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit, ARM_CC_HS, r0, r1);
+}
+
+static jit_reloc_t
+boaddi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit, ARM_CC_HS, r0, i1);
+}
+
+static jit_reloc_t
+bxaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit, ARM_CC_VC, r0, r1);
+}
+
+static jit_reloc_t
+bxaddi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit, ARM_CC_VC, r0, i1);
+}
+
+static jit_reloc_t
+bxaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return baddr(_jit, ARM_CC_LO, r0, r1);
+}
+
+static jit_reloc_t
+bxaddi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return baddi(_jit, ARM_CC_LO, r0, i1);
+}
+
+static jit_reloc_t
+bsubr(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_SUB(_jit, r0, r0, r1);
+  else
+    T2_SUBS(_jit, r0, r0, r1);
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bsubi(jit_state_t *_jit, int cc, int32_t r0, int i1)
+{
+  int i;
+  if (r0 < 8 && !(i1 & ~7))
+    T1_SUBI3(_jit, r0, r0, i1);
+  else if (r0 < 8 && !(-i1 & ~7))
+    T1_ADDI3(_jit, r0, r0, -i1);
+  else if (r0 < 8 && !(i1 & ~0xff))
+    T1_SUBI8(_jit, r0, i1);
+  else if (r0 < 8 && !(-i1 & ~0xff))
+    T1_ADDI8(_jit, r0, -i1);
+  else if ((i = encode_thumb_immediate(i1)) != -1)
+    T2_SUBSI(_jit, r0, r0, i);
+  else if ((i = encode_thumb_immediate(-i1)) != -1)
+    T2_SUBSI(_jit, r0, r0, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    T2_SUBS(_jit, r0, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bosubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit, ARM_CC_VS, r0, r1);
+}
+
+static jit_reloc_t
+bosubi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit, ARM_CC_VS, r0, i1);
+}
+
+static jit_reloc_t
+bosubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit, ARM_CC_LO, r0, r1);
+}
+
+static jit_reloc_t
+bosubi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit, ARM_CC_LO, r0, i1);
+}
+
+static jit_reloc_t
+bxsubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit, ARM_CC_VC, r0, r1);
+}
+
+static jit_reloc_t
+bxsubi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit, ARM_CC_VC, r0, i1);
+}
+
+static jit_reloc_t
+bxsubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bsubr(_jit, ARM_CC_HS, r0, r1);
+}
+
+static jit_reloc_t
+bxsubi_u(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bsubi(_jit, ARM_CC_HS, r0, i1);
+}
+
+static jit_reloc_t
+bmxr(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_TST(_jit, r0, r1);
+  else
+    T2_TST(_jit, r0, r1);
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bmxi(jit_state_t *_jit, int cc, int32_t r0, jit_word_t i1)
+{
+  int i;
+  if ((i = encode_thumb_immediate(i1)) != -1)
+    T2_TSTI(_jit, r0, i);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    T2_TST(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+bmsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bmxr(_jit, ARM_CC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bmsi(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bmxi(_jit, ARM_CC_NE, r0, i1);
+}
+
+static jit_reloc_t
+bmcr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return bmxr(_jit, ARM_CC_EQ, r0, r1);
+}
+
+static jit_reloc_t
+bmci(jit_state_t *_jit, int32_t r0, int32_t i1)
+{
+  return bmxi(_jit, ARM_CC_EQ, r0, i1);
+}
+
+static void
+ldr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_LDRSBI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_LDRSBI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_LDRSB(_jit, r0, r1, r2);
+  else
+    T2_LDRSB(_jit, r0, r1, r2);
+}
+
+#define jit_ldrt_strt_p() 0
+
+static void
+ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    
+  if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_LDRSBI(_jit, r0, r1, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_LDRSBIN(_jit, r0, r1, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_LDRSBWI(_jit, r0, r1, i0);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    if ((r0|r1) < 8)
+      T1_LDRSB(_jit, r0, r1, r0);
+    else
+      T2_LDRSB(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_LDRSB(_jit, r0, r1, jit_gpr_regno(reg));
+    else
+      T2_LDRSB(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_LDRBI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_LDRBI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_LDRB(_jit, r0, r1, r2);
+  else
+    T2_LDRB(_jit, r0, r1, r2);
+}
+
+static void
+ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && i0 < 0x20)
+    T1_LDRBI(_jit, r0, r1, i0);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_LDRBI(_jit, r0, r1, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_LDRBIN(_jit, r0, r1, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_LDRBWI(_jit, r0, r1, i0);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    if ((r0|r1) < 8)
+      T1_LDRB(_jit, r0, r1, r0);
+    else
+      T2_LDRB(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_LDRB(_jit, r0, r1, jit_gpr_regno(reg));
+    else
+      T2_LDRB(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_LDRSHI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_LDRSHI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_LDRSH(_jit, r0, r1, r2);
+  else
+    T2_LDRSH(_jit, r0, r1, r2);
+}
+
+static void
+ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_LDRSHI(_jit, r0, r1, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_LDRSHIN(_jit, r0, r1, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_LDRSHWI(_jit, r0, r1, i0);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    if ((r0|r1) < 8)
+      T1_LDRSH(_jit, r0, r1, r0);
+    else
+      T2_LDRSH(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_LDRSH(_jit, r0, r1, jit_gpr_regno(reg));
+    else
+      T2_LDRSH(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_LDRHI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_LDRHI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  
+  if ((r0|r1|r2) < 8)
+    T1_LDRH(_jit, r0, r1, r2);
+  else
+    T2_LDRH(_jit, r0, r1, r2);
+}
+
+static void
+ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 1) && (i0 >> 1) < 0x20)
+    T1_LDRHI(_jit, r0, r1, i0 >> 1);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_LDRHI(_jit, r0, r1, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_LDRHIN(_jit, r0, r1, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_LDRHWI(_jit, r0, r1, i0);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    if ((r0|r1) < 8)
+      T1_LDRH(_jit, r0, r1, r0);
+    else
+      T2_LDRH(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_LDRH(_jit, r0, r1, jit_gpr_regno(reg));
+    else
+      T2_LDRH(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_LDRI(_jit, r0, r1, 0);
+}
+
+static void
+ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_LDRI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_LDR(_jit, r0, r1, r2);
+  else
+    T2_LDR(_jit, r0, r1, r2);
+}
+
+static void
+ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 3) && (i0 >> 2) < 0x20)
+    T1_LDRI(_jit, r0, r1, i0 >> 2);
+  else if (r1 == jit_gpr_regno(JIT_SP) && r0 < 8 &&
+           i0 >= 0 && !(i0 & 3) && (i0 >> 2) <= 255)
+    T1_LDRISP(_jit, r0, i0 >> 2);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_LDRI(_jit, r0, r1, i0);
+  else if (i0 < 0 && i0 > -255)
+    T2_LDRIN(_jit, r0, r1, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_LDRWI(_jit, r0, r1, i0);
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    if ((r0|r1) < 8)
+      T1_LDR(_jit, r0, r1, r0);
+    else
+      T2_LDR(_jit, r0, r1, r0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_LDR(_jit, r0, r1, jit_gpr_regno(reg));
+    else
+      T2_LDR(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+str_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_STRBI(_jit, r1, r0, 0);
+}
+
+static void
+sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_STRBI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_STRB(_jit, r2, r1, r0);
+  else
+    T2_STRB(_jit, r2, r1, r0);
+}
+
+static void
+stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && i0 < 0x20)
+    T1_STRBI(_jit, r1, r0, i0);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_STRBI(_jit, r1, r0, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_STRBIN(_jit, r1, r0, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_STRBWI(_jit, r1, r0, i0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_STRB(_jit, r1, r0, jit_gpr_regno(reg));
+    else
+      T2_STRB(_jit, r1, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+str_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_STRHI(_jit, r1, r0, 0);
+}
+
+static void
+sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_STRHI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_STRH(_jit, r2, r1, r0);
+  else
+    T2_STRH(_jit, r2, r1, r0);
+}
+
+static void
+stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 1) && (i0 >> 1) < 0x20)
+    T1_STRHI(_jit, r1, r0, i0 >> 1);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_STRHI(_jit, r1, r0, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_STRHIN(_jit, r1, r0, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_STRHWI(_jit, r1, r0, i0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_STRH(_jit, r1, r0, jit_gpr_regno(reg));
+    else
+      T2_STRH(_jit, r1, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+str_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  T2_STRI(_jit, r1, r0, 0);
+}
+
+static void
+sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  T2_STRI(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if ((r0|r1|r2) < 8)
+    T1_STR(_jit, r2, r1, r0);
+  else
+    T2_STR(_jit, r2, r1, r0);
+}
+
+static void
+stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 3) && (i0 >> 2) < 0x20)
+    T1_STRI(_jit, r1, r0, i0 >> 2);
+  else if (r0 == jit_gpr_regno(JIT_SP) && r1 < 8 &&
+           i0 >= 0 && !(i0 & 3) && (i0 >> 2) <= 255)
+    T1_STRISP(_jit, r1, i0 >> 2);
+  else if (jit_ldrt_strt_p() && i0 >= 0 && i0 <= 255)
+    T2_STRI(_jit, r1, r0, i0);
+  else if (i0 < 0 && i0 >= -255)
+    T2_STRIN(_jit, r1, r0, -i0);
+  else if (i0 >= 0 && i0 <= 4095)
+    T2_STRWI(_jit, r1, r0, i0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if ((r0|r1|jit_gpr_regno(reg)) < 8)
+      T1_STR(_jit, r1, r0, jit_gpr_regno(reg));
+    else
+      T2_STR(_jit, r1, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+bswapr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_REV(_jit, r0, r1);
+  else
+    T2_REV(_jit, r0, r1);
+  rshi_u(_jit, r0, r0, 16);
+}
+
+/* inline glibc htonl (without register clobber) */
+static void
+bswapr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_REV(_jit, r0, r1);
+  else
+    T2_REV(_jit, r0, r1);
+}
+
+static void
+extr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  
+  if ((r0|r1) < 8)
+    T1_SXTB(_jit, r0, r1);
+  else
+    T2_SXTB(_jit, r0, r1);
+}
+
+static void
+extr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_UXTB(_jit, r0, r1);
+  else
+    T2_UXTB(_jit, r0, r1);
+}
+
+static void
+extr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_SXTH(_jit, r0, r1);
+  else
+    T2_SXTH(_jit, r0, r1);
+}
+
+static void
+extr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if ((r0|r1) < 8)
+    T1_UXTH(_jit, r0, r1);
+  else
+    T2_UXTH(_jit, r0, r1);
+}
+
+static void
+callr(jit_state_t *_jit, int32_t r0)
+{
+  T1_BLX(_jit, r0);
+}
+
+static void
+calli(jit_state_t *_jit, jit_word_t i0)
+{
+  if (i0 & 1)
+    jit_patch_there(_jit, T2_BLI(_jit), (void*)(i0 & ~1));
+  else
+    jit_patch_there(_jit, T2_BLXI(_jit), (void*)i0);
+}
+
+static void
+jmpi_with_link(jit_state_t *_jit, jit_word_t i0)
+{
+  jit_patch_there(_jit, T2_BLI(_jit), (void*)i0);
+}
+
+static void
+push_link_register(jit_state_t *_jit)
+{
+}
+
+static void
+pop_link_register(jit_state_t *_jit)
+{
+}
+
+static void
+ret(jit_state_t *_jit)
+{
+  T1_BX(_jit, jit_gpr_regno(_LR));
+}
+
+static void
+reti(jit_state_t *_jit, int32_t i0)
+{
+  movi(_jit, jit_gpr_regno(_R0), i0);
+  ret(_jit);
+}
+
+static void
+retr(jit_state_t *_jit, int32_t r0)
+{
+  movr(_jit, jit_gpr_regno(_R0), r0);
+  ret(_jit);
+}
+
+static void
+retval_c(jit_state_t *_jit, int32_t r0)
+{
+  extr_c(_jit, r0, jit_gpr_regno(_R0));
+}
+
+static void
+retval_uc(jit_state_t *_jit, int32_t r0)
+{
+  extr_uc(_jit, r0, jit_gpr_regno(_R0));
+}
+
+static void
+retval_s(jit_state_t *_jit, int32_t r0)
+{
+  extr_s(_jit, r0, jit_gpr_regno(_R0));
+}
+
+static void
+retval_us(jit_state_t *_jit, int32_t r0)
+{
+  extr_us(_jit, r0, jit_gpr_regno(_R0));
+}
+
+static void
+retval_i(jit_state_t *_jit, int32_t r0)
+{
+  movr(_jit, r0, jit_gpr_regno(_R0));
+}
+
+static uint32_t*
+jmp_without_veneer(jit_state_t *_jit)
+{
+  uint32_t *loc = _jit->pc.ui;
+  emit_u16(_jit, 0);
+  emit_u16(_jit, 0);
+  return loc;
+}
+
+static void
+patch_jmp_without_veneer(jit_state_t *_jit, uint32_t *loc)
+{
+  uint8_t *pc_base = ((uint8_t *)loc) + 4;
+  uint8_t rsh = 1;
+  int32_t off = (_jit->pc.uc - pc_base) >> rsh;
+  write_wide_thumb(loc, THUMB2_B | encode_thumb_jump(off));
+}
+
+struct veneer
+{
+  uint16_t ldr;
+  uint16_t br;
+  uint32_t addr;
+};
+
+static void
+patch_veneer(uint32_t *loc, jit_pointer_t addr)
+{
+  struct veneer *v = (struct veneer*) loc;
+  v->addr = (uintptr_t) addr;
+}
+
+static void
+emit_veneer(jit_state_t *_jit, jit_pointer_t target)
+{
+  uint16_t thumb1_ldr = 0x4800;
+  int32_t tmp = jit_gpr_regno(JIT_TMP1);
+  int32_t rd = jit_gpr_regno(_PC);
+  ASSERT(tmp < 8);
+  // Loaded addr is 4 bytes after the LDR, which is aligned, so offset is 0.
+  emit_u16(_jit, thumb1_ldr | (tmp << 8));
+  emit_u16(_jit, THUMB_MOV|((_u4(rd)&8)<<4)|(_u4(tmp)<<3)|(rd&7));
+  emit_u32(_jit, (uint32_t) target);
+}
+
+static void
+ldr_atomic(jit_state_t *_jit, int32_t dst, int32_t loc)
+{
+  T1_DMB(_jit, DMB_ISH);
+  ldr_i(_jit, dst, loc);
+  T1_DMB(_jit, DMB_ISH);
+}
+
+static void
+str_atomic(jit_state_t *_jit, int32_t loc, int32_t val)
+{
+  T1_DMB(_jit, DMB_ISH);
+  str_i(_jit, loc, val);
+  T1_DMB(_jit, DMB_ISH);
+}
+
+static void
+swap_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t val)
+{
+  int32_t result = jit_gpr_regno(get_temp_gpr(_jit));
+  int32_t val_or_tmp = dst == val ? jit_gpr_regno(get_temp_gpr(_jit)) : val;
+  movr(_jit, val_or_tmp, val);
+  T1_DMB(_jit, DMB_ISH);
+  void *retry = jit_address(_jit);
+  T1_LDREX(_jit, dst, loc, 0);
+  T1_STREX(_jit, result, val_or_tmp, loc, 0);
+  jit_patch_there(_jit, bnei(_jit, result, 0), retry);
+  T1_DMB(_jit, DMB_ISH);
+  if (dst == val) unget_temp_gpr(_jit);
+  unget_temp_gpr(_jit);
+}
+
+static void
+cas_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t expected,
+           int32_t desired)
+{
+  int32_t dst_or_tmp;
+  if (dst == loc || dst == expected || dst == expected)
+    dst_or_tmp = jit_gpr_regno(get_temp_gpr(_jit));
+  else
+    dst_or_tmp = dst;
+  T1_DMB(_jit, DMB_ISH);
+  void *retry = jit_address(_jit);
+  T1_LDREX(_jit, dst_or_tmp, loc, 0);
+  jit_reloc_t bad = bner(_jit, dst_or_tmp, expected);
+  int result = jit_gpr_regno(get_temp_gpr(_jit));
+  T1_STREX(_jit, result, desired, loc, 0);
+  jit_patch_there(_jit, bnei(_jit, result, 0), retry);
+  unget_temp_gpr(_jit);
+  jit_patch_here(_jit, bad);
+  T1_DMB(_jit, DMB_ISH);
+  movr(_jit, dst, dst_or_tmp);
+  unget_temp_gpr(_jit);
+}
+
+static void
+breakpoint(jit_state_t *_jit)
+{
+  T1_BRK(_jit);
+}
diff --git a/libguile/lightening/lightening/arm-vfp.c b/libguile/lightening/lightening/arm-vfp.c
new file mode 100644
index 000000000..208edc316
--- /dev/null
+++ b/libguile/lightening/lightening/arm-vfp.c
@@ -0,0 +1,1168 @@
+/*
+ * Copyright (C) 2012-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#define ARM_V_F64               0x00000100
+#define ARM_VADD_F              0x0e300a00
+#define ARM_VSUB_F              0x0e300a40
+#define ARM_VMUL_F              0x0e200a00
+#define ARM_VDIV_F              0x0e800a00
+#define ARM_VABS_F              0x0eb00ac0
+#define ARM_VNEG_F              0x0eb10a40
+#define ARM_VSQRT_F             0x0eb10ac0
+#define ARM_VMOV_F              0x0eb00a40
+#define ARM_VMOV_A_S            0x0e100a10 /* vmov rn, sn */
+#define ARM_VMOV_S_A            0x0e000a10 /* vmov sn, rn */
+#define ARM_VMOV_D_AA           0x0c400b10 /* vmov dn, rn,rn */
+#define ARM_VCMP                0x0eb40a40
+#define ARM_VMRS                0x0ef10a10
+#define ARM_VCVT_2I             0x00040000 /* to integer */
+#define ARM_VCVT_2S             0x00010000 /* to signed */
+#define ARM_VCVT_RS             0x00000080 /* round to zero or signed */
+#define ARM_VCVT                0x0eb80a40
+#define ARM_VCVT_S32_F32        ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S|ARM_VCVT_RS
+#define ARM_VCVT_S32_F64        ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S|ARM_VCVT_RS|ARM_V_F64
+#define ARM_VCVT_F32_S32        ARM_VCVT|ARM_VCVT_RS
+#define ARM_VCVT_F64_S32        ARM_VCVT|ARM_VCVT_RS|ARM_V_F64
+#define ARM_VCVT_F              0x0eb70ac0
+#define ARM_VCVT_F32_F64        ARM_VCVT_F
+#define ARM_VCVT_F64_F32        ARM_VCVT_F|ARM_V_F64
+#define ARM_P                   0x00800000 /* positive offset */
+#define ARM_V_D                 0x00400000
+#define ARM_V_N                 0x00000080
+#define ARM_V_M                 0x00000020
+#define ARM_V_I32               0x00200000
+#define ARM_VMOVI               0x02800010
+#define ARM_VMVNI               0x02800030
+#define ARM_VLDR                0x0d100a00
+#define ARM_VSTR                0x0d000a00
+#define ARM_VM                  0x0c000a00
+#define ARM_VMOV_A_D            0x0e100b10
+#define ARM_VMOV_D_A            0x0e000b10
+
+#define vfp_regno(rn)         ((rn) >> 1)
+
+static void
+vodi(jit_state_t *_jit, int oi, int r0)
+{
+  ASSERT(!(oi  & 0x0000f000));
+  ASSERT(!(r0 & 1));
+  r0 >>= 1;
+  emit_wide_thumb(_jit, oi|(_u4(r0)<<12));
+}
+
+static void
+vo_ss(jit_state_t *_jit, int o, int r0, int r1)
+{
+  ASSERT(!(o  & 0xf000f00f));
+  if (r0 & 1) o |= ARM_V_D;
+  if (r1 & 1) o |= ARM_V_M;
+  r0 >>= 1; r1 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r0)<<12)|_u4(r1));
+}
+
+static void
+vo_dd(jit_state_t *_jit, int o, int r0, int r1)
+{
+  ASSERT(!(o  & 0xf000f00f));
+  ASSERT(!(r0 & 1) && !(r1 & 1));
+  r0 >>= 1; r1 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r0)<<12)|_u4(r1));
+}
+
+static void
+vors_(jit_state_t *_jit, int o, int r0, int r1)
+{
+  ASSERT(!(o  & 0xf000f00f));
+  if (r1 & 1) o |= ARM_V_N;
+  r1 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12));
+}
+
+static void
+vori_(jit_state_t *_jit, int o, int r0, int r1)
+{
+  ASSERT(!(o  & 0xf000f00f));
+  /* use same bit pattern, to set opc1... */
+  if (r1 & 1) o |= ARM_V_I32;
+  r1 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12));
+}
+
+static void
+vorrd(jit_state_t *_jit, int o, int r0, int r1, int r2)
+{
+  ASSERT(!(o  & 0xf00ff00f));
+  ASSERT(!(r2 & 1));
+  r2 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12)|_u4(r2));
+}
+
+static void
+vosss(jit_state_t *_jit, int o, int r0, int r1, int r2)
+{
+  ASSERT(!(o  & 0xf00ff00f));
+  if (r0 & 1) o |= ARM_V_D;
+  if (r1 & 1) o |= ARM_V_N;
+  if (r2 & 1) o |= ARM_V_M;
+  r0 >>= 1; r1 >>= 1; r2 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12)|_u4(r2));
+}
+
+static void
+voddd(jit_state_t *_jit, int o, int r0, int r1, int r2)
+{
+  ASSERT(!(o  & 0xf00ff00f));
+  ASSERT(!(r0 & 1) && !(r1 & 1) && !(r2 & 1));
+  r0 >>= 1; r1 >>= 1; r2 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12)|_u4(r2));
+}
+
+static void
+vldst(jit_state_t *_jit, int o, int r0, int r1, int i0)
+{
+  /* i0 << 2 is byte offset */
+  ASSERT(!(o  & 0xf00ff0ff));
+  if (r0 & 1) {
+    ASSERT(!(o & ARM_V_F64));
+    o |= ARM_V_D;
+  }
+  r0 >>= 1;
+  emit_wide_thumb(_jit, ARM_CC_AL|o|(_u4(r1)<<16)|(_u4(r0)<<12)|_u8(i0));
+}
+
+static void
+VADD_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  vosss(_jit,ARM_VADD_F,r0,r1,r2);
+}
+
+static void
+VADD_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  voddd(_jit,ARM_VADD_F|ARM_V_F64,r0,r1,r2);
+}
+
+static void
+VSUB_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  vosss(_jit,ARM_VSUB_F,r0,r1,r2);
+}
+
+static void
+VSUB_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  voddd(_jit,ARM_VSUB_F|ARM_V_F64,r0,r1,r2);
+}
+
+static void
+VMUL_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  vosss(_jit,ARM_VMUL_F,r0,r1,r2);
+}
+
+static void
+VMUL_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  voddd(_jit,ARM_VMUL_F|ARM_V_F64,r0,r1,r2);
+}
+
+static void
+VDIV_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  vosss(_jit,ARM_VDIV_F,r0,r1,r2);
+}
+
+static void
+VDIV_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  voddd(_jit,ARM_VDIV_F|ARM_V_F64,r0,r1,r2);
+}
+
+static void
+VABS_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VABS_F,r0,r1);
+}
+
+static void
+VABS_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_dd(_jit,ARM_VABS_F|ARM_V_F64,r0,r1);
+}
+
+static void
+VNEG_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VNEG_F,r0,r1);
+}
+
+static void
+VNEG_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_dd(_jit,ARM_VNEG_F|ARM_V_F64,r0,r1);
+}
+
+static void
+VSQRT_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VSQRT_F,r0,r1);
+}
+
+static void
+VSQRT_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_dd(_jit,ARM_VSQRT_F|ARM_V_F64,r0,r1);
+}
+
+static void
+VMOV_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VMOV_F,r0,r1);
+}
+
+static void
+VMOV_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_dd(_jit,ARM_VMOV_F|ARM_V_F64,r0,r1);
+}
+
+static void
+VMOV_D_AA(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  vorrd(_jit,ARM_VMOV_D_AA,r1,r2,r0);
+}
+
+static void
+VMOV_S_A(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vors_(_jit,ARM_VMOV_S_A,r1,r0);
+}
+
+static void
+VCMP_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCMP,r0,r1);
+}
+
+static void
+VCMP_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_dd(_jit,ARM_VCMP|ARM_V_F64,r0,r1);
+}
+
+static void
+VMRS(jit_state_t *_jit)
+{
+  emit_wide_thumb(_jit, ARM_CC_AL|ARM_VMRS|(0xf<<12));
+}
+
+static void
+VCVT_S32_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_S32_F32,r0,r1);
+}
+
+static void
+VCVT_S32_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_S32_F64,r0,r1);
+}
+
+static void
+VCVT_F32_S32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_F32_S32,r0,r1);
+}
+
+static void
+VCVT_F64_S32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_F64_S32,r0,r1);
+}
+
+static void
+VCVT_F32_F64(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_F32_F64,r0,r1);
+}
+
+static void
+VCVT_F64_F32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vo_ss(_jit,ARM_VCVT_F64_F32,r0,r1);
+}
+
+static void
+VMOV_A_S32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vori_(_jit,ARM_VMOV_A_D,r0,r1);
+}
+
+static void
+VMOV_V_I32(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  vori_(_jit,ARM_VMOV_D_A,r1,r0);
+}
+
+/* "oi" should be the result of encode_vfp_double */
+static void
+VIMM(jit_state_t *_jit, int32_t oi, int32_t r0)
+{
+  vodi(_jit, oi,r0);
+}
+
+/* index is multipled by four */
+static void
+VLDRN_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VLDR,r0,r1,i0);
+}
+
+static void
+VLDR_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VLDR|ARM_P,r0,r1,i0);
+}
+
+static void
+VLDRN_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VLDR|ARM_V_F64,r0,r1,i0);
+}
+
+static void
+VLDR_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VLDR|ARM_V_F64|ARM_P,r0,r1,i0);
+}
+
+static void
+VSTRN_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VSTR,r0,r1,i0);
+}
+
+static void
+VSTR_F32(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VSTR|ARM_P,r0,r1,i0);
+}
+
+static void
+VSTRN_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VSTR|ARM_V_F64,r0,r1,i0);
+}
+
+static void
+VSTR_F64(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  vldst(_jit,ARM_VSTR|ARM_V_F64|ARM_P,r0,r1,i0);
+}
+
+static void
+absr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VABS_F32(_jit, r0,r1);
+}
+
+static void
+absr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VABS_F64(_jit, r0,r1);
+}
+
+static void
+negr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VNEG_F32(_jit, r0,r1);
+}
+
+static void
+negr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VNEG_F64(_jit, r0,r1);
+}
+
+static void
+sqrtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VSQRT_F32(_jit, r0,r1);
+}
+
+static void
+sqrtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VSQRT_F64(_jit, r0,r1);
+}
+
+static void
+addr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VADD_F32(_jit, r0,r1,r2);
+}
+
+static void
+addr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VADD_F64(_jit, r0,r1,r2);
+}
+
+static void
+subr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VSUB_F32(_jit, r0,r1,r2);
+}
+
+static void
+subr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VSUB_F64(_jit, r0,r1,r2);
+}
+
+static void
+mulr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VMUL_F32(_jit, r0,r1,r2);
+}
+
+static void
+mulr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VMUL_F64(_jit, r0,r1,r2);
+}
+
+static void
+divr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VDIV_F32(_jit, r0,r1,r2);
+}
+
+static void
+divr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  VDIV_F64(_jit, r0,r1,r2);
+}
+
+static void
+cmp_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VCMP_F32(_jit, r0, r1);
+}
+
+static void
+cmp_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VCMP_F64(_jit, r0, r1);
+}
+
+static jit_reloc_t
+vbcmp_x(jit_state_t *_jit, int cc)
+{
+  VMRS(_jit);
+  return T2_CC_B(_jit, cc);
+}
+
+static jit_reloc_t
+vbcmp_f(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  cmp_f(_jit, r0, r1);
+  return vbcmp_x(_jit, cc);
+}
+
+static jit_reloc_t
+vbcmp_d(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  cmp_d(_jit, r0, r1);
+  return vbcmp_x(_jit, cc);
+}
+
+static jit_reloc_t
+vbncmp_x(jit_state_t *_jit, int cc)
+{
+  VMRS(_jit);
+  jit_reloc_t cont = T2_CC_B(_jit, cc);
+  jit_reloc_t ret = T2_B(_jit);
+  jit_patch_here(_jit, cont);
+  return ret;
+}
+
+static jit_reloc_t
+vbncmp_f(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  cmp_f(_jit, r0, r1);
+  return vbncmp_x(_jit, cc);
+}
+
+static jit_reloc_t
+vbncmp_d(jit_state_t *_jit, int cc, int32_t r0, int32_t r1)
+{
+  cmp_d(_jit, r0, r1);
+  return vbncmp_x(_jit, cc);
+}
+
+static jit_reloc_t
+bltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_MI, r0, r1);
+}
+
+static jit_reloc_t
+bltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_MI, r0, r1);
+}
+
+static jit_reloc_t
+bler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_LS, r0, r1);
+}
+
+static jit_reloc_t
+bler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_LS, r0, r1);
+}
+
+static jit_reloc_t
+beqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_EQ, r0, r1);
+}
+
+static jit_reloc_t
+beqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_EQ, r0, r1);
+}
+
+static jit_reloc_t
+bger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bner_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bner_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bunltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbncmp_f(_jit, ARM_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bunltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbncmp_d(_jit, ARM_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bunler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbncmp_f(_jit, ARM_CC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bunler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbncmp_d(_jit, ARM_CC_GT, r0, r1);
+}
+
+static jit_reloc_t
+bungtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_HI, r0, r1);
+}
+
+static jit_reloc_t
+bungtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_HI, r0, r1);
+}
+
+static jit_reloc_t
+bordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_VC, r0, r1);
+}
+
+static jit_reloc_t
+bordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_VC, r0, r1);
+}
+
+static jit_reloc_t
+bunordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_f(_jit, ARM_CC_VS, r0, r1);
+}
+
+static jit_reloc_t
+bunordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return vbcmp_d(_jit, ARM_CC_VS, r0, r1);
+}
+
+static jit_reloc_t
+buneqr_x(jit_state_t *_jit)
+{
+  VMRS(_jit);
+  jit_reloc_t a = T2_CC_B(_jit, ARM_CC_VS);
+  jit_reloc_t b = T2_CC_B(_jit, ARM_CC_NE);
+  jit_patch_here(_jit, a);
+  jit_reloc_t ret = T2_B(_jit);
+  jit_patch_here(_jit, b);
+  return ret;
+}
+
+static jit_reloc_t
+buneqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_f(_jit, r0, r1);
+  return buneqr_x(_jit);
+}
+
+static jit_reloc_t
+buneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_d(_jit, r0, r1);
+  return buneqr_x(_jit);
+}
+
+static jit_reloc_t
+bunger_x(jit_state_t *_jit)
+{
+  VMRS(_jit);
+  jit_reloc_t a = T2_CC_B(_jit, ARM_CC_MI);
+  jit_reloc_t ret = T2_CC_B(_jit, ARM_CC_HS);
+  jit_patch_here(_jit, a);
+  return ret;
+}
+
+static jit_reloc_t
+bunger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_f(_jit, r0, r1);
+  return bunger_x(_jit);
+}
+
+static jit_reloc_t
+bunger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_d(_jit, r0, r1);
+  return bunger_x(_jit);
+}
+
+static jit_reloc_t
+bltgtr_x(jit_state_t *_jit)
+{
+  VMRS(_jit);
+  jit_reloc_t a = T2_CC_B(_jit, ARM_CC_VS);
+  jit_reloc_t b = T2_CC_B(_jit, ARM_CC_EQ);
+  jit_reloc_t ret = T2_B(_jit);
+  jit_patch_here(_jit, a);
+  jit_patch_here(_jit, b);
+  return ret;
+}
+
+static jit_reloc_t
+bltgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_f(_jit, r0, r1);
+  return bltgtr_x(_jit);
+}
+
+static jit_reloc_t
+bltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  cmp_d(_jit, r0, r1);
+  return bltgtr_x(_jit);
+}
+
+static void
+ldr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VLDR_F32(_jit, r0,r1,0);
+}
+
+static void
+ldr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VLDR_F64(_jit, r0,r1,0);
+}
+
+static void
+str_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VSTR_F32(_jit, r1,r0,0);
+}
+
+static void
+str_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VSTR_F64(_jit, r1,r0,0);
+}
+
+static void
+movr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    VMOV_F32(_jit, r0, r1);
+}
+
+static void
+movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    VMOV_F64(_jit, r0, r1);
+}
+
+static int
+encode_vfp_double(int mov, int inv, unsigned lo, unsigned hi)
+{
+  int           code, mode, imm, mask;
+
+  if (hi != lo) {
+    if (mov && !inv) {
+      /* (I64)
+       *        aaaaaaaabbbbbbbbccccccccddddddddeeeeeeeeffffffffgggggggghhhhhhhh
+       */
+      for (mode = 0, mask = 0xff; mode < 4; mask <<= 8, mode++) {
+        imm = lo & mask;
+        if (imm != mask && imm != 0)
+          goto fail;
+        imm = hi & mask;
+        if (imm != mask && imm != 0)
+          goto fail;
+      }
+      mode = 0xe20;
+      imm = (((hi & 0x80000000) >> 24) | ((hi & 0x00800000) >> 17) |
+             ((hi & 0x00008000) >> 10) | ((hi & 0x00000080) >>  3) |
+             ((lo & 0x80000000) >> 28) | ((lo & 0x00800000) >> 21) |
+             ((lo & 0x00008000) >> 14) | ((lo & 0x00000080) >>  7));
+      goto success;
+    }
+    goto fail;
+  }
+  /*  (I32)
+   *  00000000 00000000 00000000 abcdefgh
+   *  00000000 00000000 abcdefgh 00000000
+   *  00000000 abcdefgh 00000000 00000000
+   *  abcdefgh 00000000 00000000 00000000 */
+  for (mode = 0, mask = 0xff; mode < 4; mask <<= 8, mode++) {
+    if ((lo & mask) == lo) {
+      imm = lo >> (mode << 3);
+      mode <<= 9;
+      goto success;
+    }
+  }
+  /*  (I16)
+   *  00000000 abcdefgh 00000000 abcdefgh
+   *  abcdefgh 00000000 abcdefgh 00000000 */
+  for (mode = 0, mask = 0xff; mode < 2; mask <<= 8, mode++) {
+    if ((lo & mask) && ((lo & (mask << 16)) >> 16) == (lo & mask)) {
+      imm = lo >> (mode << 3);
+      mode = 0x800 | (mode << 9);
+      goto success;
+    }
+  }
+  if (mov) {
+    /*  (I32)
+     *  00000000 00000000 abcdefgh 11111111
+     *  00000000 abcdefgh 11111111 11111111 */
+    for (mode = 0, mask = 0xff; mode < 2;
+         mask = (mask << 8) | 0xff, mode++) {
+      if ((lo & mask) == mask &&
+          !((lo & ~mask) >> 8) &&
+          (imm = lo >> (8 + (mode << 8)))) {
+        mode = 0xc00 | (mode << 8);
+        goto success;
+      }
+    }
+    if (!inv) {
+      /* (F32)
+       *  aBbbbbbc defgh000 00000000 00000000
+       *  from the ARM Architecture Reference Manual:
+       *  In this entry, B = NOT(b). The bit pattern represents the
+       *  floating-point number (-1)^s* 2^exp * mantissa, where
+       *  S = UInt(a),
+       *  exp = UInt(NOT(b):c:d)-3 and
+       *  mantissa = (16+UInt(e:f:g:h))/16. */
+      if ((lo & 0x7ffff) == 0 &&
+          (((lo & 0x7e000000) == 0x3e000000) ||
+           ((lo & 0x7e000000) == 0x40000000))) {
+        mode = 0xf00;
+        imm = ((lo >> 24) & 0x80) | ((lo >> 19) & 0x7f);
+        goto success;
+      }
+    }
+  }
+
+fail:
+  /* need another approach (load from memory, move from arm register, etc) */
+  return -1;
+
+success:
+  code = inv ? ARM_VMVNI : ARM_VMOVI;
+  switch ((mode & 0xf00) >> 8) {
+  case 0x0:     case 0x2:       case 0x4:       case 0x6:
+  case 0x8:     case 0xa:
+    if (inv)    mode |= 0x20;
+    if (!mov)   mode |= 0x100;
+    break;
+  case 0x1:     case 0x3:       case 0x5:       case 0x7:
+    /* should actually not reach here */
+    ASSERT(!inv);
+  case 0x9:     case 0xb:
+    ASSERT(!mov);
+    break;
+  case 0xc:     case 0xd:
+    /* should actually not reach here */
+    ASSERT(inv);
+  case 0xe:
+    ASSERT(mode & 0x20);
+    ASSERT(mov && !inv);
+    break;
+  default:
+    ASSERT(!(mode & 0x20));
+    break;
+  }
+  imm = ((imm & 0x80) << 17) | ((imm & 0x70) << 12) | (imm & 0x0f);
+  code |= mode | imm;
+    
+  if (code & 0x1000000)
+    code |= 0xff000000;
+  else
+    code |= 0xef000000;
+
+  return code;
+}
+
+static void
+movi_f(jit_state_t *_jit, int32_t r0, jit_float32_t i0)
+{
+  union { int32_t i; jit_float32_t f; } u = { .f = i0 };
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), u.i);
+  VMOV_S_A(_jit, r0, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+movi_d(jit_state_t *_jit, int32_t r0, jit_float64_t i0)
+{
+  union { int32_t i[2]; jit_float64_t d; } u = { .d = i0 };
+  int32_t code;
+  if ((code = encode_vfp_double(1, 0, u.i[0], u.i[1])) != -1 ||
+      (code = encode_vfp_double(1, 1, ~u.i[0], ~u.i[1])) != -1)
+    VIMM(_jit, code, r0);
+  else {
+    jit_gpr_t rg0 = get_temp_gpr(_jit);
+    jit_gpr_t rg1 = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(rg0), u.i[0]);
+    movi(_jit, jit_gpr_regno(rg1), u.i[1]);
+    VMOV_D_AA(_jit, r0, jit_gpr_regno(rg0), jit_gpr_regno(rg1));
+    unget_temp_gpr(_jit);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+extr_d_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VCVT_F64_F32(_jit, r0, r1);
+}
+
+static void
+extr_f_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VCVT_F32_F64(_jit, r0, r1);
+}
+
+static void
+extr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VMOV_V_I32(_jit, r0, r1);
+  VCVT_F32_S32(_jit, r0, r0);
+}
+
+static void
+extr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  VMOV_V_I32(_jit, r0, r1);
+  VCVT_F64_S32(_jit, r0, r0);
+}
+
+static void
+truncr_f_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_fpr_t reg = get_temp_fpr(_jit);
+  VCVT_S32_F32(_jit, jit_fpr_regno(reg), r1);
+  VMOV_A_S32(_jit, r0, jit_fpr_regno(reg));
+  unget_temp_fpr(_jit);
+}
+
+static void
+truncr_d_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_fpr_t reg = get_temp_fpr(_jit);
+  VCVT_S32_F64(_jit, jit_fpr_regno(reg), r1);
+  VMOV_A_S32(_jit, r0, jit_fpr_regno(reg));
+  unget_temp_fpr(_jit);
+}
+
+static void
+ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t gpr = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(gpr), i0);
+  VLDR_F32(_jit, r0, jit_gpr_regno(gpr), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  VLDR_F64(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  addr(_jit, jit_gpr_regno(reg), r1, r2);
+  VLDR_F32(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  addr(_jit, jit_gpr_regno(reg), r1, r2);
+  VLDR_F64(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 >= 0) {
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VLDR_F32(_jit, r0, r1, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      addi(_jit, jit_gpr_regno(reg), r1, i0);
+      VLDR_F32(_jit, r0, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+  else {
+    i0 = -i0;
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VLDRN_F32(_jit, r0, r1, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      subi(_jit, jit_gpr_regno(reg), r1, i0);
+      VLDR_F32(_jit, r0, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 >= 0) {
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VLDR_F64(_jit, r0, r1, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      addi(_jit, jit_gpr_regno(reg), r1, i0);
+      VLDR_F64(_jit, r0, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+  else {
+    i0 = -i0;
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VLDRN_F64(_jit, r0, r1, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      subi(_jit, jit_gpr_regno(reg), r1, i0);
+      VLDR_F64(_jit, r0, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  VSTR_F32(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  VSTR_F64(_jit, r0, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  addr(_jit, jit_gpr_regno(reg), r0, r1);
+  VSTR_F32(_jit, r2, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  addr(_jit, jit_gpr_regno(reg), r0, r1);
+  VSTR_F64(_jit, r2, jit_gpr_regno(reg), 0);
+  unget_temp_gpr(_jit);
+}
+
+static void
+stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (i0 >= 0) {
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VSTR_F32(_jit, r1, r0, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      addi(_jit, jit_gpr_regno(reg), r0, i0);
+      VSTR_F32(_jit, r1, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+  else {
+    i0 = -i0;
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VSTRN_F32(_jit, r1, r0, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      subi(_jit, jit_gpr_regno(reg), r0, i0);
+      VSTR_F32(_jit, r1, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (i0 >= 0) {
+    ASSERT(!(i0 & 3));
+    if (i0 < 0124)
+      VSTR_F64(_jit, r1, r0, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      addi(_jit, jit_gpr_regno(reg), r0, i0);
+      VSTR_F64(_jit, r1, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+  else {
+    i0 = -i0;
+    ASSERT(!(i0 & 3));
+    if (i0 < 1024)
+      VSTRN_F64(_jit, r1, r0, i0 >> 2);
+    else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      subi(_jit, jit_gpr_regno(reg), r0, i0);
+      VSTR_F64(_jit, r1, jit_gpr_regno(reg), 0);
+      unget_temp_gpr(_jit);
+    }
+  }
+}
+
+static void
+retr_d(jit_state_t *_jit, int32_t r)
+{
+  movr_d(_jit, jit_fpr_regno(_D0), r);
+  ret(_jit);
+}
+
+static void
+retr_f(jit_state_t *_jit, int32_t r)
+{
+  movr_f(_jit, jit_fpr_regno(_S0), r);
+  ret(_jit);
+}
+
+static void
+retval_f(jit_state_t *_jit, int32_t r0)
+{
+  movr_f(_jit, r0, jit_fpr_regno(_S0));
+}
+
+static void
+retval_d(jit_state_t *_jit, int32_t r0)
+{
+  movr_d(_jit, r0, jit_fpr_regno(_D0));
+}
diff --git a/libguile/lightening/lightening/arm.c b/libguile/lightening/lightening/arm.c
new file mode 100644
index 000000000..d587e7158
--- /dev/null
+++ b/libguile/lightening/lightening/arm.c
@@ -0,0 +1,139 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+/*
+ * Types
+ */
+typedef union _jit_thumb_t {
+  int32_t             i;
+  int16_t             s[2];
+} jit_thumb_t;
+
+/* libgcc */
+extern void __clear_cache(void *, void *);
+
+#include "arm-cpu.c"
+#include "arm-vfp.c"
+
+static const jit_gpr_t abi_gpr_args[] = {
+  _R0, _R1, _R2, _R3
+};
+static const int abi_gpr_arg_count = sizeof(abi_gpr_args) / sizeof(abi_gpr_args[0]);
+
+struct abi_arg_iterator
+{
+  const jit_operand_t *args;
+  size_t argc;
+
+  size_t arg_idx;
+  size_t gpr_idx;
+  uint32_t vfp_used_registers;
+  size_t stack_size;
+  size_t stack_padding;
+};
+
+static size_t page_size;
+
+jit_bool_t
+jit_get_cpu(void)
+{
+  page_size = sysconf(_SC_PAGE_SIZE);
+  // FIXME check version, thumb, hardware fp support
+  return 1;
+}
+
+jit_bool_t
+jit_init(jit_state_t *_jit)
+{
+  return 1;
+}
+
+static size_t
+jit_initial_frame_size (void)
+{
+  return 0;
+}
+
+static void
+reset_abi_arg_iterator(struct abi_arg_iterator *iter, size_t argc,
+                       const jit_operand_t *args)
+{
+  memset(iter, 0, sizeof *iter);
+  iter->argc = argc;
+  iter->args = args;
+}
+
+static void
+next_abi_arg(struct abi_arg_iterator *iter, jit_operand_t *arg)
+{
+  ASSERT(iter->arg_idx < iter->argc);
+  enum jit_operand_abi abi = iter->args[iter->arg_idx].abi;
+  iter->arg_idx++;
+  if (is_gpr_arg(abi) && iter->gpr_idx < abi_gpr_arg_count) {
+    *arg = jit_operand_gpr (abi, abi_gpr_args[iter->gpr_idx++]);
+    return;
+  }
+  if (is_fpr_arg(abi)) {
+    // The ARM VFP ABI passes floating-point arguments in d0-d7
+    // (s0-s15), and allows for "back-filling".  Say you have a
+    // function:
+    //
+    //  void f(float a, double b, float c);
+    //
+    // A gets allocated to s0, then b to d1 (which aliases s2+s3), then
+    // c to s1.
+    uint32_t width = abi == JIT_OPERAND_ABI_FLOAT ? 1 : 2;
+    uint32_t mask = (1 << width) - 1;
+    for (size_t i = 0; i < 16; i += width) {
+      if ((iter->vfp_used_registers & (mask << i)) == 0) {
+        iter->vfp_used_registers |= (mask << i);
+        *arg = jit_operand_fpr (abi, JIT_FPR(i));
+        return;
+      }
+    }
+  }
+  *arg = jit_operand_mem (abi, JIT_SP, iter->stack_size);
+  iter->stack_size += 4;
+}
+
+static void
+jit_flush(void *fptr, void *tptr)
+{
+  jit_word_t f = (jit_word_t)fptr & -page_size;
+  jit_word_t t = (((jit_word_t)tptr) + page_size - 1) & -page_size;
+  __clear_cache((void *)f, (void *)t);
+}
+
+static inline size_t
+jit_stack_alignment(void)
+{
+  return 8;
+}
+
+static void
+jit_try_shorten(jit_state_t *_jit, jit_reloc_t reloc, jit_pointer_t addr)
+{
+}
+
+static void*
+bless_function_pointer(void *ptr)
+{
+  // Set low bit to mark as thumb mode.
+  return (void*) (((uintptr_t)ptr) | 1);
+}
diff --git a/libguile/lightening/lightening/arm.h b/libguile/lightening/lightening/arm.h
new file mode 100644
index 000000000..b18411e1e
--- /dev/null
+++ b/libguile/lightening/lightening/arm.h
@@ -0,0 +1,134 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_arm_h
+#define _jit_arm_h
+
+
+#define JIT_NEEDS_LITERAL_POOL 1
+
+#define _R0     JIT_GPR(0)
+#define _R1     JIT_GPR(1)
+#define _R2     JIT_GPR(2)
+#define _R3     JIT_GPR(3)
+#define _R4     JIT_GPR(4)
+#define _R5     JIT_GPR(5)
+#define _R6     JIT_GPR(6)
+#define _R7     JIT_GPR(7)
+#define _R8     JIT_GPR(8)
+#define _R9     JIT_GPR(9)
+#define _R10    JIT_GPR(10)
+#define _R11    JIT_GPR(11)
+#define _R12    JIT_GPR(12)
+#define _R13    JIT_GPR(13)
+#define _R14    JIT_GPR(14)
+#define _R15    JIT_GPR(15)
+
+#define _D0     JIT_FPR(0)
+#define _D1     JIT_FPR(2)
+#define _D2     JIT_FPR(4)
+#define _D3     JIT_FPR(6)
+#define _D4     JIT_FPR(8)
+#define _D5     JIT_FPR(10)
+#define _D6     JIT_FPR(12)
+#define _D7     JIT_FPR(14)
+#define _D8     JIT_FPR(16)
+#define _D9     JIT_FPR(18)
+#define _D10    JIT_FPR(20)
+#define _D11    JIT_FPR(22)
+#define _D12    JIT_FPR(24)
+#define _D13    JIT_FPR(26)
+#define _D14    JIT_FPR(28)
+#define _D15    JIT_FPR(30)
+
+#define _S0     JIT_FPR(0)
+#define _S1     JIT_FPR(1)
+#define _S2     JIT_FPR(2)
+#define _S3     JIT_FPR(3)
+#define _S4     JIT_FPR(4)
+#define _S5     JIT_FPR(5)
+#define _S6     JIT_FPR(6)
+#define _S7     JIT_FPR(7)
+#define _S8     JIT_FPR(8)
+#define _S9     JIT_FPR(9)
+#define _S10     JIT_FPR(10)
+#define _S11     JIT_FPR(11)
+#define _S12     JIT_FPR(12)
+#define _S13     JIT_FPR(13)
+#define _S14     JIT_FPR(14)
+#define _S15     JIT_FPR(15)
+#define _S16     JIT_FPR(16)
+#define _S17     JIT_FPR(17)
+#define _S18     JIT_FPR(18)
+#define _S19     JIT_FPR(19)
+#define _S20    JIT_FPR(20)
+#define _S21    JIT_FPR(21)
+#define _S22    JIT_FPR(22)
+#define _S23    JIT_FPR(23)
+#define _S24    JIT_FPR(24)
+#define _S25    JIT_FPR(25)
+#define _S26    JIT_FPR(26)
+#define _S27    JIT_FPR(27)
+#define _S28    JIT_FPR(28)
+#define _S29    JIT_FPR(29)
+#define _S30    JIT_FPR(30)
+#define _S31    JIT_FPR(31)
+
+#define JIT_R0    _R0
+#define JIT_R1    _R1
+#define JIT_R2    _R2
+#define JIT_R3    _R3
+#define JIT_TMP0  _R12
+
+#define JIT_V0    _R4
+#define JIT_V1    _R5
+#define JIT_V2    _R6
+#define JIT_TMP1  _R7
+#define JIT_V3    _R8
+#define JIT_V4    _R9
+#define JIT_V5    _R10
+#define JIT_V6    _R11
+
+#define JIT_LR _R14
+#define JIT_SP _R13
+#define _LR _R14
+#define _PC _R15
+
+#define JIT_F0 _D0
+#define JIT_F1 _D1
+#define JIT_F2 _D2
+#define JIT_F3 _D3
+#define JIT_F4 _D4
+#define JIT_F5 _D5
+#define JIT_F6 _D6
+#define JIT_FTMP _D7
+
+#define JIT_VF0 _D8
+#define JIT_VF1 _D9
+#define JIT_VF2 _D10
+#define JIT_VF3 _D11
+#define JIT_VF4 _D12
+#define JIT_VF5 _D13
+#define JIT_VF6 _D14
+#define JIT_VF7 _D15
+
+#define JIT_PLATFORM_CALLEE_SAVE_GPRS _LR, JIT_TMP1
+
+
+#endif /* _jit_arm_h */
diff --git a/libguile/lightening/lightening/endian.h b/libguile/lightening/lightening/endian.h
new file mode 100644
index 000000000..3b34a1518
--- /dev/null
+++ b/libguile/lightening/lightening/endian.h
@@ -0,0 +1,95 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ *	Andy Wingo
+ */
+
+#ifndef _jit_endian_h
+#define _jit_endian_h
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+#include <stddef.h>
+
+#ifndef __WORDSIZE
+#  if defined(WORDSIZE)				/* ppc darwin */
+#    define __WORDSIZE		WORDSIZE
+#  elif defined(__SIZEOF_POINTER__)		/* ppc aix */
+#    define __WORDSIZE		(__SIZEOF_POINTER__ << 3)
+#  elif defined(_MIPS_SZPTR)			/* mips irix */
+#    if _MIPS_SZPTR == 32
+#      define __WORDSIZE	32
+#    else
+#      define __WORDSIZE	64
+#    endif
+#  else						/* From FreeBSD 9.1 stdint.h */
+#    if defined(UINTPTR_MAX) && defined(UINT64_MAX) && \
+	(UINTPTR_MAX == UINT64_MAX)
+#      define __WORDSIZE	64
+#    else
+#      define __WORDSIZE	32
+#    endif
+#  endif
+#endif
+#ifndef __LITTLE_ENDIAN
+#  if defined(LITTLE_ENDIAN)			/* ppc darwin */
+#    define __LITTLE_ENDIAN	LITTLE_ENDIAN
+#  elif defined(__ORDER_LITTLE_ENDIAN__)	/* ppc aix */
+#    define __LITTLE_ENDIAN	__ORDER_LITTLE_ENDIAN__
+#  else
+#    define __LITTLE_ENDIAN	1234
+#  endif
+#endif
+#ifndef __BIG_ENDIAN
+#  if defined(BIG_ENDIAN)			/* ppc darwin */
+#    define __BIG_ENDIAN	BIG_ENDIAN
+#  elif defined(__ORDER_BIG_ENDIAN__)		/* ppc aix */
+#    define __BIG_ENDIAN	__ORDER_BIG_ENDIAN__
+#  else
+#    define __BIG_ENDIAN	4321
+#  endif
+#endif
+#ifndef __BYTE_ORDER
+#  if defined(BYTE_ORDER)			/* ppc darwin */
+#    define __BYTE_ORDER	BYTE_ORDER
+#  elif defined(__BYTE_ORDER__)			/* ppc aix */
+#    define __BYTE_ORDER	__BYTE_ORDER__
+#  elif defined(__i386__)			/* 32 bit x86 solaris */
+#    define __BYTE_ORDER	__LITTLE_ENDIAN
+#  elif defined(__x86_64__)			/* 64 bit x86 solaris */
+#    define __BYTE_ORDER	__LITTLE_ENDIAN
+#  elif defined(__MIPSEB)			/* mips irix */
+#    define __BYTE_ORDER	__BIG_ENDIAN
+#  else
+#    error cannot figure __BYTE_ORDER
+#  endif
+#endif
+
+#if __WORDSIZE == 32
+#define CHOOSE_32_64(x, y) x
+#elif __WORDSIZE == 64
+#define CHOOSE_32_64(x, y) y
+#else
+#error unhandled __WORDSIZE
+#endif
+
+#define WHEN_64(x) CHOOSE_32_64(/**/, x)
+
+
+#endif /* _jit_endian_h */
diff --git a/libguile/lightening/lightening/lightening.c b/libguile/lightening/lightening/lightening.c
new file mode 100644
index 000000000..ca5708f0a
--- /dev/null
+++ b/libguile/lightening/lightening/lightening.c
@@ -0,0 +1,1394 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#if HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <assert.h>
+#include <fcntl.h>
+#include <limits.h>
+#include <stdio.h>
+#include <sys/mman.h>
+
+#include "../lightening.h"
+
+#define ASSERT(x) do { if (!(x)) abort(); } while (0)
+
+#if defined(__GNUC__)
+# define maybe_unused           __attribute__ ((unused))
+# define UNLIKELY(exprn) __builtin_expect(exprn, 0)
+#else
+# define maybe_unused           /**/
+# define UNLIKELY(exprn) exprn
+#endif
+
+union jit_pc
+{
+  uint8_t *uc;
+  uint16_t *us;
+  uint32_t *ui;
+  uint64_t *ul;
+  intptr_t w;
+  uintptr_t uw;
+};
+
+#ifdef JIT_NEEDS_LITERAL_POOL
+struct jit_literal_pool_entry
+{
+  jit_reloc_t reloc;
+  int64_t value;
+};
+
+struct jit_literal_pool
+{
+  uint32_t deadline;
+  uint32_t size;
+  uint32_t capacity;
+  struct jit_literal_pool_entry entries[];
+};
+#endif // JIT_NEEDS_LITERAL_POOL
+
+struct jit_state
+{
+  union jit_pc pc;
+  uint8_t *start;
+  uint8_t *last_instruction_start;
+  uint8_t *limit;
+  uint8_t temp_gpr_saved;
+  uint8_t temp_fpr_saved;
+  uint8_t overflow;
+  int frame_size; // Used to know when to align stack.
+#ifdef JIT_NEEDS_LITERAL_POOL
+  struct jit_literal_pool *pool;
+#endif
+  void* (*alloc)(size_t);
+  void (*free)(void*);
+};
+
+static jit_bool_t jit_get_cpu(void);
+static jit_bool_t jit_init(jit_state_t *);
+static void jit_flush(void *fptr, void *tptr);
+static void jit_try_shorten(jit_state_t *_jit, jit_reloc_t reloc,
+                            jit_pointer_t addr);
+static void* bless_function_pointer(void *ptr);
+
+struct abi_arg_iterator;
+
+#ifdef JIT_NEEDS_LITERAL_POOL
+static struct jit_literal_pool* alloc_literal_pool(jit_state_t *_jit,
+                                                   size_t capacity);
+static void reset_literal_pool(jit_state_t *_jit,
+                               struct jit_literal_pool *pool);
+static jit_bool_t add_pending_literal(jit_state_t *_jit, jit_reloc_t src,
+                                      uint8_t max_offset_bits);
+static void remove_pending_literal(jit_state_t *_jit, jit_reloc_t src);
+static void patch_pending_literal(jit_state_t *_jit, jit_reloc_t src,
+                                  uint64_t value);
+enum guard_pool { GUARD_NEEDED, NO_GUARD_NEEDED };
+static void emit_literal_pool(jit_state_t *_jit, enum guard_pool guard);
+
+static int32_t read_jmp_offset(uint32_t *loc);
+static int offset_in_jmp_range(ptrdiff_t offset);
+static void patch_jmp_offset(uint32_t *loc, ptrdiff_t offset);
+static int32_t read_jcc_offset(uint32_t *loc);
+static int offset_in_jcc_range(ptrdiff_t offset);
+static void patch_jcc_offset(uint32_t *loc, ptrdiff_t offset);
+static void patch_veneer(uint32_t *loc, jit_pointer_t addr);
+static int32_t read_load_from_pool_offset(uint32_t *loc);
+#endif
+
+static jit_bool_t is_fpr_arg(enum jit_operand_abi arg);
+static jit_bool_t is_gpr_arg(enum jit_operand_abi arg);
+static void reset_abi_arg_iterator(struct abi_arg_iterator *iter, size_t argc,
+                                   const jit_operand_t *args);
+static void next_abi_arg(struct abi_arg_iterator *iter,
+                         jit_operand_t *arg);
+
+jit_bool_t
+init_jit(void)
+{
+  return jit_get_cpu ();
+}
+
+jit_state_t *
+jit_new_state(void* (*alloc_fn)(size_t), void (*free_fn)(void*))
+{
+  if (!alloc_fn) alloc_fn = malloc;
+  if (!free_fn) free_fn = free;
+
+  jit_state_t *_jit = alloc_fn (sizeof (*_jit));
+  if (!_jit)
+    abort ();
+
+  memset(_jit, 0, sizeof (*_jit));
+  _jit->alloc = alloc_fn;
+  _jit->free = free_fn;
+
+  if (!jit_init (_jit)) {
+#ifdef JIT_NEEDS_LITERAL_POOL
+    free_fn (_jit->pool);
+#endif
+    free_fn (_jit);
+    return NULL;
+  }
+
+#ifdef JIT_NEEDS_LITERAL_POOL
+  _jit->pool = alloc_literal_pool(_jit, 0);
+#endif
+
+  return _jit;
+}
+
+void
+jit_destroy_state(jit_state_t *_jit)
+{
+#ifdef JIT_NEEDS_LITERAL_POOL
+  _jit->free (_jit->pool);
+#endif
+  _jit->free (_jit);
+}
+
+jit_pointer_t
+jit_address(jit_state_t *_jit)
+{
+  ASSERT (_jit->start);
+  return _jit->pc.uc;
+}
+
+void
+jit_begin(jit_state_t *_jit, uint8_t* buf, size_t length)
+{
+  ASSERT (!_jit->start);
+
+  _jit->pc.uc = _jit->start = buf;
+  _jit->limit = buf + length;
+  _jit->overflow = 0;
+  _jit->frame_size = 0;
+#if JIT_NEEDS_LITERAL_POOL
+  ASSERT(_jit->pool->size == 0);
+  _jit->pool->deadline = length;
+#endif
+}
+
+jit_bool_t
+jit_has_overflow(jit_state_t *_jit)
+{
+  ASSERT (_jit->start);
+  return _jit->overflow;
+}
+
+void
+jit_reset(jit_state_t *_jit)
+{
+  ASSERT (_jit->start);
+  _jit->pc.uc = _jit->start = _jit->limit = NULL;
+  _jit->overflow = 0;
+  _jit->frame_size = 0;
+#ifdef JIT_NEEDS_LITERAL_POOL
+  reset_literal_pool(_jit, _jit->pool);
+#endif
+}
+
+jit_function_pointer_t
+jit_address_to_function_pointer(jit_pointer_t p)
+{
+  return bless_function_pointer(p);
+}
+
+void*
+jit_end(jit_state_t *_jit, size_t *length)
+{
+#ifdef JIT_NEEDS_LITERAL_POOL
+  if (_jit->pool->size)
+    emit_literal_pool(_jit, NO_GUARD_NEEDED);
+#endif
+
+  if (_jit->overflow)
+    return NULL;
+
+  uint8_t *start = _jit->start;
+  uint8_t *end = _jit->pc.uc;
+
+  ASSERT (start);
+  ASSERT (start <= end);
+  ASSERT (end <= _jit->limit);
+
+  jit_flush (start, end);
+
+  if (length) {
+    *length = end - start;
+  }
+
+  _jit->pc.uc = _jit->start = _jit->limit = NULL;
+  _jit->overflow = 0;
+  _jit->frame_size = 0;
+#ifdef JIT_NEEDS_LITERAL_POOL
+  reset_literal_pool(_jit, _jit->pool);
+#endif
+
+  return jit_address_to_function_pointer(start);
+}
+
+static int
+is_power_of_two (unsigned x)
+{
+  return x && !(x & (x-1));
+}
+
+static jit_gpr_t
+get_temp_gpr(jit_state_t *_jit)
+{
+  switch(_jit->temp_gpr_saved++)
+    {
+    case 0:
+      return JIT_TMP0;
+#ifdef JIT_TMP1
+    case 1:
+      return JIT_TMP1;
+#endif
+    default:
+      abort();
+    }
+}
+
+static jit_fpr_t
+get_temp_fpr(jit_state_t *_jit)
+{
+  switch(_jit->temp_fpr_saved++)
+    {
+    case 0:
+      return JIT_FTMP;
+    default:
+      abort();
+    }
+}
+
+static void
+unget_temp_fpr(jit_state_t *_jit)
+{
+  ASSERT(_jit->temp_fpr_saved);
+  _jit->temp_fpr_saved--;
+}
+
+static void
+unget_temp_gpr(jit_state_t *_jit)
+{
+  ASSERT(_jit->temp_gpr_saved);
+  _jit->temp_gpr_saved--;
+}
+
+static inline void emit_u8(jit_state_t *_jit, uint8_t u8) {
+  if (UNLIKELY(_jit->pc.uc + 1 > _jit->limit)) {
+    _jit->overflow = 1;
+  } else {
+    *_jit->pc.uc++ = u8;
+  }
+}
+
+static inline void emit_u16(jit_state_t *_jit, uint16_t u16) {
+  if (UNLIKELY(_jit->pc.us + 1 > (uint16_t*)_jit->limit)) {
+    _jit->overflow = 1;
+  } else {
+    *_jit->pc.us++ = u16;
+  }
+}
+
+static inline void emit_u32(jit_state_t *_jit, uint32_t u32) {
+  if (UNLIKELY(_jit->pc.ui + 1 > (uint32_t*)_jit->limit)) {
+    _jit->overflow = 1;
+  } else {
+    *_jit->pc.ui++ = u32;
+  }
+}
+
+#ifdef JIT_NEEDS_LITERAL_POOL
+static inline void emit_u16_with_pool(jit_state_t *_jit, uint16_t u16) {
+  emit_u16(_jit, u16);
+  if (UNLIKELY(_jit->pc.uc >= _jit->start + _jit->pool->deadline))
+    emit_literal_pool(_jit, GUARD_NEEDED);
+}
+
+static inline void emit_u32_with_pool(jit_state_t *_jit, uint32_t u32) {
+  emit_u32(_jit, u32);
+  if (UNLIKELY(_jit->pc.uc >= _jit->start + _jit->pool->deadline))
+    emit_literal_pool(_jit, GUARD_NEEDED);
+}
+#endif
+
+static inline void emit_u64(jit_state_t *_jit, uint64_t u64) {
+  if (UNLIKELY(_jit->pc.ul + 1 > (uint64_t*)_jit->limit)) {
+    _jit->overflow = 1;
+  } else {
+    *_jit->pc.ul++ = u64;
+  }
+}
+
+static inline jit_reloc_t
+jit_reloc (jit_state_t *_jit, enum jit_reloc_kind kind,
+           uint8_t inst_start_offset, uint8_t *loc, uint8_t *pc_base,
+           uint8_t rsh)
+{
+  jit_reloc_t ret;
+
+  ASSERT(rsh < __WORDSIZE);
+  ASSERT(pc_base >= (loc - inst_start_offset));
+  ASSERT(pc_base - (loc - inst_start_offset) < 256);
+
+  ret.kind = kind;
+  ret.inst_start_offset = inst_start_offset;
+  ret.pc_base_offset = pc_base - (loc - inst_start_offset);
+  ret.rsh = rsh;
+  ret.offset = loc - _jit->start;
+  
+  return ret;
+}
+
+void
+jit_patch_here(jit_state_t *_jit, jit_reloc_t reloc)
+{
+  jit_patch_there (_jit, reloc, jit_address (_jit));
+}
+
+void
+jit_patch_there(jit_state_t* _jit, jit_reloc_t reloc, jit_pointer_t addr)
+{
+  if (_jit->overflow)
+    return;
+  union jit_pc loc;
+  uint8_t *end;
+  loc.uc = _jit->start + reloc.offset;
+  uint8_t *pc_base = loc.uc - reloc.inst_start_offset + reloc.pc_base_offset;
+  ptrdiff_t diff = (uint8_t*)addr - pc_base;
+  ASSERT((diff & ((1 << reloc.rsh) - 1)) == 0);
+  diff >>= reloc.rsh;
+
+  switch (reloc.kind)
+    {
+    case JIT_RELOC_ABSOLUTE:
+      if (sizeof(diff) == 4)
+        *loc.ui = (uintptr_t)addr;
+      else
+        *loc.ul = (uintptr_t)addr;
+      end = loc.uc + sizeof(diff);
+      break;
+    case JIT_RELOC_REL8:
+      ASSERT (INT8_MIN <= diff && diff <= INT8_MAX);
+      *loc.uc = diff;
+      end = loc.uc + 1;
+      break;
+    case JIT_RELOC_REL16:
+      ASSERT (INT16_MIN <= diff && diff <= INT16_MAX);
+      *loc.us = diff;
+      end = loc.uc + 2;
+      break;
+#ifdef JIT_NEEDS_LITERAL_POOL
+    case JIT_RELOC_JMP_WITH_VENEER: {
+      int32_t voff = read_jmp_offset(loc.ui);
+      uint8_t *target = pc_base + (voff << reloc.rsh);
+      if (target == loc.uc) {
+        // PC still in range to reify direct branch.
+        if (offset_in_jmp_range(diff)) {
+          // Target also in range: reify direct branch.
+          patch_jmp_offset(loc.ui, diff);
+          remove_pending_literal(_jit, reloc);
+        } else {
+          // Target out of range; branch to veneer.
+          patch_pending_literal(_jit, reloc, (uintptr_t) addr);
+        }
+      } else {
+        // Already emitted a veneer.  In this case, patch the veneer
+        // directly.
+        patch_veneer((uint32_t *) target, addr);
+      }
+      return;
+    }
+    case JIT_RELOC_JCC_WITH_VENEER: {
+      int32_t voff = read_jcc_offset(loc.ui);
+      uint8_t *target = pc_base + (voff << reloc.rsh);
+      if (target == loc.uc) {
+        if (offset_in_jcc_range(diff)) {
+          patch_jcc_offset(loc.ui, diff);
+          remove_pending_literal(_jit, reloc);
+        } else {
+          patch_pending_literal(_jit, reloc, (uintptr_t) addr);
+        }
+      } else {
+        patch_veneer((uint32_t *) target, addr);
+      }
+      return;
+    }
+    case JIT_RELOC_LOAD_FROM_POOL: {
+      int32_t voff = read_load_from_pool_offset(loc.ui);
+      uint8_t *target = pc_base + (voff << reloc.rsh);
+      if (target == loc.uc) {
+        patch_pending_literal(_jit, reloc, (uintptr_t) addr);
+      } else {
+        *(uintptr_t *) target = (uintptr_t) addr;
+      }
+      return;
+    }
+#endif
+    case JIT_RELOC_REL32:
+      ASSERT (INT32_MIN <= diff && diff <= INT32_MAX);
+      *loc.ui = diff;
+      end = loc.uc + 4;
+      break;
+    case JIT_RELOC_REL64:
+      *loc.ul = diff;
+      end = loc.uc + 8;
+      break;
+    default:
+      abort ();
+    }
+
+  if (end == _jit->pc.uc)
+    jit_try_shorten (_jit, reloc, addr);
+}
+
+#if defined(__i386__) || defined(__x86_64__)
+# include "x86.c"
+#elif defined(__mips__)
+# include "mips.c"
+#elif defined(__arm__)
+# include "arm.c"
+#elif defined(__ppc__) || defined(__powerpc__)
+# include "ppc.c"
+#elif defined(__aarch64__)
+# include "aarch64.c"
+#elif defined(__s390__) || defined(__s390x__)
+# include "s390.c"
+#endif
+
+#define JIT_IMPL_0(stem, ret) \
+  ret jit_##stem (jit_state_t* _jit) \
+  {                                  \
+    return stem(_jit);            \
+  }
+#define JIT_IMPL_1(stem, ret, ta)                 \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a) \
+  {                                               \
+    return stem(_jit, unwrap_##ta(a));         \
+  }
+#define JIT_IMPL_2(stem, ret, ta, tb)                             \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b) \
+  {                                                               \
+    return stem(_jit, unwrap_##ta(a), unwrap_##tb(b));         \
+  }
+#define JIT_IMPL_3(stem, ret, ta, tb, tc)                               \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b, jit_##tc##_t c) \
+  {                                                                     \
+    return stem(_jit, unwrap_##ta(a), unwrap_##tb(b), unwrap_##tc(c)); \
+  }
+#define JIT_IMPL_4(stem, ret, ta, tb, tc, td)                           \
+  ret jit_##stem (jit_state_t* _jit, jit_##ta##_t a, jit_##tb##_t b, jit_##tc##_t c, jit_##td##_t d) \
+  {                                                                     \
+    return stem(_jit, unwrap_##ta(a), unwrap_##tb(b), unwrap_##tc(c), unwrap_##td(d)); \
+  }
+
+#define JIT_IMPL_RFF__(stem) JIT_IMPL_2(stem, jit_reloc_t, fpr, fpr)
+#define JIT_IMPL_RGG__(stem) JIT_IMPL_2(stem, jit_reloc_t, gpr, gpr)
+#define JIT_IMPL_RG___(stem) JIT_IMPL_1(stem, jit_reloc_t, gpr)
+#define JIT_IMPL_RGi__(stem) JIT_IMPL_2(stem, jit_reloc_t, gpr, imm)
+#define JIT_IMPL_RGu__(stem) JIT_IMPL_2(stem, jit_reloc_t, gpr, uimm)
+#define JIT_IMPL_R____(stem) JIT_IMPL_0(stem, jit_reloc_t)
+#define JIT_IMPL__FFF_(stem) JIT_IMPL_3(stem, void, fpr, fpr, fpr)
+#define JIT_IMPL__FF__(stem) JIT_IMPL_2(stem, void, fpr, fpr)
+#define JIT_IMPL__FGG_(stem) JIT_IMPL_3(stem, void, fpr, gpr, gpr)
+#define JIT_IMPL__FG__(stem) JIT_IMPL_2(stem, void, fpr, gpr)
+#define JIT_IMPL__FGo_(stem) JIT_IMPL_3(stem, void, fpr, gpr, off)
+#define JIT_IMPL__F___(stem) JIT_IMPL_1(stem, void, fpr)
+#define JIT_IMPL__Fd__(stem) JIT_IMPL_2(stem, void, fpr, float64)
+#define JIT_IMPL__Ff__(stem) JIT_IMPL_2(stem, void, fpr, float32)
+#define JIT_IMPL__Fp__(stem) JIT_IMPL_2(stem, void, fpr, pointer)
+#define JIT_IMPL__GF__(stem) JIT_IMPL_2(stem, void, gpr, fpr)
+#define JIT_IMPL__GGF_(stem) JIT_IMPL_3(stem, void, gpr, gpr, fpr)
+#define JIT_IMPL__GGGG(stem) JIT_IMPL_4(stem, void, gpr, gpr, gpr, gpr)
+#define JIT_IMPL__GGG_(stem) JIT_IMPL_3(stem, void, gpr, gpr, gpr)
+#define JIT_IMPL__GGGi(stem) JIT_IMPL_4(stem, void, gpr, gpr, gpr, imm)
+#define JIT_IMPL__GGGu(stem) JIT_IMPL_4(stem, void, gpr, gpr, gpr, uimm)
+#define JIT_IMPL__GG__(stem) JIT_IMPL_2(stem, void, gpr, gpr)
+#define JIT_IMPL__GGi_(stem) JIT_IMPL_3(stem, void, gpr, gpr, imm)
+#define JIT_IMPL__GGo_(stem) JIT_IMPL_3(stem, void, gpr, gpr, off)
+#define JIT_IMPL__GGu_(stem) JIT_IMPL_3(stem, void, gpr, gpr, uimm)
+#define JIT_IMPL__G___(stem) JIT_IMPL_1(stem, void, gpr)
+#define JIT_IMPL__Gi__(stem) JIT_IMPL_2(stem, void, gpr, imm)
+#define JIT_IMPL__Gp__(stem) JIT_IMPL_2(stem, void, gpr, pointer)
+#define JIT_IMPL______(stem) JIT_IMPL_0(stem, void)
+#define JIT_IMPL__i___(stem) JIT_IMPL_1(stem, void, imm)
+#define JIT_IMPL__oGF_(stem) JIT_IMPL_3(stem, void, off, gpr, fpr)
+#define JIT_IMPL__oGG_(stem) JIT_IMPL_3(stem, void, off, gpr, gpr)
+#define JIT_IMPL__pF__(stem) JIT_IMPL_2(stem, void, pointer, fpr)
+#define JIT_IMPL__pG__(stem) JIT_IMPL_2(stem, void, pointer, gpr)
+#define JIT_IMPL__p___(stem) JIT_IMPL_1(stem, void, pointer)
+
+#define unwrap_gpr(r) jit_gpr_regno(r)
+#define unwrap_fpr(r) jit_fpr_regno(r)
+#define unwrap_imm(i) i
+#define unwrap_uimm(u) u
+#define unwrap_off(o) o
+#define unwrap_pointer(p) ((uintptr_t) p)
+#define unwrap_float32(f) f
+#define unwrap_float64(d) d
+
+#define IMPL_INSTRUCTION(kind, stem) JIT_IMPL_##kind(stem)
+FOR_EACH_INSTRUCTION(IMPL_INSTRUCTION)
+#undef IMPL_INSTRUCTION
+
+void
+jit_align(jit_state_t *_jit, unsigned align)
+{
+  ASSERT (is_power_of_two (align));
+  uintptr_t here = _jit->pc.w;
+  uintptr_t there = (here + align - 1) & ~(align - 1);
+  if (there - here)
+    nop(_jit, there - here);
+}
+
+static jit_bool_t
+is_fpr_arg(enum jit_operand_abi arg)
+{
+  switch (arg)
+    {
+    case JIT_OPERAND_ABI_UINT8:
+    case JIT_OPERAND_ABI_INT8:
+    case JIT_OPERAND_ABI_UINT16:
+    case JIT_OPERAND_ABI_INT16:
+    case JIT_OPERAND_ABI_UINT32:
+    case JIT_OPERAND_ABI_INT32:
+    case JIT_OPERAND_ABI_UINT64:
+    case JIT_OPERAND_ABI_INT64:
+    case JIT_OPERAND_ABI_POINTER:
+      return 0;
+    case JIT_OPERAND_ABI_FLOAT:
+    case JIT_OPERAND_ABI_DOUBLE:
+      return 1;
+    default:
+      abort();
+    }
+}
+
+static jit_bool_t
+is_gpr_arg(enum jit_operand_abi arg)
+{
+  return !is_fpr_arg(arg);
+}
+
+static void
+abi_imm_to_gpr(jit_state_t *_jit, enum jit_operand_abi abi, jit_gpr_t dst,
+               intptr_t imm)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_UINT8:
+    ASSERT(0 <= imm);
+    ASSERT(imm <= UINT8_MAX);
+    break;
+  case JIT_OPERAND_ABI_INT8:
+    ASSERT(INT8_MIN <= imm);
+    ASSERT(imm <= INT8_MAX);
+    break;
+  case JIT_OPERAND_ABI_UINT16:
+    ASSERT(0 <= imm);
+    ASSERT(imm <= UINT16_MAX);
+    break;
+  case JIT_OPERAND_ABI_INT16:
+    ASSERT(INT16_MIN <= imm);
+    ASSERT(imm <= INT16_MAX);
+    break;
+  case JIT_OPERAND_ABI_UINT32:
+    ASSERT(0 <= imm);
+    ASSERT(imm <= UINT32_MAX);
+    break;
+  case JIT_OPERAND_ABI_INT32:
+    ASSERT(INT32_MIN <= imm);
+    ASSERT(imm <= INT32_MAX);
+    break;
+#if __WORDSIZE > 32
+  case JIT_OPERAND_ABI_UINT64:
+  case JIT_OPERAND_ABI_INT64:
+    break;
+#endif
+  case JIT_OPERAND_ABI_POINTER:
+    break;
+  default:
+    abort();
+  }
+  jit_movi (_jit, dst, imm);
+}
+
+static void
+abi_gpr_to_mem(jit_state_t *_jit, enum jit_operand_abi abi,
+               jit_gpr_t base, ptrdiff_t offset, jit_gpr_t src)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_UINT8:
+  case JIT_OPERAND_ABI_INT8:
+    jit_stxi_c(_jit, offset, base, src);
+    break;
+  case JIT_OPERAND_ABI_UINT16:
+  case JIT_OPERAND_ABI_INT16:
+    jit_stxi_s(_jit, offset, base, src);
+    break;
+  case JIT_OPERAND_ABI_UINT32:
+  case JIT_OPERAND_ABI_INT32:
+#if __WORDSIZE == 32
+  case JIT_OPERAND_ABI_POINTER:
+#endif
+    jit_stxi_i(_jit, offset, base, src);
+    break;
+#if __WORDSIZE == 64
+  case JIT_OPERAND_ABI_UINT64:
+  case JIT_OPERAND_ABI_INT64:
+  case JIT_OPERAND_ABI_POINTER:
+    jit_stxi_l(_jit, offset, base, src);
+    break;
+#endif
+  default:
+    abort();
+  }
+}
+
+static void
+abi_fpr_to_mem(jit_state_t *_jit, enum jit_operand_abi abi,
+               jit_gpr_t base, ptrdiff_t offset, jit_fpr_t src)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_FLOAT:
+    jit_stxi_f(_jit, offset, base, src);
+    break;
+  case JIT_OPERAND_ABI_DOUBLE:
+    jit_stxi_d(_jit, offset, base, src);
+    break;
+  default:
+    abort();
+  }
+}
+
+static void
+abi_mem_to_gpr(jit_state_t *_jit, enum jit_operand_abi abi,
+               jit_gpr_t dst, jit_gpr_t base, ptrdiff_t offset)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_UINT8:
+    jit_ldxi_uc(_jit, dst, base, offset);
+    break;
+  case JIT_OPERAND_ABI_INT8:
+    jit_ldxi_c(_jit, dst, base, offset);
+    break;
+  case JIT_OPERAND_ABI_UINT16:
+    jit_ldxi_us(_jit, dst, base, offset);
+    break;
+  case JIT_OPERAND_ABI_INT16:
+    jit_ldxi_s(_jit, dst, base, offset);
+    break;
+#if __WORDSIZE == 32
+  case JIT_OPERAND_ABI_UINT32:
+  case JIT_OPERAND_ABI_POINTER:
+#endif
+  case JIT_OPERAND_ABI_INT32:
+    jit_ldxi_i(_jit, dst, base, offset);
+    break;
+#if __WORDSIZE == 64
+  case JIT_OPERAND_ABI_UINT32:
+    jit_ldxi_ui(_jit, dst, base, offset);
+    break;
+  case JIT_OPERAND_ABI_UINT64:
+  case JIT_OPERAND_ABI_POINTER:
+  case JIT_OPERAND_ABI_INT64:
+    jit_ldxi_l(_jit, dst, base, offset);
+    break;
+#endif
+  default:
+    abort();
+  }
+}
+
+static void
+abi_mem_to_fpr(jit_state_t *_jit, enum jit_operand_abi abi,
+               jit_fpr_t dst, jit_gpr_t base, ptrdiff_t offset)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_FLOAT:
+    jit_ldxi_f(_jit, dst, base, offset);
+    break;
+  case JIT_OPERAND_ABI_DOUBLE:
+    jit_ldxi_d(_jit, dst, base, offset);
+    break;
+  default:
+    abort();
+  }
+}
+
+static void
+abi_imm_to_mem(jit_state_t *_jit, enum jit_operand_abi abi, jit_gpr_t base,
+               ptrdiff_t offset, jit_imm_t imm)
+{
+  ASSERT(!is_fpr_arg(abi));
+
+  jit_gpr_t tmp = get_temp_gpr(_jit);
+  abi_imm_to_gpr(_jit, abi, tmp, imm);
+  abi_gpr_to_mem(_jit, abi, base, offset, tmp);
+  unget_temp_gpr(_jit);
+}
+
+static void
+abi_mem_to_mem(jit_state_t *_jit, enum jit_operand_abi abi, jit_gpr_t base,
+               ptrdiff_t offset, jit_gpr_t src_base, ptrdiff_t src_offset)
+{
+  if (is_gpr_arg (abi)) {
+    jit_gpr_t tmp = get_temp_gpr(_jit);
+    abi_mem_to_gpr(_jit, abi, tmp, src_base, src_offset);
+    abi_gpr_to_mem(_jit, abi, base, offset, tmp);
+    unget_temp_gpr(_jit);
+  } else {
+    jit_fpr_t tmp = get_temp_fpr(_jit);
+    abi_mem_to_fpr(_jit, abi, tmp, src_base, src_offset);
+    abi_fpr_to_mem(_jit, abi, base, offset, tmp);
+    unget_temp_fpr(_jit);
+  }
+}
+
+#define MOVE_KIND(a, b) ((((int) a) << 4) | ((int) b))
+
+#define MOVE_KIND_ENUM(a, b) \
+  MOVE_##a##_TO_##b = MOVE_KIND(JIT_OPERAND_KIND_##a, JIT_OPERAND_KIND_##b)
+enum move_kind {
+  MOVE_KIND_ENUM(IMM, GPR),
+  MOVE_KIND_ENUM(GPR, GPR),
+  MOVE_KIND_ENUM(MEM, GPR),
+  MOVE_KIND_ENUM(FPR, FPR),
+  MOVE_KIND_ENUM(MEM, FPR),
+  MOVE_KIND_ENUM(IMM, MEM),
+  MOVE_KIND_ENUM(GPR, MEM),
+  MOVE_KIND_ENUM(FPR, MEM),
+  MOVE_KIND_ENUM(MEM, MEM)
+};
+#undef MOVE_KIND_ENUM
+
+static void
+move_operand(jit_state_t *_jit, jit_operand_t dst, jit_operand_t src)
+{
+  switch (MOVE_KIND (src.kind, dst.kind)) {
+  case MOVE_IMM_TO_GPR:
+    return abi_imm_to_gpr(_jit, src.abi, dst.loc.gpr.gpr, src.loc.imm);
+
+  case MOVE_GPR_TO_GPR:
+    return jit_movr(_jit, dst.loc.gpr.gpr, src.loc.gpr.gpr);
+
+  case MOVE_MEM_TO_GPR:
+    return abi_mem_to_gpr(_jit, src.abi, dst.loc.gpr.gpr, src.loc.mem.base,
+                          src.loc.mem.offset);
+
+  case MOVE_FPR_TO_FPR:
+    ASSERT(src.abi == dst.abi);
+    if (src.abi == JIT_OPERAND_ABI_DOUBLE)
+      return jit_movr_d(_jit, dst.loc.fpr, src.loc.fpr);
+    else
+      return jit_movr_f(_jit, dst.loc.fpr, src.loc.fpr);
+
+  case MOVE_MEM_TO_FPR:
+    return abi_mem_to_fpr(_jit, src.abi, dst.loc.fpr, src.loc.mem.base,
+                          src.loc.mem.offset);
+
+  case MOVE_IMM_TO_MEM:
+    return abi_imm_to_mem(_jit, src.abi, dst.loc.mem.base, dst.loc.mem.offset,
+                          src.loc.imm);
+
+  case MOVE_GPR_TO_MEM:
+    return abi_gpr_to_mem(_jit, src.abi, dst.loc.mem.base, dst.loc.mem.offset,
+                          src.loc.gpr.gpr);
+
+  case MOVE_FPR_TO_MEM:
+    return abi_fpr_to_mem(_jit, src.abi, dst.loc.mem.base, dst.loc.mem.offset,
+                          src.loc.fpr);
+
+  case MOVE_MEM_TO_MEM:
+    return abi_mem_to_mem(_jit, src.abi, dst.loc.mem.base, dst.loc.mem.offset,
+                          src.loc.mem.base, src.loc.mem.offset);
+
+  default:
+    abort();
+  }
+}
+
+// A direct transliteration of "Tilting at windmills with Coq: formal
+// verification of a compilation algorithm for parallel moves" by
+// Laurence Rideau, Bernard Paul Serpette, and Xavier Leroy:
+// https://xavierleroy.org/publi/parallel-move.pdf
+
+enum move_status { TO_MOVE, BEING_MOVED, MOVED };
+
+static inline int
+already_in_place(jit_operand_t src, jit_operand_t dst)
+{
+  switch (MOVE_KIND(src.kind, dst.kind)) {
+  case MOVE_GPR_TO_GPR:
+    return jit_same_gprs (src.loc.gpr.gpr, dst.loc.gpr.gpr);
+  case MOVE_FPR_TO_FPR:
+    return jit_same_fprs (src.loc.fpr, dst.loc.fpr);
+  case MOVE_MEM_TO_MEM:
+    return jit_same_gprs (src.loc.mem.base, dst.loc.mem.base) &&
+      src.loc.mem.offset == dst.loc.mem.offset;
+  default:
+    return 0;
+  }
+}
+
+static inline int
+write_would_clobber(jit_operand_t src, jit_operand_t dst)
+{
+  if (already_in_place (src, dst))
+    return 1;
+
+  if (MOVE_KIND(src.kind, dst.kind) == MOVE_MEM_TO_GPR)
+    return jit_same_gprs(src.loc.mem.base, dst.loc.gpr.gpr);
+
+  return 0;
+}
+
+static inline ptrdiff_t
+operand_addend(jit_operand_t op)
+{
+  switch (op.kind) {
+  case JIT_OPERAND_KIND_GPR:
+    return op.loc.gpr.addend;
+  case JIT_OPERAND_KIND_MEM:
+    return op.loc.mem.addend;
+  default:
+    abort();
+  }
+}
+
+static void
+move_one(jit_state_t *_jit, jit_operand_t *dst, jit_operand_t *src,
+         size_t argc, enum move_status *status, size_t i)
+{
+  int tmp_gpr = 0, tmp_fpr = 0;
+
+  if (already_in_place(src[i], dst[i]))
+    return;
+
+  status[i] = BEING_MOVED;
+  for (size_t j = 0; j < argc; j++) {
+    if (write_would_clobber(src[j], dst[i])) {
+      switch (status[j]) {
+      case TO_MOVE:
+        move_one(_jit, dst, src, argc, status, j);
+        break;
+      case BEING_MOVED: {
+        jit_operand_t tmp;
+        if (is_fpr_arg (src[j].kind)) {
+          tmp_fpr = 1;
+          tmp = jit_operand_fpr(src[j].abi, get_temp_fpr(_jit));
+        } else {
+          tmp_gpr = 1;
+          /* Preserve addend, if any, from source operand, to be applied
+             at the end.  */
+          tmp = jit_operand_gpr_with_addend(src[j].abi, get_temp_gpr(_jit),
+                                            operand_addend(src[j]));
+        }
+        move_operand (_jit, tmp, src[j]);
+        src[j] = tmp;
+        break;
+      }
+      case MOVED:
+        break;
+      default:
+        abort ();
+      }
+    }
+  }
+
+  move_operand (_jit, dst[i], src[i]);
+  status[i] = MOVED;
+  if (tmp_gpr)
+    unget_temp_gpr(_jit);
+  else if (tmp_fpr)
+    unget_temp_fpr(_jit);
+}
+
+static void
+apply_addend(jit_state_t *_jit, jit_operand_t dst, jit_operand_t src)
+{
+  switch (MOVE_KIND(src.kind, dst.kind)) {
+  case MOVE_GPR_TO_GPR:
+  case MOVE_MEM_TO_GPR:
+    if (operand_addend(src))
+      jit_addi(_jit, dst.loc.gpr.gpr, dst.loc.gpr.gpr, operand_addend(src));
+    break;
+  case MOVE_GPR_TO_MEM:
+  case MOVE_MEM_TO_MEM:
+    if (operand_addend(src)) {
+      jit_gpr_t tmp = get_temp_gpr(_jit);
+      abi_mem_to_gpr(_jit, dst.abi, tmp, dst.loc.mem.base, dst.loc.mem.offset);
+      jit_addi(_jit, tmp, tmp, operand_addend(src));
+      abi_gpr_to_mem(_jit, dst.abi, dst.loc.mem.base, dst.loc.mem.offset, tmp);
+      unget_temp_gpr(_jit);
+    }
+    break;
+  default:
+    break;
+  }
+}
+
+/* Preconditions: No dest operand is IMM.  No dest operand aliases
+   another dest operand.  No dest MEM operand uses a base register which
+   is used as a dest GPR.  No dst operand has an addend.  The registers
+   returned by get_temp_gpr and get_temp_fpr do not appear in source or
+   dest args.  */
+void
+jit_move_operands(jit_state_t *_jit, jit_operand_t *dst, jit_operand_t *src,
+                  size_t argc)
+{
+  // Check preconditions, except the condition about tmp registers.
+  {
+    uint64_t src_gprs = 0;
+    uint64_t dst_gprs = 0;
+    uint64_t dst_fprs = 0;
+    uint64_t dst_mem_base_gprs = 0;
+    for (size_t i = 0; i < argc; i++) {
+      switch (src[i].kind) {
+      case JIT_OPERAND_KIND_GPR:
+        src_gprs |= 1ULL << jit_gpr_regno(src[i].loc.gpr.gpr);
+        break;
+      case JIT_OPERAND_KIND_FPR:
+      case JIT_OPERAND_KIND_IMM:
+      case JIT_OPERAND_KIND_MEM:
+        break;
+      default:
+        abort();
+      }
+      switch (dst[i].kind) {
+      case JIT_OPERAND_KIND_GPR: {
+        ASSERT(dst[i].loc.gpr.addend == 0);
+        uint64_t bit = 1ULL << jit_gpr_regno(dst[i].loc.gpr.gpr);
+        ASSERT((dst_gprs & bit) == 0);
+        dst_gprs |= bit;
+        break;
+      }
+      case JIT_OPERAND_KIND_FPR: {
+        uint64_t bit = 1ULL << jit_fpr_regno(dst[i].loc.fpr);
+        ASSERT((dst_fprs & bit) == 0);
+        dst_fprs |= bit;
+        break;
+      }
+      case JIT_OPERAND_KIND_MEM: {
+        ASSERT(dst[i].loc.mem.addend == 0);
+        uint64_t bit = 1ULL << jit_gpr_regno(dst[i].loc.mem.base);
+        dst_mem_base_gprs |= bit;
+        break;
+      }
+      case JIT_OPERAND_KIND_IMM:
+      default:
+        abort();
+        break;
+      }
+    }
+    ASSERT(((src_gprs | dst_gprs) & dst_mem_base_gprs) == 0);
+  }
+
+  enum move_status status[argc];
+  for (size_t i = 0; i < argc; i++)
+    status[i] = TO_MOVE;
+  for (size_t i = 0; i < argc; i++)
+    if (status[i] == TO_MOVE)
+      move_one(_jit, dst, src, argc, status, i);
+
+  // Apply addends at the end.  We could do it earlier in some cases but
+  // at least at the end we know that an in-place increment of one
+  // operand won't alias another.
+  for (size_t i = 0; i < argc; i++)
+    apply_addend(_jit, dst[i], src[i]);
+}
+
+size_t
+jit_align_stack(jit_state_t *_jit, size_t expand)
+{
+  size_t new_size = _jit->frame_size + expand;
+  // Align stack to double-word boundaries.  This isn't really a
+  // principle but it does work for Aarch32, AArch64 and x86-64.
+  size_t alignment = jit_stack_alignment ();
+  size_t aligned_size = (new_size + alignment - 1) & ~(alignment - 1);
+  size_t diff = aligned_size - _jit->frame_size;
+  if (diff)
+    jit_subi (_jit, JIT_SP, JIT_SP, diff);
+  _jit->frame_size = aligned_size;
+  return diff;
+}
+
+void
+jit_shrink_stack(jit_state_t *_jit, size_t diff)
+{
+  if (diff)
+    jit_addi (_jit, JIT_SP, JIT_SP, diff);
+  _jit->frame_size -= diff;
+}
+
+static const jit_gpr_t platform_callee_save_gprs[] = {
+  JIT_PLATFORM_CALLEE_SAVE_GPRS
+};
+
+static const jit_gpr_t user_callee_save_gprs[] = {
+  JIT_V0, JIT_V1, JIT_V2
+#ifdef JIT_V3
+  , JIT_V3
+#endif
+#ifdef JIT_V4
+  , JIT_V4
+#endif
+#ifdef JIT_V5
+  , JIT_V5
+#endif
+#ifdef JIT_V6
+  , JIT_V6
+#endif
+#ifdef JIT_V7
+  , JIT_V7
+#endif
+#ifdef JIT_V8
+  , JIT_V8
+#endif
+#ifdef JIT_V9
+  , JIT_V9
+#endif
+ };
+
+static const jit_fpr_t user_callee_save_fprs[] = {
+#ifdef JIT_VF0
+  JIT_VF0
+#endif
+#ifdef JIT_VF1
+  , JIT_VF1
+#endif
+#ifdef JIT_VF2
+  , JIT_VF2
+#endif
+#ifdef JIT_VF3
+  , JIT_VF3
+#endif
+#ifdef JIT_VF4
+  , JIT_VF4
+#endif
+#ifdef JIT_VF5
+  , JIT_VF5
+#endif
+#ifdef JIT_VF6
+  , JIT_VF6
+#endif
+#ifdef JIT_VF7
+  , JIT_VF7
+#endif
+};
+
+#define ARRAY_SIZE(X) (sizeof (X)/sizeof ((X)[0]))
+static const size_t pv_count = ARRAY_SIZE(platform_callee_save_gprs);
+static const size_t v_count = ARRAY_SIZE(user_callee_save_gprs);
+static const size_t vf_count = ARRAY_SIZE(user_callee_save_fprs);
+
+size_t
+jit_enter_jit_abi(jit_state_t *_jit, size_t v, size_t vf, size_t frame_size)
+{
+  ASSERT(v <= v_count);
+  ASSERT(vf <= vf_count);
+
+  ASSERT(_jit->frame_size == 0);
+  _jit->frame_size = jit_initial_frame_size();
+
+  size_t reserved =
+    jit_align_stack(_jit, (pv_count + v) * (__WORDSIZE / 8) + vf * 8);
+
+  size_t offset = 0;
+  for (size_t i = 0; i < vf; i++, offset += 8)
+    jit_stxi_d(_jit, offset, JIT_SP, user_callee_save_fprs[i]);
+  for (size_t i = 0; i < v; i++, offset += __WORDSIZE / 8)
+    jit_stxi(_jit, offset, JIT_SP, user_callee_save_gprs[i]);
+  for (size_t i = 0; i < pv_count; i++, offset += __WORDSIZE / 8)
+    jit_stxi(_jit, offset, JIT_SP, platform_callee_save_gprs[i]);
+  ASSERT(offset <= reserved);
+
+  return reserved;
+}
+
+void
+jit_leave_jit_abi(jit_state_t *_jit, size_t v, size_t vf, size_t frame_size)
+{
+  ASSERT(v <= v_count);
+  ASSERT(vf <= vf_count);
+  ASSERT((pv_count + v) * (__WORDSIZE / 8) + vf * 8 <= frame_size);
+
+  size_t offset = 0;
+  for (size_t i = 0; i < vf; i++, offset += 8)
+    jit_ldxi_d(_jit, user_callee_save_fprs[i], JIT_SP, offset);
+  for (size_t i = 0; i < v; i++, offset += __WORDSIZE / 8)
+    jit_ldxi(_jit, user_callee_save_gprs[i], JIT_SP, offset);
+  for (size_t i = 0; i < pv_count; i++, offset += __WORDSIZE / 8)
+    jit_ldxi(_jit, platform_callee_save_gprs[i], JIT_SP, offset);
+  ASSERT(offset <= frame_size);
+
+  jit_shrink_stack(_jit, frame_size);
+}
+
+// Precondition: stack is already aligned.
+static size_t
+prepare_call_args(jit_state_t *_jit, size_t argc, jit_operand_t args[])
+{
+  jit_operand_t dst[argc];
+  struct abi_arg_iterator iter;
+  
+  // Compute shuffle destinations and space for spilled arguments.
+  reset_abi_arg_iterator(&iter, argc, args);
+  for (size_t i = 0; i < argc; i++)
+    next_abi_arg(&iter, &dst[i]);
+
+  // Reserve space for spilled arguments and ensure stack alignment.
+  size_t stack_size = jit_align_stack(_jit, iter.stack_size);
+
+  // Fix up SP-relative operands.
+  for (size_t i = 0; i < argc; i++) {
+    switch(args[i].kind) {
+    case JIT_OPERAND_KIND_GPR:
+      if (jit_same_gprs (args[i].loc.gpr.gpr, JIT_SP))
+        args[i].loc.gpr.addend += stack_size;
+      break;
+    case JIT_OPERAND_KIND_MEM:
+      if (jit_same_gprs (args[i].loc.mem.base, JIT_SP))
+        args[i].loc.mem.offset += stack_size;
+      break;
+    default:
+      break;
+    }
+  }
+
+  jit_move_operands(_jit, dst, args, argc);
+
+  return stack_size;
+}
+
+void
+jit_calli(jit_state_t *_jit, jit_pointer_t f, size_t argc, jit_operand_t args[])
+{
+  size_t stack_bytes = prepare_call_args(_jit, argc, args);
+
+  calli(_jit, (jit_word_t)f);
+
+  jit_shrink_stack(_jit, stack_bytes);
+}
+
+void
+jit_callr(jit_state_t *_jit, jit_gpr_t f, size_t argc, jit_operand_t args[])
+{
+  size_t stack_bytes = prepare_call_args(_jit, argc, args);
+
+  callr(_jit, jit_gpr_regno(f));
+
+  jit_shrink_stack(_jit, stack_bytes);
+}
+
+void
+jit_locate_args(jit_state_t *_jit, size_t argc, jit_operand_t args[])
+{
+  struct abi_arg_iterator iter;
+    
+  reset_abi_arg_iterator(&iter, argc, args);
+  iter.stack_size += _jit->frame_size;
+  for (size_t i = 0; i < argc; i++)
+    next_abi_arg(&iter, &args[i]);
+}
+
+/* Precondition: args are distinct locations of type GPR or FPR.  All
+   addends of arg operands are zero.  No GPR arg is SP.  */
+void
+jit_load_args(jit_state_t *_jit, size_t argc, jit_operand_t args[])
+{
+  jit_operand_t src[argc];
+
+  memcpy(src, args, sizeof(src[0]) * argc);
+
+  jit_locate_args(_jit, argc, src);
+  jit_move_operands(_jit, args, src, argc);
+}
+
+#ifdef JIT_NEEDS_LITERAL_POOL
+static uint32_t
+literal_pool_byte_size(struct jit_literal_pool *pool)
+{
+  // Assume that we might need a uint32_t to branch over a table, and up
+  // to 7 bytes for alignment of the table.  Then we assume that no
+  // entry will be more than two words.
+  return sizeof(uint32_t) + 7 + pool->size * sizeof(uintptr_t) * 2;
+}
+
+static void
+reset_literal_pool(jit_state_t *_jit, struct jit_literal_pool *pool)
+{
+  pool->deadline = _jit->limit - _jit->start;
+  pool->size = 0;
+  memset(pool->entries, 0, sizeof(pool->entries[0]) * pool->size);
+}
+
+#define INITIAL_LITERAL_POOL_CAPACITY 12
+static struct jit_literal_pool*
+alloc_literal_pool(jit_state_t *_jit, size_t capacity)
+{
+  if (capacity == 0) capacity = INITIAL_LITERAL_POOL_CAPACITY;
+
+  struct jit_literal_pool *ret =
+    _jit->alloc (sizeof (struct jit_literal_pool) +
+                 sizeof (struct jit_literal_pool_entry) * capacity);
+  ASSERT (ret);
+  ret->capacity = capacity;
+  reset_literal_pool(_jit, ret);
+  return ret;
+}
+
+static void
+grow_literal_pool(jit_state_t *_jit)
+{
+  struct jit_literal_pool *new_pool =
+    alloc_literal_pool(_jit, _jit->pool->capacity * 2);
+
+  for (size_t i = 0; i < _jit->pool->size; i++)
+    new_pool->entries[new_pool->size++] = _jit->pool->entries[i];
+  new_pool->deadline = _jit->pool->deadline;
+
+  _jit->free (_jit->pool);
+  _jit->pool = new_pool;
+}
+
+static jit_bool_t
+add_literal_pool_entry(jit_state_t *_jit, struct jit_literal_pool_entry entry,
+                       uint32_t max_offset)
+{
+  if (_jit->overflow)
+    return 1;
+
+  if (max_offset <= literal_pool_byte_size(_jit->pool)) {
+    emit_literal_pool(_jit, GUARD_NEEDED);
+    return 0;
+  }
+
+  if (_jit->pool->size == _jit->pool->capacity)
+    grow_literal_pool (_jit);
+
+  uint32_t loc_offset = _jit->pc.uc - _jit->start;
+  uint32_t inst_offset = loc_offset - entry.reloc.inst_start_offset;
+  uint32_t pc_base_offset = inst_offset + entry.reloc.pc_base_offset;
+  uint32_t deadline =
+    pc_base_offset + (max_offset - literal_pool_byte_size(_jit->pool));
+  if (deadline < _jit->pool->deadline)
+    _jit->pool->deadline = deadline;
+
+  _jit->pool->entries[_jit->pool->size++] = entry;
+
+  return 1;
+}
+
+static jit_bool_t
+add_pending_literal(jit_state_t *_jit, jit_reloc_t src,
+                    uint8_t max_offset_bits)
+{
+  struct jit_literal_pool_entry entry = { src, 0 };
+  uint32_t max_inst_size = sizeof(uint32_t);
+  uint32_t max_offset = (1 << (max_offset_bits + src.rsh)) - max_inst_size;
+  return add_literal_pool_entry(_jit, entry, max_offset);
+}
+
+static void
+remove_pending_literal(jit_state_t *_jit, jit_reloc_t src)
+{
+  for (size_t i = _jit->pool->size; i--; ) {
+    if (_jit->pool->entries[i].reloc.offset == src.offset) {
+      for (size_t j = i + 1; j < _jit->pool->size; j++)
+        _jit->pool->entries[j-1] = _jit->pool->entries[j];
+      _jit->pool->size--;
+      return;
+    }
+  }
+  abort();
+}
+
+static void
+patch_pending_literal(jit_state_t *_jit, jit_reloc_t src, uint64_t value)
+{
+  for (size_t i = _jit->pool->size; i--; ) {
+    if (_jit->pool->entries[i].reloc.offset == src.offset) {
+      ASSERT(_jit->pool->entries[i].value == 0);
+      _jit->pool->entries[i].value = value;
+      return;
+    }
+  }
+  abort();
+}
+
+static void
+emit_literal_pool(jit_state_t *_jit, enum guard_pool guard)
+{
+  if (_jit->overflow)
+    return;
+
+  if (!_jit->pool->size)
+    return;
+
+  uint32_t *patch_loc = NULL;
+  if (guard == GUARD_NEEDED)
+    patch_loc = jmp_without_veneer(_jit);
+
+  // FIXME: Could de-duplicate constants.
+  for (size_t i = 0; i < _jit->pool->size; i++) {
+    // Align to 8-byte boundary without emitting pool.
+    if (_jit->pc.w & 1) emit_u8(_jit, 0);
+    if (_jit->pc.w & 2) emit_u16(_jit, 0);
+    if (_jit->pc.w & 4) emit_u32(_jit, 0);
+    struct jit_literal_pool_entry *entry = &_jit->pool->entries[i];
+    uint8_t *loc = _jit->start + entry->reloc.offset;
+    uint8_t *pc_base =
+      loc - entry->reloc.inst_start_offset + entry->reloc.pc_base_offset;
+    ptrdiff_t diff = _jit->pc.uc - pc_base;
+    diff >>= entry->reloc.rsh;
+
+    if (_jit->overflow)
+      return;
+
+    switch (entry->reloc.kind) {
+    case JIT_RELOC_JMP_WITH_VENEER:
+      patch_jmp_offset((uint32_t*) loc, diff);
+      emit_veneer(_jit, (void*) (uintptr_t) entry->value);
+      break;
+    case JIT_RELOC_JCC_WITH_VENEER:
+      patch_jcc_offset((uint32_t*) loc, diff);
+      emit_veneer(_jit, (void*) (uintptr_t) entry->value);
+      break;
+    case JIT_RELOC_LOAD_FROM_POOL:
+      patch_load_from_pool_offset((uint32_t*) loc, diff);
+      emit_u64(_jit, entry->value);
+      break;
+    default:
+      abort();
+    }
+  }
+
+  if (_jit->overflow)
+    return;
+
+  if (guard == GUARD_NEEDED)
+    patch_jmp_without_veneer(_jit, patch_loc);
+
+  reset_literal_pool(_jit, _jit->pool);
+}
+#endif
diff --git a/libguile/lightening/lightening/mips-cpu.c b/libguile/lightening/lightening/mips-cpu.c
new file mode 100644
index 000000000..7ab58b873
--- /dev/null
+++ b/libguile/lightening/lightening/mips-cpu.c
@@ -0,0 +1,3153 @@
+/*
+ * Copyright (C) 2012-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+typedef union {
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+    struct {	uint32_t _:26;	uint32_t b :  6; } hc;
+    struct {	uint32_t _:21;	uint32_t b :  5; } rs;
+    struct {	uint32_t _:21;	uint32_t b :  5; } fm;
+    struct {	uint32_t _:16;	uint32_t b :  5; } rt;
+    struct {	uint32_t _:16;	uint32_t b :  5; } ft;
+    struct {	uint32_t _:11;	uint32_t b :  5; } rd;
+    struct {	uint32_t _:11;	uint32_t b :  5; } fs;
+    struct {	uint32_t _: 6;	uint32_t b :  5; } ic;
+    struct {	uint32_t _: 6;	uint32_t b :  5; } fd;
+    struct {	uint32_t _: 6;	uint32_t b : 10; } tr;
+    struct {	uint32_t _: 6;	uint32_t b : 20; } br;
+    struct {				uint32_t b :  6; } tc;
+    struct {				uint32_t b : 11; } cc;
+    struct {				uint32_t b : 16; } is;
+    struct {				uint32_t b : 26; } ii;
+#else
+    struct {				uint32_t b :  6; } hc;
+    struct {	uint32_t _: 6;	uint32_t b :  5; } rs;
+    struct {	uint32_t _: 6;	uint32_t b :  5; } fm;
+    struct {	uint32_t _:11;	uint32_t b :  5; } rt;
+    struct {	uint32_t _:11;	uint32_t b :  5; } ft;
+    struct {	uint32_t _:16;	uint32_t b :  5; } rd;
+    struct {	uint32_t _:16;	uint32_t b :  5; } fs;
+    struct {	uint32_t _:21;	uint32_t b :  5; } ic;
+    struct {	uint32_t _:21;	uint32_t b :  5; } fd;
+    struct {	uint32_t _:21;	uint32_t b : 10; } tr;
+    struct {	uint32_t _:21;	uint32_t b : 20; } br;
+    struct {	uint32_t _:26;	uint32_t b :  6; } tc;
+    struct {	uint32_t _:21;	uint32_t b : 11; } cc;
+    struct {	uint32_t _:16;	uint32_t b : 16; } is;
+    struct {	uint32_t _: 6;	uint32_t b : 26; } ii;
+#endif
+    int					op;
+} jit_instr_t;
+/* FIXME */
+#  define jit_mips2_p()			0
+#  define _ZERO_REGNO			0
+#  define _T0_REGNO			0x08
+#  define _T1_REGNO			0x09
+#  define _T2_REGNO			0x0a
+#  define _T3_REGNO			0x0b
+#  define _T4_REGNO			0x0c
+#  define _T5_REGNO			0x0d
+#  define _T6_REGNO			0x0e
+#  define _T7_REGNO			0x0f
+#  define _S0_REGNO			0x10
+#  define _S1_REGNO			0x11
+#  define _S2_REGNO			0x12
+#  define _S3_REGNO			0x13
+#  define _S4_REGNO			0x14
+#  define _S5_REGNO			0x15
+#  define _S6_REGNO			0x16
+#  define _S7_REGNO			0x17
+#  define _T8_REGNO			0x18
+#  define _T9_REGNO			0x19
+#  define _SP_REGNO			0x1d
+#  define _BP_REGNO			0x1e
+#  define _RA_REGNO			0x1f
+#  define _F16_REGNO			16
+#  define _F18_REGNO			18
+#  define _F20_REGNO			20
+#  define _F22_REGNO			22
+#  define _F24_REGNO			24
+#  define _F26_REGNO			26
+#  define _F28_REGNO			28
+#  define _F30_REGNO			30
+#  if __WORDSIZE == 32
+#    if NEW_ABI
+#      define stack_framesize		144
+#    else
+#      define stack_framesize		112
+#    endif
+#    define ldr(u,v)			ldr_i(u,v)
+#    define ldi(u,v)			ldi_i(u,v)
+#    define ldxi(u,v,w)			ldxi_i(u,v,w)
+#    define sti(u,v)			sti_i(u,v)
+#    define stxi(u,v,w)			stxi_i(u,v,w)
+#  else
+#    define stack_framesize		144
+#    define ldr(u,v)			ldr_l(u,v)
+#    define ldi(u,v)			ldi_l(u,v)
+#    define ldxi(u,v,w)			ldxi_l(u,v,w)
+#    define sti(u,v)			sti_l(u,v)
+#    define stxi(u,v,w)			stxi_l(u,v,w)
+#  endif
+#  define can_sign_extend_short_p(im)	((im) >= -32678 && (im) <= 32767)
+#  define can_zero_extend_short_p(im)	((im) >= 0 && (im) <= 65535)
+#  if __WORDSIZE == 32
+#    define can_sign_extend_int_p(im)	1
+#    define can_zero_extend_int_p(im)	1
+#  else
+#    define can_sign_extend_int_p(im)					\
+	(((im) >= 0 && (im) <=  0x7fffffffL) ||				\
+	 ((im) <  0 && (im) >= -0x80000000L))
+#    define can_zero_extend_int_p(im)	((im) >= 0 && (im) <= 0xffffffff)
+#  endif
+#  define MIPS_SPECIAL			0x00
+#  define MIPS_REGIMM			0x01
+#  define MIPS_J			0x02
+#  define MIPS_SRL			0x02
+#  define MIPS_JAL			0x03
+#  define MIPS_SRA			0x03
+#  define MIPS_BEQ			0x04
+#  define MIPS_BNE			0x05
+#  define MIPS_BLEZ			0x06
+#  define MIPS_BGTZ			0x07
+#  define MIPS_ADDI			0x08
+#  define MIPS_ADDIU			0x09
+#  define MIPS_SLTI			0x0a
+#  define MIPS_SLTIU			0x0b
+#  define MIPS_ANDI			0x0c
+#  define MIPS_ORI			0x0d
+#  define MIPS_XORI			0x0e
+#  define MIPS_LUI			0x0f
+#  define MIPS_COP0			0x10
+#  define MIPS_COP1			0x11
+#  define MIPS_COP2			0x12
+#  define MIPS_COP1X			0x13
+#  define MIPS_BEQL			0x14
+#  define MIPS_BNEL			0x15
+#  define MIPS_BLEZL			0x16
+#  define MIPS_BGTZL			0x17
+#  define MIPS_DADDI			0x18
+#  define MIPS_DADDIU			0x19
+#  define MIPS_LDL			0x1a
+#  define MIPS_LDR			0x1b
+#  define MIPS_SPECIAL2			0x1c
+#  define MIPS_JALX			0x1d
+#  define MIPS_SPECIAL3			0x1f
+#  define MIPS_LB 			0x20
+#  define MIPS_LH 			0x21
+#  define MIPS_LWL			0x22
+#  define MIPS_LW 			0x23
+#  define MIPS_LBU			0x24
+#  define MIPS_LHU			0x25
+#  define MIPS_LWR			0x26
+#  define MIPS_LWU			0x27
+#  define MIPS_SB 			0x28
+#  define MIPS_SH 			0x29
+#  define MIPS_SWL			0x2a
+#  define MIPS_SW 			0x2b
+#  define MIPS_SWR			0x2e
+#  define MIPS_CACHE			0x2f
+#  define MIPS_LL 			0x30
+#  define MIPS_LWC1			0x31
+#  define MIPS_LWC2			0x32
+#  define MIPS_PREF			0x33
+#  define MIPS_LLD			0x34
+#  define MIPS_LDC1			0x35
+#  define MIPS_LDC2			0x36
+#  define MIPS_LD 			0x37
+#  define MIPS_SC 			0x38
+#  define MIPS_SCD			0x3c
+#  define MIPS_SDC1			0x3d
+#  define MIPS_SDC2			0x3e
+#  define MIPS_SWC1			0x39
+#  define MIPS_SWC2			0x3a
+#  define MIPS_SD 			0x3f
+#  define MIPS_MF			0x00
+#  define MIPS_DMF			0x01
+#  define MIPS_CF			0x02
+#  define MIPS_MFH			0x03
+#  define MIPS_MT			0x04
+#  define MIPS_DMT			0x05
+#  define MIPS_CT			0x06
+#  define MIPS_MTH			0x07
+#  define MIPS_BC			0x08
+#  define MIPS_WRPGPR			0x0e
+#  define MIPS_BGZAL			0x11
+#  define MIPS_MFMC0			0x11
+#  define MIPS_BCF			0x00
+#  define MIPS_BLTZ			0x00
+#  define MIPS_BCT			0x01
+#  define MIPS_BGEZ			0x01
+#  define MIPS_BCFL			0x02
+#  define MIPS_BLTZL			0x02
+#  define MIPS_BCTL			0x03
+#  define MIPS_BGEZL			0x03
+#  define MIPS_TGEI			0x08
+#  define MIPS_TGEIU			0x09
+#  define MIPS_TLTI			0x0a
+#  define MIPS_TLTIU			0x0b
+#  define MIPS_TEQI			0x0c
+#  define MIPS_TNEI			0x0e
+#  define MIPS_BLTZAL			0x10
+#  define MIPS_BGEZAL			0x11
+#  define MIPS_BLTZALL			0x12
+#  define MIPS_BGEZALL			0x13
+#  define MIPS_SYNCI			0x1f
+#  define MIPS_WSBH			0x02
+#  define MIPS_DBSH			0x02
+#  define MIPS_DSHD			0x05
+#  define MIPS_SEB			0x10
+#  define MIPS_SEH			0x18
+#  define MIPS_MADD			0x00
+#  define MIPS_SLL			0x00
+#  define MIPS_EXT			0x00
+#  define MIPS_DEXTM			0x01
+#  define MIPS_MADDU			0x01
+#  define MIPS_MOVFT			0x01
+#  define MIPS_TLBR			0x01
+#  define MIPS_MUL			0x02
+#  define MIPS_DEXTU			0x02
+#  define MIPS_TLBWI			0x02
+#  define MIPS_DEXT			0x03
+#  define MIPS_SLLV			0x04
+#  define MIPS_INS			0x04
+#  define MIPS_MSUB			0x04
+#  define MIPS_DINSM			0x05
+#  define MIPS_MSUBU			0x05
+#  define MIPS_SRLV			0x06
+#  define MIPS_DINSU			0x06
+#  define MIPS_TLBWR			0x06
+#  define MIPS_SRAV			0x07
+#  define MIPS_DINS			0x07
+#  define MIPS_JR			0x08
+#  define MIPS_TLBP			0x08
+#  define MIPS_JALR			0x09
+#  define MIPS_MOVZ			0x0a
+#  define MIPS_MOVN			0x0b
+#  define MIPS_SYSCALL			0x0c
+#  define MIPS_BREAK			0x0d
+#  define MIPS_PREFX			0x0f
+#  define MIPS_SYNC			0x0f
+#  define MIPS_MFHI			0x10
+#  define MIPS_MTHI			0x11
+#  define MIPS_MFLO			0x12
+#  define MIPS_MTLO			0x13
+#  define MIPS_DSLLV			0x14
+#  define MIPS_DSRLV			0x16
+#  define MIPS_DSRAV			0x17
+#  define MIPS_MULT			0x18
+#  define MIPS_ERET			0x18
+#  define MIPS_MULTU			0x19
+#  define MIPS_DIV			0x1a
+#  define MIPS_DIVU			0x1b
+#  define MIPS_DMULT			0x1c
+#  define MIPS_DMULTU			0x1d
+#  define MIPS_DDIV			0x1e
+#  define MIPS_DDIVU			0x1f
+#  define MIPS_DERET			0x1f
+#  define MIPS_ADD			0x20
+#  define MIPS_CLZ			0x20
+#  define MIPS_BSHFL			0x20
+#  define MIPS_ADDU			0x21
+#  define MIPS_CLO			0x21
+#  define MIPS_SUB			0x22
+#  define MIPS_SUBU			0x23
+#  define MIPS_AND			0x24
+#  define MIPS_DCLZ			0x24
+#  define MIPS_DBSHFL			0x24
+#  define MIPS_OR			0x25
+#  define MIPS_DCLO			0x25
+#  define MIPS_XOR			0x26
+#  define MIPS_NOR			0x27
+#  define MIPS_SLT			0x2a
+#  define MIPS_SLTU			0x2b
+#  define MIPS_DADD			0x2c
+#  define MIPS_DADDU			0x2d
+#  define MIPS_DSUB			0x2e
+#  define MIPS_DSUBU			0x2f
+#  define MIPS_TGE			0x30
+#  define MIPS_TGEU			0x31
+#  define MIPS_TLT			0x32
+#  define MIPS_TLTU			0x33
+#  define MIPS_TEQ			0x34
+#  define MIPS_TNE			0x36
+#  define MIPS_DSLL			0x38
+#  define MIPS_DSRL			0x3a
+#  define MIPS_DSRA			0x3b
+#  define MIPS_DSLL32			0x3c
+#  define MIPS_DSRL32			0x3e
+#  define MIPS_DSRA32			0x3f
+#  define MIPS_SDBPP			0x3f
+#  define ii(i)				*_jit->pc.ui++ = i
+static void
+_hrrrit(jit_state_t*,int32_t,int32_t,int32_t,int32_t,
+	int32_t,int32_t);
+#  define hrrrit(hc,rs,rt,rd,im,tc)	_hrrrit(_jit,hc,rs,rt,rd,im,tc)
+#  define hrrr_t(hc,rs,rt,rd,tc)	hrrrit(hc,rs,rt,rd,0,tc)
+#  define rrr_t(rs,rt,rd,tc)		hrrr_t(0,rs,rt,rd,tc)
+#  define hrri(hc,rs,rt,im)		_hrri(_jit,hc,rs,rt,im)
+static void _hrri(jit_state_t*,int32_t,int32_t,int32_t,int32_t);
+#  define hi(hc,im)			_hi(_jit,hc,im)
+static void _hi(jit_state_t*,int32_t,int32_t);
+#  define NOP(i0)			ii(0)
+#  define nop(i0)			_nop(_jit,i0)
+static void _nop(jit_state_t*,int32_t);
+#  define h_ri(hc,rt,im)		_hrri(_jit,hc,0,rt,im)
+#  define rrit(rt,rd,im,tc)		_hrrrit(_jit,0,0,rt,rd,im,tc)
+#  define LUI(rt,im)			h_ri(MIPS_LUI,rt,im)
+#  define ADDU(rd,rs,rt)		rrr_t(rs,rt,rd,MIPS_ADDU)
+#  define DADDU(rd,rs,rt)		rrr_t(rs,rt,rd,MIPS_DADDU)
+#  define ADDIU(rt,rs,im)		hrri(MIPS_ADDIU,rs,rt,im)
+#  define DADDIU(rt,rs,im)		hrri(MIPS_DADDIU,rs,rt,im)
+#  define SUBU(rd,rs,rt)		rrr_t(rs,rt,rd,MIPS_SUBU)
+#  define DSUBU(rd,rs,rt)		rrr_t(rs,rt,rd,MIPS_DSUBU)
+#  define MULT(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_MULT)
+#  define MULTU(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_MULTU)
+#  define DMULT(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DMULT)
+#  define DMULTU(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DMULTU)
+#  define DIV(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DIV)
+#  define DIVU(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DIVU)
+#  define DDIV(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DDIV)
+#  define DDIVU(rs,rt)			rrr_t(rs,rt,_ZERO_REGNO,MIPS_DDIVU)
+#  define SLLV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_SLLV)
+#  define SLL(rd,rt,sa)			rrit(rt,rd,sa,MIPS_SLL)
+#  define DSLLV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_DSLLV)
+#  define DSLL(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSLL)
+#  define DSLL32(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSLL32)
+#  define SRAV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_SRAV)
+#  define SRA(rd,rt,sa)			rrit(rt,rd,sa,MIPS_SRA)
+#  define SRLV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_SRLV)
+#  define SRL(rd,rt,sa)			rrit(rt,rd,sa,MIPS_SRL)
+#  define DSRAV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_DSRAV)
+#  define DSRA(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSRA)
+#  define DSRA32(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSRA32)
+#  define DSRLV(rd,rt,rs)		rrr_t(rs,rt,rd,MIPS_DSRLV)
+#  define DSRL(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSRL)
+#  define DSRL32(rd,rt,sa)		rrit(rt,rd,sa,MIPS_DSRL32)
+#  define INS(rt,rs,pos,size)		hrrrit(MIPS_SPECIAL3,rs,rt,pos,pos+size-1,MIPS_INS)
+#  define DINS(rt,rs,pos,size)		hrrrit(MIPS_SPECIAL3,rs,rt,pos,pos+size-1,MIPS_DINS)
+#  define ROTR(rd,rt,sa)		hrrrit(MIPS_SPECIAL,1,rt,rd,sa,MIPS_SRL)
+#  define DROTR(rd,rt,sa)		hrrrit(MIPS_SPECIAL,1,rt,rd,sa,MIPS_DSRL)
+#  define MFHI(rd)			rrr_t(_ZERO_REGNO,_ZERO_REGNO,rd,MIPS_MFHI)
+#  define MFLO(rd)			rrr_t(_ZERO_REGNO,_ZERO_REGNO,rd,MIPS_MFLO)
+#  define MTHI(rs)			rrr_t(rs,_ZERO_REGNO,_ZERO_REGNO,MIPS_MTHI)
+#  define MTLO(rs)			rrr_t(rs,_ZERO_REGNO,_ZERO_REGNO,MIPS_MTLO)
+#  define AND(rd,rs,rt)			rrr_t(rs,rt,rd,MIPS_AND)
+#  define ANDI(rt,rs,im)		hrri(MIPS_ANDI,rs,rt,im)
+#  define OR(rd,rs,rt)			rrr_t(rs,rt,rd,MIPS_OR)
+#  define ORI(rt,rs,im)			hrri(MIPS_ORI,rs,rt,im)
+#  define XOR(rd,rs,rt)			rrr_t(rs,rt,rd,MIPS_XOR)
+#  define XORI(rt,rs,im)		hrri(MIPS_XORI,rs,rt,im)
+#  define LB(rt,of,rb)			hrri(MIPS_LB,rb,rt,of)
+#  define LBU(rt,of,rb)			hrri(MIPS_LBU,rb,rt,of)
+#  define LH(rt,of,rb)			hrri(MIPS_LH,rb,rt,of)
+#  define LHU(rt,of,rb)			hrri(MIPS_LHU,rb,rt,of)
+#  define LW(rt,of,rb)			hrri(MIPS_LW,rb,rt,of)
+#  define LWU(rt,of,rb)			hrri(MIPS_LWU,rb,rt,of)
+#  define LD(rt,of,rb)			hrri(MIPS_LD,rb,rt,of)
+#  define SB(rt,of,rb)			hrri(MIPS_SB,rb,rt,of)
+#  define SH(rt,of,rb)			hrri(MIPS_SH,rb,rt,of)
+#  define SW(rt,of,rb)			hrri(MIPS_SW,rb,rt,of)
+#  define SD(rt,of,rb)			hrri(MIPS_SD,rb,rt,of)
+#  define WSBH(rd,rt)			hrrrit(MIPS_SPECIAL3,0,rt,rd,MIPS_WSBH,MIPS_BSHFL)
+#  define SEB(rd,rt)			hrrrit(MIPS_SPECIAL3,0,rt,rd,MIPS_SEB,MIPS_BSHFL)
+#  define SEH(rd,rt)			hrrrit(MIPS_SPECIAL3,0,rt,rd,MIPS_SEH,MIPS_BSHFL)
+#  define SLT(rd,rs,rt)			rrr_t(rs,rt,rd,MIPS_SLT)
+#  define SLTU(rd,rs,rt)		rrr_t(rs,rt,rd,MIPS_SLTU)
+#  define SLTI(rt,rs,im)		hrri(MIPS_SLTI,rs,rt,im)
+#  define SLTIU(rt,rs,im)		hrri(MIPS_SLTIU,rs,rt,im)
+#  define BLTZ(rs,im)			hrri(MIPS_REGIMM,rs,MIPS_BLTZ,im)
+#  define BLEZ(rs,im)			hrri(MIPS_BLEZ,rs,_ZERO_REGNO,im)
+#  define BEQ(rs,rt,im)			hrri(MIPS_BEQ,rs,rt,im)
+#  define BGEZ(rs,im)			hrri(MIPS_REGIMM,rs,MIPS_BGEZ,im)
+#  define BGTZ(rs,im)			hrri(MIPS_BGTZ,rs,_ZERO_REGNO,im)
+#  define BNE(rs,rt,im)			hrri(MIPS_BNE,rs,rt,im)
+#  define JALR(r0)			hrrrit(MIPS_SPECIAL,r0,0,_RA_REGNO,0,MIPS_JALR)
+#  define JR(r0)			hrrrit(MIPS_SPECIAL,r0,0,0,0,MIPS_JR)
+#  define J(i0)				hi(MIPS_J,i0)
+#  define MOVZ(rd,rs,rt)		hrrrit(0,rs,rt,rd,0,MIPS_MOVZ)
+#  define comr(r0,r1)			xori(r0,r1,-1)
+#  define negr(r0,r1)			subr(r0,_ZERO_REGNO,r1)
+#  if __WORDSIZE == 32
+#    define addr(rd,rs,rt)		ADDU(rd,rs,rt)
+#    define addiu(r0,r1,i0)		ADDIU(r0,r1,i0)
+#    define subr(rd,rs,rt)		SUBU(rd,rs,rt)
+#    define mult(rs,rt)			MULT(rs,rt)
+#    define multu(rs,rt)		MULTU(rs,rt)
+#    define div(rs,rt)			DIV(rs,rt)
+#    define divu(rs,rt)			DIVU(rs,rt)
+#  else
+#    define addr(rd,rs,rt)		DADDU(rd,rs,rt)
+#    define addiu(r0,r1,i0)		DADDIU(r0,r1,i0)
+#    define subr(rd,rs,rt)		DSUBU(rd,rs,rt)
+#    define mult(rs,rt)			DMULT(rs,rt)
+#    define multu(rs,rt)		DMULTU(rs,rt)
+#    define div(rs,rt)			DDIV(rs,rt)
+#    define divu(rs,rt)			DDIVU(rs,rt)
+#  endif
+#  define addi(r0,r1,i0)		_addi(_jit,r0,r1,i0)
+static void _addi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define addcr(r0,r1,r2)			_addcr(_jit,r0,r1,r2)
+static void _addcr(jit_state_t*,int32_t,int32_t,int32_t);
+#define addci(r0,r1,i0)			_addci(_jit,r0,r1,i0)
+static void _addci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define addxr(r0,r1,r2)		_addxr(_jit,r0,r1,r2)
+static void _addxr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addxi(r0,r1,i0)		_addxi(_jit,r0,r1,i0)
+static void _addxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subi(r0,r1,i0)		_subi(_jit,r0,r1,i0)
+static void _subi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subcr(r0,r1,r2)		_subcr(_jit,r0,r1,r2)
+static void _subcr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subci(r0,r1,i0)		_subci(_jit,r0,r1,i0)
+static void _subci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subxr(r0,r1,r2)		_subxr(_jit,r0,r1,r2)
+static void _subxr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subxi(r0,r1,i0)		_subxi(_jit,r0,r1,i0)
+static void _subxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define rsbi(r0, r1, i0)		_rsbi(_jit, r0, r1, i0)
+static void _rsbi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define mulr(r0,r1,r2)		_mulr(_jit,r0,r1,r2)
+static void _mulr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define muli(r0,r1,i0)		_muli(_jit,r0,r1,i0)
+static void _muli(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qmulr(r0,r1,r2,r3)		iqmulr(r0,r1,r2,r3,1)
+#  define qmulr_u(r0,r1,r2,r3)		iqmulr(r0,r1,r2,r3,0)
+#  define iqmulr(r0,r1,r2,r3,cc)	_iqmulr(_jit,r0,r1,r2,r3,cc)
+static void _iqmulr(jit_state_t*,int32_t,int32_t,
+		    int32_t,int32_t,jit_bool_t);
+#  define qmuli(r0,r1,r2,i0)		iqmuli(r0,r1,r2,i0,1)
+#  define qmuli_u(r0,r1,r2,i0)		iqmuli(r0,r1,r2,i0,0)
+#  define iqmuli(r0,r1,r2,i0,cc)	_iqmuli(_jit,r0,r1,r2,i0,cc)
+static void _iqmuli(jit_state_t*,int32_t,int32_t,
+		    int32_t,jit_word_t,jit_bool_t);
+#  define divr(r0,r1,r2)		_divr(_jit,r0,r1,r2)
+static void _divr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi(r0,r1,i0)		_divi(_jit,r0,r1,i0)
+static void _divi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define divr_u(r0,r1,r2)		_divr_u(_jit,r0,r1,r2)
+static void _divr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi_u(r0,r1,i0)		_divi_u(_jit,r0,r1,i0)
+static void _divi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qdivr(r0,r1,r2,r3)		iqdivr(r0,r1,r2,r3,1)
+#  define qdivr_u(r0,r1,r2,r3)		iqdivr(r0,r1,r2,r3,0)
+#  define iqdivr(r0,r1,r2,r3,cc)	_iqdivr(_jit,r0,r1,r2,r3,cc)
+static void _iqdivr(jit_state_t*,int32_t,int32_t,
+		    int32_t,int32_t,jit_bool_t);
+#  define qdivi(r0,r1,r2,i0)		iqdivi(r0,r1,r2,i0,1)
+#  define qdivi_u(r0,r1,r2,i0)		iqdivi(r0,r1,r2,i0,0)
+#  define iqdivi(r0,r1,r2,i0,cc)	_iqdivi(_jit,r0,r1,r2,i0,cc)
+static void _iqdivi(jit_state_t*,int32_t,int32_t,
+		    int32_t,jit_word_t,jit_bool_t);
+#  define remr(r0,r1,r2)		_remr(_jit,r0,r1,r2)
+static void _remr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi(r0,r1,i0)		_remi(_jit,r0,r1,i0)
+static void _remi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define remr_u(r0,r1,r2)		_remr_u(_jit,r0,r1,r2)
+static void _remr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi_u(r0,r1,i0)		_remi_u(_jit,r0,r1,i0)
+static void _remi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define lshr(r0,r1,r2)		SLLV(r0,r1,r2)
+#    define lshi(r0,r1,i0)		SLL(r0,r1,i0)
+#    define rshr(r0,r1,r2)		SRAV(r0,r1,r2)
+#    define rshi(r0,r1,i0)		SRA(r0,r1,i0)
+#    define rshr_u(r0,r1,r2)		SRLV(r0,r1,r2)
+#    define rshi_u(r0,r1,i0)		SRL(r0,r1,i0)
+#  else
+#    define lshr(r0,r1,r2)		DSLLV(r0,r1,r2)
+#    define lshi(r0,r1,i0)		_lshi(_jit,r0,r1,i0)
+static void _lshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#    define rshr(r0,r1,r2)		DSRAV(r0,r1,r2)
+#    define rshi(r0,r1,i0)		_rshi(_jit,r0,r1,i0)
+static void _rshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#    define rshr_u(r0,r1,r2)		DSRLV(r0,r1,r2)
+#    define rshi_u(r0,r1,i0)		_rshi_u(_jit,r0,r1,i0)
+static void _rshi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  endif
+#  define andr(r0,r1,r2)		AND(r0,r1,r2)
+#  define andi(r0,r1,i0)		_andi(_jit,r0,r1,i0)
+static void _andi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define orr(r0,r1,r2)			OR(r0,r1,r2)
+#  define ori(r0,r1,i0)			_ori(_jit,r0,r1,i0)
+static void _ori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define xorr(r0,r1,r2)		XOR(r0,r1,r2)
+#  define xori(r0,r1,i0)		_xori(_jit,r0,r1,i0)
+static void _xori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define movr(r0,r1)			orr(r0,r1,_ZERO_REGNO)
+#  define movi(r0,i0)			_movi(_jit,r0,i0)
+static void _movi(jit_state_t*,int32_t,jit_word_t);
+#  define movi_p(r0,i0)			_movi_p(_jit,r0,i0)
+static jit_word_t _movi_p(jit_state_t*,int32_t,jit_word_t);
+#  define ldr_c(r0,r1)			LB(r0,0,r1)
+#  define ldi_c(r0,i0)			_ldi_c(_jit,r0,i0)
+static void _ldi_c(jit_state_t*,int32_t,jit_word_t);
+#  define ldr_uc(r0,r1)			LBU(r0,0,r1)
+#  define ldi_uc(r0,i0)			_ldi_uc(_jit,r0,i0)
+static void _ldi_uc(jit_state_t*,int32_t,jit_word_t);
+#  define ldr_s(r0,r1)			LH(r0,0,r1)
+#  define ldi_s(r0,i0)			_ldi_s(_jit,r0,i0)
+static void _ldi_s(jit_state_t*,int32_t,jit_word_t);
+#  define ldr_us(r0,r1)			LHU(r0,0,r1)
+#  define ldi_us(r0,i0)			_ldi_us(_jit,r0,i0)
+static void _ldi_us(jit_state_t*,int32_t,jit_word_t);
+#  define ldr_i(r0,r1)			LW(r0,0,r1)
+#  define ldi_i(r0,i0)			_ldi_i(_jit,r0,i0)
+static void _ldi_i(jit_state_t*,int32_t,jit_word_t);
+#  if __WORDSIZE == 64
+#    define ldr_ui(r0,r1)		LWU(r0,0,r1)
+#    define ldi_ui(r0,i0)		_ldi_ui(_jit,r0,i0)
+static void _ldi_ui(jit_state_t*,int32_t,jit_word_t);
+#    define ldr_l(r0,r1)		LD(r0,0,r1)
+#    define ldi_l(r0,i0)		_ldi_l(_jit,r0,i0)
+static void _ldi_l(jit_state_t*,int32_t,jit_word_t);
+#  endif
+#  define ldxr_c(r0,r1,r2)		_ldxr_c(_jit,r0,r1,r2)
+static void _ldxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_c(r0,r1,i0)		_ldxi_c(_jit,r0,r1,i0)
+static void _ldxi_c(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldxr_uc(r0,r1,r2)		_ldxr_uc(_jit,r0,r1,r2)
+static void _ldxr_uc(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_uc(r0,r1,i0)		_ldxi_uc(_jit,r0,r1,i0)
+static void _ldxi_uc(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldxr_s(r0,r1,r2)		_ldxr_s(_jit,r0,r1,r2)
+static void _ldxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_s(r0,r1,i0)		_ldxi_s(_jit,r0,r1,i0)
+static void _ldxi_s(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldxr_us(r0,r1,r2)		_ldxr_us(_jit,r0,r1,r2)
+static void _ldxr_us(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_us(r0,r1,i0)		_ldxi_us(_jit,r0,r1,i0)
+static void _ldxi_us(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldxr_i(r0,r1,r2)		_ldxr_i(_jit,r0,r1,r2)
+static void _ldxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_i(r0,r1,i0)		_ldxi_i(_jit,r0,r1,i0)
+static void _ldxi_i(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 64
+#    define ldxr_ui(r0,r1,r2)		_ldxr_ui(_jit,r0,r1,r2)
+static void _ldxr_ui(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_ui(r0,r1,i0)		_ldxi_ui(_jit,r0,r1,i0)
+static void _ldxi_ui(jit_state_t*,int32_t,int32_t,jit_word_t);
+#    define ldxr_l(r0,r1,r2)		_ldxr_l(_jit,r0,r1,r2)
+static void _ldxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_l(r0,r1,i0)		_ldxi_l(_jit,r0,r1,i0)
+static void _ldxi_l(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  endif
+#  define str_c(r0,r1)			SB(r1,0,r0)
+#  define sti_c(i0,r0)			_sti_c(_jit,i0,r0)
+static void _sti_c(jit_state_t*,jit_word_t,int32_t);
+#  define str_s(r0,r1)			SH(r1,0,r0)
+#  define sti_s(i0,r0)			_sti_s(_jit,i0,r0)
+static void _sti_s(jit_state_t*,jit_word_t,int32_t);
+#  define str_i(r0,r1)			SW(r1,0,r0)
+#  define sti_i(i0,r0)			_sti_i(_jit,i0,r0)
+static void _sti_i(jit_state_t*,jit_word_t,int32_t);
+#  if __WORDSIZE == 64
+#    define str_l(r0,r1)		SD(r1,0,r0)
+#    define sti_l(i0,r0)		_sti_l(_jit,i0,r0)
+static void _sti_l(jit_state_t*,jit_word_t,int32_t);
+#  endif
+#  define stxr_c(r0,r1,r2)		_stxr_c(_jit,r0,r1,r2)
+static void _stxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_c(i0,r0,r1)		_stxi_c(_jit,i0,r0,r1)
+static void _stxi_c(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define stxr_s(r0,r1,r2)		_stxr_s(_jit,r0,r1,r2)
+static void _stxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_s(i0,r0,r1)		_stxi_s(_jit,i0,r0,r1)
+static void _stxi_s(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define stxr_i(r0,r1,r2)		_stxr_i(_jit,r0,r1,r2)
+static void _stxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_i(i0,r0,r1)		_stxi_i(_jit,i0,r0,r1)
+static void _stxi_i(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  if __WORDSIZE == 64
+#    define stxr_l(r0,r1,r2)		_stxr_l(_jit,r0,r1,r2)
+static void _stxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#    define stxi_l(i0,r0,r1)		_stxi_l(_jit,i0,r0,r1)
+static void _stxi_l(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  endif
+#  if __BYTE_ORDER == __LITTLE_ENDIAN
+#    define bswapr_us(r0,r1)		_bswapr_us(_jit,r0,r1)
+static void _bswapr_us(jit_state_t*,int32_t,int32_t);
+#    define bswapr_ui(r0,r1)		_bswapr_ui(_jit,r0,r1)
+static void _bswapr_ui(jit_state_t*,int32_t,int32_t);
+#    if __WORDSIZE == 64
+#      define bswapr_ul(r0,r1)		_bswapr_ul(_jit,r0,r1)
+static void _bswapr_ul(jit_state_t*,int32_t,int32_t);
+#    endif
+#  else
+#    define bswapr_us(r0,r1)		extr_us(r0,r1)
+#    if __WORDSIZE == 32
+#      define bswapr_ui(r0,r1)		movr(r0,r1)
+#    else
+#      define bswapr_ui(r0,r1)		extr_ui(r0,r1)
+#      define bswapr_ul(r0,r1)		movr(r0,r1)
+#    endif
+#  endif
+#  define extr_c(r0,r1)			_extr_c(_jit,r0,r1)
+static void _extr_c(jit_state_t*,int32_t,int32_t);
+#  define extr_uc(r0,r1)		ANDI(r0,r1,0xff)
+#  define extr_s(r0,r1)			_extr_s(_jit,r0,r1)
+static void _extr_s(jit_state_t*,int32_t,int32_t);
+#  define extr_us(r0,r1)		ANDI(r0,r1,0xffff)
+#  if __WORDSIZE == 64
+#    define extr_i(r0,r1)		SLL(r0,r1,0)
+#    define extr_ui(r0,r1)		_extr_ui(_jit,r0,r1)
+static void _extr_ui(jit_state_t*,int32_t,int32_t);
+#  endif
+#  define ltr(r0,r1,r2)			SLT(r0,r1,r2)
+#  define lti(r0,r1,i0)			_lti(_jit,r0,r1,i0)
+static void _lti(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ltr_u(r0,r1,r2)		SLTU(r0,r1,r2)
+#  define lti_u(r0,r1,i0)		_lti_u(_jit,r0,r1,i0)
+static void _lti_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define ler(r0,r1,r2)			_ler(_jit,r0,r1,r2)
+static void _ler(jit_state_t*,int32_t,int32_t,int32_t);
+#define lei(r0,r1,i0)			_lei(_jit,r0,r1,i0)
+static void _lei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define ler_u(r0,r1,r2)			_ler_u(_jit,r0,r1,r2)
+static void _ler_u(jit_state_t*,int32_t,int32_t,int32_t);
+#define lei_u(r0,r1,i0)			_lei_u(_jit,r0,r1,i0)
+static void _lei_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define eqr(r0,r1,r2)			_eqr(_jit,r0,r1,r2)
+static void _eqr(jit_state_t*,int32_t,int32_t,int32_t);
+#define eqi(r0,r1,i0)			_eqi(_jit,r0,r1,i0)
+static void _eqi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define ger(r0,r1,r2)			_ger(_jit,r0,r1,r2)
+static void _ger(jit_state_t*,int32_t,int32_t,int32_t);
+#define gei(r0,r1,i0)			_gei(_jit,r0,r1,i0)
+static void _gei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define ger_u(r0,r1,i0)			_ger_u(_jit,r0,r1,i0)
+static void _ger_u(jit_state_t*,int32_t,int32_t,int32_t);
+#define gei_u(r0,r1,i0)			_gei_u(_jit,r0,r1,i0)
+static void _gei_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define gtr(r0,r1,r2)			SLT(r0,r2,r1)
+#define gti(r0,r1,i0)			_gti(_jit,r0,r1,i0)
+static void _gti(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define gtr_u(r0,r1,r2)		SLTU(r0,r2,r1)
+#  define gti_u(r0,r1,i0)		_gti_u(_jit,r0,r1,i0)
+static void _gti_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define ner(r0,r1,r2)			_ner(_jit,r0,r1,r2)
+static void _ner(jit_state_t*,int32_t,int32_t,int32_t);
+#define nei(r0,r1,i0)			_nei(_jit,r0,r1,i0)
+static void _nei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define bltr(i0,r0,r1)			_bltr(_jit,i0,r0,r1)
+static jit_word_t _bltr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bltr_u(i0,r0,r1)		_bltr_u(_jit,i0,r0,r1)
+static jit_word_t _bltr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blti(i0,r0,i1)			_blti(_jit,i0,r0,i1)
+static jit_word_t _blti(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define blti_u(i0,r0,i1)		_blti_u(_jit,i0,r0,i1)
+static jit_word_t _blti_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bler(i0,r0,r1)			_bler(_jit,i0,r0,r1)
+static jit_word_t _bler(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bler_u(i0,r0,r1)		_bler_u(_jit,i0,r0,r1)
+static jit_word_t _bler_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blei(i0,r0,i1)			_blei(_jit,i0,r0,i1)
+static jit_word_t _blei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define blei_u(i0,r0,i1)		_blei_u(_jit,i0,r0,i1)
+static jit_word_t _blei_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define beqr(i0,r0,r1)			_beqr(_jit,i0,r0,r1)
+static jit_word_t _beqr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define beqi(i0,r0,i1)			_beqi(_jit,i0,r0,i1)
+static jit_word_t _beqi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bger(i0,r0,r1)			_bger(_jit,i0,r0,r1)
+static jit_word_t _bger(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bger_u(i0,r0,r1)		_bger_u(_jit,i0,r0,r1)
+static jit_word_t _bger_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgei(i0,r0,i1)			_bgei(_jit,i0,r0,i1)
+static jit_word_t _bgei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bgei_u(i0,r0,i1)		_bgei_u(_jit,i0,r0,i1)
+static jit_word_t _bgei_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bgtr(i0,r0,r1)			_bgtr(_jit,i0,r0,r1)
+static jit_word_t _bgtr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgtr_u(i0,r0,r1)		_bgtr_u(_jit,i0,r0,r1)
+static jit_word_t _bgtr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgti(i0,r0,i1)			_bgti(_jit,i0,r0,i1)
+static jit_word_t _bgti(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bgti_u(i0,r0,i1)		_bgti_u(_jit,i0,r0,i1)
+static jit_word_t _bgti_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bner(i0,r0,r1)			_bner(_jit,i0,r0,r1)
+static jit_word_t _bner(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bnei(i0,r0,i1)			_bnei(_jit,i0,r0,i1)
+static jit_word_t _bnei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define jmpr(r0)			_jmpr(_jit,r0)
+static void _jmpr(jit_state_t*,int32_t);
+#  define jmpi(i0)			_jmpi(_jit,i0)
+static jit_word_t _jmpi(jit_state_t*,jit_word_t);
+#  define boaddr(i0,r0,r1)		_boaddr(_jit,i0,r0,r1)
+static jit_word_t _boaddr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define boaddi(i0,r0,i1)		_boaddi(_jit,i0,r0,i1)
+static jit_word_t _boaddi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define boaddr_u(i0,r0,r1)		_boaddr_u(_jit,i0,r0,r1)
+static jit_word_t _boaddr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define boaddi_u(i0,r0,i1)		_boaddi_u(_jit,i0,r0,i1)
+static jit_word_t _boaddi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bxaddr(i0,r0,r1)		_bxaddr(_jit,i0,r0,r1)
+static jit_word_t _bxaddr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bxaddi(i0,r0,i1)		_bxaddi(_jit,i0,r0,i1)
+static jit_word_t _bxaddi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bxaddr_u(i0,r0,r1)		_bxaddr_u(_jit,i0,r0,r1)
+static jit_word_t _bxaddr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bxaddi_u(i0,r0,i1)		_bxaddi_u(_jit,i0,r0,i1)
+static jit_word_t _bxaddi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bosubr(i0,r0,r1)		_bosubr(_jit,i0,r0,r1)
+static jit_word_t _bosubr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bosubi(i0,r0,i1)		_bosubi(_jit,i0,r0,i1)
+static jit_word_t _bosubi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bosubr_u(i0,r0,r1)		_bosubr_u(_jit,i0,r0,r1)
+static jit_word_t _bosubr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bosubi_u(i0,r0,i1)		_bosubi_u(_jit,i0,r0,i1)
+static jit_word_t _bosubi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bxsubr(i0,r0,r1)		_bxsubr(_jit,i0,r0,r1)
+static jit_word_t _bxsubr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bxsubi(i0,r0,i1)		_bxsubi(_jit,i0,r0,i1)
+static jit_word_t _bxsubi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bxsubr_u(i0,r0,r1)		_bxsubr_u(_jit,i0,r0,r1)
+static jit_word_t _bxsubr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bxsubi_u(i0,r0,i1)		_bxsubi_u(_jit,i0,r0,i1)
+static jit_word_t _bxsubi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bmsr(i0,r0,r1)		_bmsr(_jit,i0,r0,r1)
+static jit_word_t _bmsr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bmsi(i0,r0,i1)		_bmsi(_jit,i0,r0,i1)
+static jit_word_t _bmsi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define bmcr(i0,r0,r1)		_bmcr(_jit,i0,r0,r1)
+static jit_word_t _bmcr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bmci(i0,r0,i1)		_bmci(_jit,i0,r0,i1)
+static jit_word_t _bmci(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define callr(r0)			_callr(_jit,r0)
+static void _callr(jit_state_t*,int32_t);
+#  define calli(i0)			_calli(_jit,i0)
+static void _calli(jit_state_t*,jit_word_t);
+#  define calli_p(i0)			_calli_p(_jit,i0)
+static jit_word_t _calli_p(jit_state_t*,jit_word_t);
+#  define prolog(node)			_prolog(_jit,node)
+static void _prolog(jit_state_t*,jit_node_t*);
+#  define epilog(node)			_epilog(_jit,node)
+static void _epilog(jit_state_t*,jit_node_t*);
+#  define vastart(r0)			_vastart(_jit, r0)
+static void _vastart(jit_state_t*, int32_t);
+#  define vaarg(r0, r1)			_vaarg(_jit, r0, r1)
+static void _vaarg(jit_state_t*, int32_t, int32_t);
+#define patch_abs(instr,label)		_patch_abs(_jit,instr,label)
+static void _patch_abs(jit_state_t*,jit_word_t,jit_word_t);
+#define patch_at(jump,label)		_patch_at(_jit,jump,label)
+static void _patch_at(jit_state_t*,jit_word_t,jit_word_t);
+#endif
+
+#if CODE
+static void
+_hrrrit(jit_state_t *_jit,int32_t hc,
+	int32_t rs, int32_t rt, int32_t rd,
+	int32_t ic, int32_t tc)
+{
+    jit_instr_t		i;
+    i.tc.b = tc;
+    i.ic.b = ic;
+    i.rd.b = rd;
+    i.rt.b = rt;
+    i.rs.b = rs;
+    i.hc.b = hc;
+    ii(i.op);
+}
+
+static void
+_hrri(jit_state_t *_jit, int32_t hc,
+      int32_t rs, int32_t rt, int32_t im)
+{
+    jit_instr_t		i;
+    i.op = 0;
+    i.is.b = im;
+    i.rt.b = rt;
+    i.rs.b = rs;
+    i.hc.b = hc;
+    ii(i.op);
+}
+
+static void
+_hi(jit_state_t *_jit, int32_t hc, int32_t im)
+{
+    jit_instr_t		i;
+    i.ii.b = im;
+    i.hc.b = hc;
+    ii(i.op);
+}
+
+static void
+_nop(jit_state_t *_jit, int32_t i0)
+{
+    for (; i0 > 0; i0 -= 4)
+	NOP();
+    assert(i0 == 0);
+}
+
+static void
+_addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	movr(r0, r1);
+    else if (can_sign_extend_short_p(i0))
+	addiu(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	addr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_addcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		t0;
+
+    if (jit_carry == _NOREG)
+	jit_carry = jit_get_reg(jit_class_gpr);
+    if (r0 == r1) {
+	t0 = jit_get_reg(jit_class_gpr);
+	addr(rn(t0), r1, r2);
+	SLTU(rn(jit_carry), rn(t0), r1);
+	movr(r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    else {
+	addr(r0, r1, r2);
+	SLTU(rn(jit_carry), r0, r1);
+    }
+}
+
+static void
+_addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		t0;
+
+    if (jit_carry == _NOREG)
+	jit_carry = jit_get_reg(jit_class_gpr);
+    t0 = jit_get_reg(jit_class_gpr);
+    if (r0 == r1) {
+	if (can_sign_extend_short_p(i0))
+	    addiu(rn(t0), r1, i0);
+	else {
+	    movi(rn(t0), i0);
+	    addr(rn(t0), r1, rn(t0));
+	}
+	SLTU(rn(jit_carry), rn(t0), r1);
+	movr(r0, rn(t0));
+    }
+    else {
+	if (can_sign_extend_short_p(i0))
+	    addiu(r0, r1, i0);
+	else {
+	    movi(rn(t0), i0);
+	    addr(r0, r1, rn(t0));
+	}
+	SLTU(rn(jit_carry), r0, r1);
+    }
+    jit_unget_reg(t0);
+}
+
+static void
+_addxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		t0;
+
+    assert(jit_carry != _NOREG);
+    t0 = jit_get_reg(jit_class_gpr);
+    movr(rn(t0), rn(jit_carry));
+    addcr(r0, r1, r2);
+    addcr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		t0;
+
+    assert(jit_carry != _NOREG);
+    t0 = jit_get_reg(jit_class_gpr);
+    movr(rn(t0), rn(jit_carry));
+    addci(r0, r1, i0);
+    addcr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	movr(r0, r1);
+    else if (can_sign_extend_short_p(i0) && (i0 & 0xffff) != 0x8000)
+	addiu(r0, r1, -i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	subr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_subcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		t0;
+
+    if (jit_carry == _NOREG)
+	jit_carry = jit_get_reg(jit_class_gpr);
+    if (r0 == r1) {
+	t0 = jit_get_reg(jit_class_gpr);
+	subr(rn(t0), r1, r2);
+	SLTU(rn(jit_carry), r1, rn(t0));
+	movr(r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    else {
+	subr(r0, r1, r2);
+	SLTU(rn(jit_carry), r1, r0);
+    }
+}
+
+static void
+_subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		t0;
+
+    if (jit_carry == _NOREG)
+	jit_carry = jit_get_reg(jit_class_gpr);
+    t0 = jit_get_reg(jit_class_gpr);
+    if (r0 == r1) {
+	if (can_sign_extend_short_p(i0) && (i0 & 0xffff) != 0x8000)
+	    addiu(rn(t0), r1, -i0);
+	else {
+	    movi(rn(t0), i0);
+	    subr(rn(t0), r1, rn(t0));
+	}
+	SLTU(rn(jit_carry), r1, rn(t0));
+	movr(r0, rn(t0));
+    }
+    else {
+	if (can_sign_extend_short_p(i0) && (i0 & 0xffff) != 0x8000)
+	    addiu(r0, r1, -i0);
+	else {
+	    movi(rn(t0), i0);
+	    subr(r0, r1, rn(t0));
+	}
+	SLTU(rn(jit_carry), r1, r0);
+    }
+    jit_unget_reg(t0);
+}
+
+static void
+_subxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		t0;
+
+    assert(jit_carry != _NOREG);
+    t0 = jit_get_reg(jit_class_gpr);
+    movr(rn(t0), rn(jit_carry));
+    subcr(r0, r1, r2);
+    subcr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		t0;
+
+    assert(jit_carry != _NOREG);
+    t0 = jit_get_reg(jit_class_gpr);
+    movr(rn(t0), rn(jit_carry));
+    subci(r0, r1, i0);
+    subcr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_rsbi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    subi(r0, r1, i0);
+    negr(r0, r0);
+}
+
+static void
+_mulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    multu(r1, r2);
+    MFLO(r0);
+}
+
+static void
+_muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    mulr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_iqmulr(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, int32_t r3, jit_bool_t sign)
+{
+    if (sign)
+	mult(r2, r3);
+    else
+	multu(r2, r3);
+    MFLO(r0);
+    MFHI(r1);
+}
+
+static void
+_iqmuli(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    iqmulr(r0, r1, r2, rn(reg), sign);
+    jit_unget_reg(reg);
+}
+
+static void
+_divr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    div(r1, r2);
+    MFLO(r0);
+}
+
+static void
+_divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    divr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_divr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    divu(r1, r2);
+    MFLO(r0);
+}
+
+static void
+_divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    divr_u(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_iqdivr(jit_state_t *_jit, int32_t r0, int32_t r1,
+       int32_t r2, int32_t r3, jit_bool_t sign)
+{
+    if (sign)
+	div(r2, r3);
+    else
+	divu(r2, r3);
+    MFLO(r0);
+    MFHI(r1);
+}
+
+static void
+_iqdivi(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    iqdivr(r0, r1, r2, rn(reg), sign);
+    jit_unget_reg(reg);
+}
+
+static void
+_remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    div(r1, r2);
+    MFHI(r0);
+}
+
+static void
+_remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    remr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    divu(r1, r2);
+    MFHI(r0);
+}
+
+static void
+_remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    remr_u(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+#if __WORDSIZE == 64
+static void
+_lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    assert(i0 >= 0 && i0 <= 63);
+    if (i0 < 32)
+	DSLL(r0, r1, i0);
+    else
+	DSLL32(r0, r1, i0 - 32);
+}
+
+static void
+_rshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    assert(i0 >= 0 && i0 <= 63);
+    if (i0 < 32)
+	DSRA(r0, r1, i0);
+    else
+	DSRA32(r0, r1, i0 - 32);
+}
+
+static void
+_rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    assert(i0 >= 0 && i0 <= 63);
+    if (i0 < 32)
+	DSRL(r0, r1, i0);
+    else
+	DSRL32(r0, r1, i0 - 32);
+}
+#endif
+
+static void
+_andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	ANDI(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	AND(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	ORI(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	OR(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	XORI(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	XOR(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    if (i0 == 0)
+	OR(r0, _ZERO_REGNO, _ZERO_REGNO);
+    else if (can_sign_extend_short_p(i0))
+	addiu(r0, _ZERO_REGNO, i0);
+    else if (can_zero_extend_short_p(i0))
+	ORI(r0, _ZERO_REGNO, i0);
+    else {
+	if (can_sign_extend_int_p(i0))
+	    LUI(r0, i0 >> 16);
+	else if (can_zero_extend_int_p(i0)) {
+	    if (i0 & 0xffff0000) {
+		ORI(r0, _ZERO_REGNO, i0 >> 16);
+		lshi(r0, r0, 16);
+	    }
+	}
+#  if __WORDSIZE == 64
+	else {
+	    movi(r0, (jit_uword_t)i0 >> 32);
+	    if (i0 & 0xffff0000) {
+		lshi(r0, r0, 16);
+		ORI(r0, r0, i0 >> 16);
+		lshi(r0, r0, 16);
+	    }
+	    else
+		lshi(r0, r0, 32);
+	}
+#  endif
+	if (i0 & 0xffff)
+	    ORI(r0, r0, i0);
+    }
+}
+
+static jit_word_t
+_movi_p(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_word_t		w;
+
+    w = _jit->pc.w;
+#  if __WORDSIZE == 32
+    LUI(r0, i0 >> 16);
+    ORI(r0, r0, i0);
+#  else
+    LUI(r0, i0 >> 48);
+    ORI(r0, r0, i0 >> 32);
+    lshi(r0, r0, 16);
+    ORI(r0, r0, i0 >> 16);
+    lshi(r0, r0, 16);
+    ORI(r0, r0, i0);
+#  endif
+
+    return (w);
+}
+
+static void
+_ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LB(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_c(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LBU(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_uc(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LH(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_s(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LHU(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_us(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LW(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_i(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_ldi_ui(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LWU(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_ui(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_l(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LD(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_l(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+#endif
+
+static void
+_ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_c(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LB(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_c(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_uc(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LBU(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_uc(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_s(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LH(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_s(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_us(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LHU(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_us(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_i(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LW(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_i(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_ldxr_ui(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_ui(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_ui(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LWU(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_ui(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_l(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_l(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_l(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LD(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_l(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+#endif
+
+static void
+_sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SB(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_c(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SH(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_s(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SW(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_i(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_sti_l(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SD(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_l(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+#endif
+
+static void
+_stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_c(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SB(r1, i0, r0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_c(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_s(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SH(r1, i0, r0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_s(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_i(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SW(r1, i0, r0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_i(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_stxr_l(jit_state_t *_jit, int32_t r0, int32_t r1 ,int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_l(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_l(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SD(r1, i0, r0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_l(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+#endif
+
+#  if __BYTE_ORDER == __LITTLE_ENDIAN
+static void
+_bswapr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr);
+    rshi(rn(t0), r1, 8);
+    andi(r0, r1, 0xff);
+    andi(rn(t0), rn(t0), 0xff);
+    lshi(r0, r0, 8);
+    orr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_bswapr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+    t0 = jit_get_reg(jit_class_gpr);
+    t1 = jit_get_reg(jit_class_gpr);
+    t2 = jit_get_reg(jit_class_gpr);
+    rshi(rn(t0), r1, 24);
+    rshi(rn(t1), r1, 16);
+    rshi(rn(t2), r1,  8);
+    andi(rn(t0), rn(t0), 0xff);
+    andi(rn(t1), rn(t1), 0xff);
+    andi(rn(t2), rn(t2), 0xff);
+    andi(r0, r1, 0xff);
+    lshi(r0, r0, 24);
+    lshi(rn(t1), rn(t1), 8);
+    orr(r0, r0, rn(t0));
+    lshi(rn(t2), rn(t2), 16);
+    orr(r0, r0, rn(t1));
+    orr(r0, r0, rn(t2));
+    jit_unget_reg(t2);
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+}
+
+static void
+_bswapr_ul(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    rshi_u(rn(reg), r1, 32);
+    bswapr_ui(r0, r1);
+    bswapr, 2019_ui(rn(reg), rn(reg));
+    lshi(r0, r0, 32);
+    orr(r0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+#  endif
+
+static void
+_extr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (jit_mips2_p())
+	SEB(r0, r1);
+    else {
+	lshi(r0, r1, __WORDSIZE - 8);
+	rshi(r0, r0, __WORDSIZE - 8);
+    }
+}
+
+static void
+_extr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (jit_mips2_p())
+	SEH(r0, r1);
+    else {
+	lshi(r0, r1, __WORDSIZE - 16);
+	rshi(r0, r0, __WORDSIZE - 16);
+    }
+}
+
+#  if __WORDSIZE == 64
+static void
+_extr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    lshi(r0, r1, 32);
+    rshi_u(r0, r0, 32);
+}
+#  endif
+
+static void
+_lti(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (can_sign_extend_short_p(i0))
+	SLTI(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ltr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_lti_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (can_sign_extend_short_p(i0))
+	SLTIU(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ltr_u(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ler(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    SLT(r0, r2, r1);
+    XORI(r0, r0, 1);
+}
+
+static void
+_lei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (i0 == 0) {
+	SLT(r0, _ZERO_REGNO, r1);
+	XORI(r0, r0, 1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ler(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ler_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    SLTU(r0, r2, r1);
+    XORI(r0, r0, 1);
+}
+
+static void
+_lei_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (i0 == 0) {
+	SLTU(r0, _ZERO_REGNO, r1);
+	XORI(r0, r0, 1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ler_u(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_eqr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    subr(r0, r1, r2);
+    SLTU(r0, _ZERO_REGNO, r0);
+    XORI(r0, r0, 1);
+}
+
+static void
+_eqi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    if (i0) {
+	subi(r0, r1, i0);
+	SLTU(r0, _ZERO_REGNO, r0);
+    }
+    else
+	SLTU(r0, _ZERO_REGNO, r1);
+    XORI(r0, r0, 1);
+}
+
+static void
+_ger(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    SLT(r0, r1, r2);
+    XORI(r0, r0, 1);
+}
+
+static void
+_gei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    ger(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ger_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    SLTU(r0, r1, r2);
+    XORI(r0, r0, 1);
+}
+
+static void
+_gei_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    ger_u(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_gti(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (i0 == 0)
+	SLT(r0, _ZERO_REGNO, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	SLT(r0, rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_gti_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+
+    if (i0 == 0)
+	SLTU(r0, _ZERO_REGNO, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	SLTU(r0, rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ner(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    subr(r0, r1, r2);
+    SLTU(r0, _ZERO_REGNO, r0);
+}
+
+static void
+_nei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    if (i0) {
+	subi(r0, r1, i0);
+	SLTU(r0, _ZERO_REGNO, r0);
+    }
+    else
+	SLTU(r0, _ZERO_REGNO, r1);
+}
+
+static jit_word_t
+_bltr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr);
+    SLT(rn(reg), r0, r1);
+    w = _jit->pc.w;
+    BNE(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bltr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLTU(rn(reg), r0, r1);
+    w = _jit->pc.w;
+    BNE(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_blti(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    jit_word_t		d;
+    int32_t		reg;
+    jit_bool_t		zero_p;
+
+    if (!(zero_p = i1 == 0))
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_sign_extend_short_p(i1)) {
+	if (!zero_p)
+	    SLTI(rn(reg), r0, i1);
+	w = _jit->pc.w;
+	d = ((i0 - w) >> 2) - 1;
+	if (!zero_p)
+	    BNE(rn(reg), _ZERO_REGNO, d);
+	else
+	    BLTZ(r0, d);
+	NOP(1);
+    }
+    else {
+	movi(rn(reg), i1);
+	w = bltr(i0, r0, rn(reg));
+    }
+    if (!zero_p)
+	jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_blti_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_sign_extend_short_p(i1)) {
+	SLTIU(rn(reg), r0, i1);
+	w = _jit->pc.w;
+	BNE(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	movi(rn(reg), i1);
+	w = bltr_u(i0, r0, rn(reg));
+    }
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bler(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(reg), r1, r0);
+    w = _jit->pc.w;
+    BEQ(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bler_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLTU(rn(reg), r1, r0);
+    w = _jit->pc.w;
+    BEQ(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_blei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BLEZ(r0, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = bler(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_blei_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BEQ(r0, _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = bler_u(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_beqr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+
+    w = _jit->pc.w;
+    BEQ(r0, r1, ((i0 - w) >> 2) - 1);
+    NOP(1);
+
+    return (w);
+}
+
+static jit_word_t
+_beqi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BEQ(r0, _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = beqr(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_bger(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(reg), r0, r1);
+    w = _jit->pc.w;
+    BEQ(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bger_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLTU(rn(reg), r0, r1);
+    w = _jit->pc.w;
+    BEQ(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bgei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    jit_word_t		d;
+    int32_t		reg;
+    jit_bool_t		zero_p;
+
+    if (!(zero_p = i1 == 0))
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_sign_extend_short_p(i1)) {
+	if (!zero_p)
+	    SLTI(rn(reg), r0, i1);
+	w = _jit->pc.w;
+	d = ((i0 - w) >> 2) - 1;
+	if (!zero_p)
+	    BEQ(rn(reg), _ZERO_REGNO, d);
+	else
+	    BGEZ(r0, d);
+	NOP(1);
+    }
+    else {
+	movi(rn(reg), i1);
+	w = bger(i0, r0, rn(reg));
+    }
+    if (!zero_p)
+	jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bgei_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_sign_extend_short_p(i1)) {
+	SLTIU(rn(reg), r0, i1);
+	w = _jit->pc.w;
+	BEQ(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	movi(rn(reg), i1);
+	w = bger_u(i0, r0, rn(reg));
+    }
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bgtr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(reg), r1, r0);
+    w = _jit->pc.w;
+    BNE(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bgtr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLTU(rn(reg), r1, r0);
+    w = _jit->pc.w;
+    BNE(rn(reg), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(reg);
+
+    return (w);
+}
+
+static jit_word_t
+_bgti(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BGTZ(r0, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = bgtr(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_bgti_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BNE(r0, _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = bgtr_u(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_bner(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+
+    w = _jit->pc.w;
+    BNE(r0, r1, ((i0 - w) >> 2) - 1);
+    NOP(1);
+
+    return (w);
+}
+
+static jit_word_t
+_bnei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    if (i1 == 0) {
+	w = _jit->pc.w;
+	BNE(r0, _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(reg), i1);
+	w = bner(i0, r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static void
+_jmpr(jit_state_t *_jit, int32_t r0)
+{
+    JR(r0);
+    NOP(1);
+}
+
+static jit_word_t
+_jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		w;
+    int32_t		reg;
+
+    w = _jit->pc.w;
+    if (((w + sizeof(int32_t)) & 0xf0000000) == (i0 & 0xf0000000)) {
+	J((i0 & ~0xf0000000) >> 2);
+	NOP(1);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi_p(rn(reg), i0);
+	jmpr(rn(reg));
+	jit_unget_reg(reg);
+    }
+
+    return (w);
+}
+
+static jit_word_t
+_boaddr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    /* t1 = r0 + r1;	overflow = r1 < 0 ? r0 < t1 : t1 < r0 */
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(t0), r1, _ZERO_REGNO);	/* t0 = r1 < 0 */
+    addr(rn(t1), r0, r1);		/* t1 = r0 + r1 */
+    SLT(rn(t2), rn(t1), r0);		/* t2 = t1 < r0 */
+    SLT(rn(t1), r0, rn(t1));		/* t1 = r0 < t1 */
+    MOVZ(rn(t1), rn(t2), rn(t0));	/* if (r0 == 0) t1 = t2 */
+    w = _jit->pc.w;
+    BNE(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    addr(r0, r0, r1);
+    jit_unget_reg(t2);
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+
+    return (w);
+}
+
+static jit_word_t
+_boaddi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    if (can_sign_extend_short_p(i1)) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	SLTI(rn(t0), _ZERO_REGNO, i1);
+	addiu(rn(t1), r0, i1);
+	SLT(rn(t2), r0, rn(t1));
+	SLT(rn(t1), rn(t1), r0);
+	MOVZ(rn(t1), rn(t2), rn(t0));
+	w = _jit->pc.w;
+	BNE(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	addiu(r0, r0, i1);
+	jit_unget_reg(t2);
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr);
+	movi(rn(t0), i1);
+	w = boaddr(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_boaddr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    addr(rn(t0), r0, r1);
+    SLTU(rn(t1), rn(t0), r0);
+    w = _jit->pc.w;
+    BNE(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    movr(r0, rn(t0));
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_boaddi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    if (can_sign_extend_short_p(i0)) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	addiu(rn(t0), r0, i1);
+	SLTU(rn(t1), rn(t0), r0);
+	w = _jit->pc.w;
+	BNE(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	movr(r0, rn(t0));
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = boaddr_u(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bxaddr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    /* t1 = r0 + r1;	overflow = r1 < 0 ? r0 < t1 : t1 < r0 */
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(t0), r1, _ZERO_REGNO);	/* t0 = r1 < 0 */
+    addr(rn(t1), r0, r1);		/* t1 = r0 + r1 */
+    SLT(rn(t2), rn(t1), r0);		/* t2 = t1 < r0 */
+    SLT(rn(t1), r0, rn(t1));		/* t1 = r0 < t1 */
+    MOVZ(rn(t1), rn(t2), rn(t0));	/* if (r0 == 0) t1 = t2 */
+    w = _jit->pc.w;
+    BEQ(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    addr(r0, r0, r1);
+    jit_unget_reg(t2);
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+
+    return (w);
+}
+
+static jit_word_t
+_bxaddi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    if (can_sign_extend_short_p(i1)) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	SLTI(rn(t0), _ZERO_REGNO, i1);
+	addiu(rn(t1), r0, i1);
+	SLT(rn(t2), r0, rn(t1));
+	SLT(rn(t1), rn(t1), r0);
+	MOVZ(rn(t1), rn(t2), rn(t0));
+	w = _jit->pc.w;
+	BEQ(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	addiu(r0, r0, i1);
+	jit_unget_reg(t2);
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bxaddr(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bxaddr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    addr(rn(t0), r0, r1);
+    SLTU(rn(t1), rn(t0), r0);
+    w = _jit->pc.w;
+    BEQ(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    movr(r0, rn(t0));
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bxaddi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    if (can_sign_extend_short_p(i0)) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	addiu(rn(t0), r0, i1);
+	SLTU(rn(t1), rn(t0), r0);
+	w = _jit->pc.w;
+	BEQ(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	movr(r0, rn(t0));
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bxaddr_u(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bosubr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    /* t1 = r0 - r1;	overflow = 0 < r1 ? r0 < t1 : t1 < r0 */
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(t0), _ZERO_REGNO, r1);	/* t0 = 0 < r1 */
+    subr(rn(t1), r0, r1);		/* t1 = r0 - r1 */
+    SLT(rn(t2), rn(t1), r0);		/* t2 = t1 < r0 */
+    SLT(rn(t1), r0, rn(t1));		/* t1 = r0 < t1 */
+    MOVZ(rn(t1), rn(t2), rn(t0));	/* if (r0 == 0) t1 = t2 */
+    w = _jit->pc.w;
+    BNE(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    subr(r0, r0, r1);
+    jit_unget_reg(t2);
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+
+    return (w);
+}
+
+static jit_word_t
+_bosubi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    if (can_sign_extend_short_p(i1) && (i1 & 0xffff) != 0x8000) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	SLTI(rn(t0), _ZERO_REGNO, i1);
+	addiu(rn(t1), r0, -i1);
+	SLT(rn(t2), rn(t1), r0);
+	SLT(rn(t1), r0, rn(t1));
+	MOVZ(rn(t1), rn(t2), rn(t0));
+	w = _jit->pc.w;
+	BNE(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	addiu(r0, r0, -i1);
+	jit_unget_reg(t2);
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bosubr(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bosubr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    subr(rn(t0), r0, r1);
+    SLTU(rn(t1), r0, rn(t0));
+    w = _jit->pc.w;
+    BNE(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    movr(r0, rn(t0));
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bosubi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    if (can_sign_extend_short_p(i0) && (i0 & 0xffff) != 0x8000) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	addiu(rn(t0), r0, -i1);
+	SLTU(rn(t1), r0, rn(t0));
+	w = _jit->pc.w;
+	BNE(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	movr(r0, rn(t0));
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bosubr_u(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bxsubr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    /* t1 = r0 - r1;	overflow = 0 < r1 ? r0 < t1 : t1 < r0 */
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    SLT(rn(t0), _ZERO_REGNO, r1);	/* t0 = 0 < r1 */
+    subr(rn(t1), r0, r1);		/* t1 = r0 - r1 */
+    SLT(rn(t2), rn(t1), r0);		/* t2 = t1 < r0 */
+    SLT(rn(t1), r0, rn(t1));		/* t1 = r0 < t1 */
+    MOVZ(rn(t1), rn(t2), rn(t0));	/* if (t0 == 0) t1 = t2 */
+    w = _jit->pc.w;
+    BEQ(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    subr(r0, r0, r1);
+    jit_unget_reg(t2);
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+
+    return (w);
+}
+
+static jit_word_t
+_bxsubi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+    int32_t		t2;
+
+    if (can_sign_extend_short_p(i1) && (i1 & 0xffff) != 0x8000) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t2 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	SLTI(rn(t0), _ZERO_REGNO, i1);
+	addiu(rn(t1), r0, -i1);
+	SLT(rn(t2), rn(t1), r0);
+	SLT(rn(t1), r0, rn(t1));
+	MOVZ(rn(t1), rn(t2), rn(t0));
+	w = _jit->pc.w;
+	BEQ(rn(t1), _ZERO_REGNO, ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	addiu(r0, r0, -i1);
+	jit_unget_reg(t2);
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bxsubr(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bxsubr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    subr(rn(t0), r0, r1);
+    SLTU(rn(t1), r0, rn(t0));
+    w = _jit->pc.w;
+    BEQ(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+    /* delay slot */
+    movr(r0, rn(t0));
+    jit_unget_reg(t1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bxsubi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    int32_t		t1;
+
+    if (can_sign_extend_short_p(i0) && (i0 & 0xffff) != 0x8000) {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	t1 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	addiu(rn(t0), r0, -i1);
+	SLTU(rn(t1), r0, rn(t0));
+	w = _jit->pc.w;
+	BEQ(_ZERO_REGNO, rn(t1), ((i0 - w) >> 2) - 1);
+	/* delay slot */
+	movr(r0, rn(t0));
+	jit_unget_reg(t1);
+	jit_unget_reg(t0);
+    }
+    else {
+	t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	movi(rn(t0), i1);
+	w = bxsubr_u(i0, r0, rn(t0));
+	jit_unget_reg(t0);
+    }
+    return (w);
+}
+
+static jit_word_t
+_bmsr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    AND(rn(t0), r0, r1);
+    w = _jit->pc.w;
+    BNE(_ZERO_REGNO, rn(t0), ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bmsi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_zero_extend_short_p(i1)) {
+	ANDI(rn(t0), r0, i1);
+	w = _jit->pc.w;
+	BNE(_ZERO_REGNO, rn(t0), ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	movi(rn(t0), i1);
+	w = bmsr(i0, r0, rn(t0));
+    }
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bmcr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    AND(rn(t0), r0, r1);
+    w = _jit->pc.w;
+    BEQ(_ZERO_REGNO, rn(t0), ((i0 - w) >> 2) - 1);
+    NOP(1);
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static jit_word_t
+_bmci(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    if (can_zero_extend_short_p(i1)) {
+	ANDI(rn(t0), r0, i1);
+	w = _jit->pc.w;
+	BEQ(_ZERO_REGNO, rn(t0), ((i0 - w) >> 2) - 1);
+	NOP(1);
+    }
+    else {
+	movi(rn(t0), i1);
+	w = bmcr(i0, r0, rn(t0));
+    }
+    jit_unget_reg(t0);
+    return (w);
+}
+
+static void
+_callr(jit_state_t *_jit, int32_t r0)
+{
+    if (r0 != _T9_REGNO)
+	movr(_T9_REGNO, r0);
+    JALR(r0);
+    NOP(1);
+}
+
+static void
+_calli(jit_state_t *_jit, jit_word_t i0)
+{
+    movi(_T9_REGNO, i0);
+    JALR(_T9_REGNO);
+    NOP(1);
+}
+
+static jit_word_t
+_calli_p(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		word;
+
+    word = _jit->pc.w;
+    movi_p(_T9_REGNO, i0);
+    JALR(_T9_REGNO);
+    NOP(1);
+
+    return (word);
+}
+
+static int32_t fregs[] = {
+    _F30, _F28, _F26, _F24, _F22, _F20,
+#if !NEW_ABI
+    _F18, _F16,
+#endif
+};
+
+static int32_t iregs[] = {
+    _S7, _S6, _S5, _S4, _S3, _S2, _S1, _S0,
+};
+
+static void
+_prolog(jit_state_t *_jit, jit_node_t *node)
+{
+    int32_t		index;
+    int32_t		offset;
+    if (_jitc->function->define_frame || _jitc->function->assume_frame) {
+	int32_t	frame = -_jitc->function->frame;
+	assert(_jitc->function->self.aoff >= frame);
+	if (_jitc->function->assume_frame)
+	    return;
+	_jitc->function->self.aoff = frame;
+    }
+    if (_jitc->function->allocar)
+	_jitc->function->self.aoff &= -8;
+#if NEW_ABI
+    _jitc->function->stack = ((_jitc->function->self.alen -
+			      /* align stack at 16 bytes */
+			       _jitc->function->self.aoff) + 15) & -16;
+#else
+    _jitc->function->stack = ((/* first 16 bytes must be allocated */
+			      (_jitc->function->self.alen > 16 ?
+			       _jitc->function->self.alen : 16) -
+			      /* align stack at 8 bytes */
+			      _jitc->function->self.aoff) + 7) & -8;
+#endif
+    /* callee save registers */
+#if NEW_ABI
+    if ((_jitc->function->self.call & jit_call_varargs) &&
+	jit_arg_reg_p(_jitc->function->vagp))
+	subi(_SP_REGNO, _SP_REGNO, stack_framesize + 64);
+    else
+#endif
+	subi(_SP_REGNO, _SP_REGNO, stack_framesize);
+    offset = stack_framesize - (sizeof(jit_word_t) << 1);
+    for (index = 0; index < jit_size(fregs); index++, offset -= 8) {
+	if (jit_regset_tstbit(&_jitc->function->regset, fregs[index]))
+	    stxi_d(offset, _SP_REGNO, rn(fregs[index]));
+    }
+    for (index = 0; index < jit_size(iregs);
+	 index++, offset -= sizeof(jit_word_t)) {
+	if (jit_regset_tstbit(&_jitc->function->regset, iregs[index]))
+	    stxi(offset, _SP_REGNO, rn(iregs[index]));
+    }
+    assert(offset >= sizeof(jit_word_t));
+    stxi(offset, _SP_REGNO, _RA_REGNO);
+    stxi(0, _SP_REGNO, _BP_REGNO);
+    movr(_BP_REGNO, _SP_REGNO);
+
+    /* alloca */
+    if (_jitc->function->stack)
+	subi(_SP_REGNO, _SP_REGNO, _jitc->function->stack);
+    if (_jitc->function->allocar) {
+	index = jit_get_reg(jit_class_gpr);
+	movi(rn(index), _jitc->function->self.aoff);
+	stxi_i(_jitc->function->aoffoff, _BP_REGNO, rn(index));
+	jit_unget_reg(index);
+    }
+
+    if (_jitc->function->self.call & jit_call_varargs) {
+#if NEW_ABI
+	index = _jitc->function->vagp;
+#else
+	index = (_jitc->function->self.size - stack_framesize) >> STACK_SHIFT;
+#endif
+	offset = stack_framesize + index * STACK_SLOT;
+	for (; jit_arg_reg_p(index); ++index, offset += STACK_SLOT) {
+#if NEW_ABI
+	    SD(rn(_A0 - index), offset, _BP_REGNO);
+#else
+	    stxi(offset +  WORD_ADJUST, _BP_REGNO, rn(_A0 - index));
+#endif
+	}
+    }
+}
+
+static void
+_epilog(jit_state_t *_jit, jit_node_t *node)
+{
+    int32_t		index;
+    int32_t		offset;
+    if (_jitc->function->assume_frame)
+	return;
+    /* callee save registers */
+    movr(_SP_REGNO, _BP_REGNO);
+    offset = stack_framesize - (sizeof(jit_word_t) << 1);
+    for (index = 0; index < jit_size(fregs); index++, offset -= 8) {
+	if (jit_regset_tstbit(&_jitc->function->regset, fregs[index]))
+	    ldxi_d(rn(fregs[index]), _SP_REGNO, offset);
+    }
+    for (index = 0; index < jit_size(iregs);
+	 index++, offset -= sizeof(jit_word_t)) {
+	if (jit_regset_tstbit(&_jitc->function->regset, iregs[index]))
+	    ldxi(rn(iregs[index]), _SP_REGNO, offset);
+    }
+    assert(offset >= sizeof(jit_word_t));
+    ldxi(_RA_REGNO, _SP_REGNO, offset);
+    ldxi(_BP_REGNO, _SP_REGNO, 0);
+    JR(_RA_REGNO);
+    /* delay slot */
+#if NEW_ABI
+    if ((_jitc->function->self.call & jit_call_varargs) &&
+	jit_arg_reg_p(_jitc->function->vagp))
+	addi(_SP_REGNO, _SP_REGNO, stack_framesize + 64);
+    else
+#endif
+	addi(_SP_REGNO, _SP_REGNO, stack_framesize);
+}
+
+static void
+_vastart(jit_state_t *_jit, int32_t r0)
+{
+    assert(_jitc->function->self.call & jit_call_varargs);
+    /* Initialize va_list to the first stack argument. */
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->vagp))
+	addi(r0, _BP_REGNO, stack_framesize + _jitc->function->vagp *
+	     sizeof(int64_t));
+    else
+#endif
+	addi(r0, _BP_REGNO, _jitc->function->self.size);
+}
+
+static void
+_vaarg(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    /* Load argument. */
+#if WORD_ADJUST
+    ldxi(r0, r1, WORD_ADJUST);
+#else
+    ldr(r0, r1);
+#endif
+
+    /* Update va_list. */
+    addi(r1, r1, STACK_SLOT);
+}
+
+static void
+_patch_abs(jit_state_t *_jit, jit_word_t instr, jit_word_t label)
+{
+    jit_instr_t		i;
+    union {
+	int32_t	*i;
+	jit_word_t	 w;
+    } u;
+
+    u.w = instr;
+#if __WORDSIZE == 32
+    i.op = u.i[0];
+    assert(i.hc.b == MIPS_LUI);
+    i.is.b = label >> 16;
+    u.i[0] = i.op;
+    i.op = u.i[1];
+    assert(i.hc.b == MIPS_ORI);
+    i.is.b = label;
+    u.i[1] = i.op;
+#else
+    i.op = u.i[0];
+    assert(i.hc.b == MIPS_LUI);
+    i.is.b = label >> 48;
+    u.i[0] = i.op;
+    i.op = u.i[1];
+    assert(i.hc.b == MIPS_ORI);
+    i.is.b = label >> 32;
+    u.i[1] = i.op;
+    /* lshi */
+    i.op = u.i[3];
+    assert(i.hc.b == MIPS_ORI);
+    i.is.b = label >> 16;
+    u.i[3] = i.op;
+    /* lshi */
+    i.op = u.i[5];
+    assert(i.hc.b == MIPS_ORI);
+    i.is.b = label;
+    u.i[5] = i.op;
+#endif
+}
+
+static void
+_patch_at(jit_state_t *_jit, jit_word_t instr, jit_word_t label)
+{
+    jit_instr_t		i;
+    union {
+	int32_t	*i;
+	jit_word_t	 w;
+    } u;
+
+    u.w = instr;
+    i.op = u.i[0];
+    switch (i.hc.b) {
+	/* 16 bit immediate opcodes */
+	case MIPS_REGIMM:
+	    switch (i.rt.b) {
+		case MIPS_BLTZ:		case MIPS_BLTZL:
+		case MIPS_BLTZAL:	case MIPS_BLTZALL:
+		case MIPS_BGEZ:		case MIPS_BGEZAL:
+		case MIPS_BGEZALL:	case MIPS_BGEZL:
+		case MIPS_TEQI:		case MIPS_TGEI:
+		case MIPS_TGEIU:	case MIPS_TLTI:
+		case MIPS_TLTIU:	case MIPS_TNEI:
+		    i.is.b = ((label - instr) >> 2) - 1;
+		    u.i[0] = i.op;
+		    break;
+		default:
+		    assert(!"unhandled branch opcode");
+		    break;
+	    }
+	    break;
+
+	case MIPS_COP1:			case MIPS_COP2:
+	    assert(i.rs.b == MIPS_BC);
+	    switch (i.rt.b) {
+		case MIPS_BCF:		case MIPS_BCFL:
+		case MIPS_BCT:		case MIPS_BCTL:
+		    i.is.b = ((label - instr) >> 2) - 1;
+		    u.i[0] = i.op;
+		    break;
+		default:
+		    assert(!"unhandled branch opcode");
+		    break;
+	    }
+	    break;
+
+	case MIPS_BLEZ:			case MIPS_BLEZL:
+	case MIPS_BEQ:			case MIPS_BEQL:
+	case MIPS_BGTZ:			case MIPS_BGTZL:
+	case MIPS_BNE:			case MIPS_BNEL:
+	    i.is.b = ((label - instr) >> 2) - 1;
+	    u.i[0] = i.op;
+	    break;
+
+	case MIPS_LUI:
+	    patch_abs(instr, label);
+	    break;
+
+	case MIPS_J:			case MIPS_JAL:
+	case MIPS_JALX:
+	    assert(((instr + sizeof(int32_t)) & 0xf0000000) ==
+		   (label & 0xf0000000));
+	    i.ii.b = (label & ~0xf0000000) >> 2;
+	    u.i[0] = i.op;
+	    break;
+
+	default:
+	    assert(!"unhandled branch opcode");
+	    break;
+    }
+}
+#endif
diff --git a/libguile/lightening/lightening/mips-fpu.c b/libguile/lightening/lightening/mips-fpu.c
new file mode 100644
index 000000000..cc9be6c66
--- /dev/null
+++ b/libguile/lightening/lightening/mips-fpu.c
@@ -0,0 +1,1844 @@
+/*
+ * Copyright (C) 2012-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+#  define BE_P				(__BYTE_ORDER == __BIG_ENDIAN)
+#  define LE_P				(__BYTE_ORDER == __LITTLE_ENDIAN)
+#  define MIPS_fmt_S			0x10		/* float32 */
+#  define MIPS_fmt_D			0x11		/* float64 */
+#  define MIPS_fmt_W			0x14		/* int32 */
+#  define MIPS_fmt_L			0x15		/* int64 */
+#  define MIPS_fmt_PS			0x16		/* 2 x float32 */
+#  define MIPS_fmt_S_PU			0x20
+#  define MIPS_fmt_S_PL			0x26
+#  define MIPS_ADD_fmt			0x00
+#  define MIPS_LWXC1			0x00
+#  define MIPS_SUB_fmt			0x01
+#  define MIPS_LDXC1			0x01
+#  define MIPS_MUL_fmt			0x02
+#  define MIPS_DIV_fmt			0x03
+#  define MIPS_SQRT_fmt			0x04
+#  define MIPS_ABS_fmt			0x05
+#  define MIPS_LUXC1			0x05
+#  define MIPS_MOV_fmt			0x06
+#  define MIPS_NEG_fmt			0x07
+#  define MIPS_SWXC1			0x08
+#  define MIPS_ROUND_fmt_L		0x08
+#  define MIPS_TRUNC_fmt_L		0x09
+#  define MIPS_SDXC1			0x09
+#  define MIPS_CEIL_fmt_L		0x0a
+#  define MIPS_FLOOR_fmt_L		0x0b
+#  define MIPS_ROUND_fmt_W		0x0c
+#  define MIPS_TRUNC_fmt_W		0x0d
+#  define MIPS_SUXC1			0x0d
+#  define MIPS_CEIL_fmt_W		0x0e
+#  define MIPS_FLOOR_fmt_W		0x0f
+#  define MIPS_RECIP			0x15
+#  define MIPS_RSQRT			0x16
+#  define MIPS_ALNV_PS			0x1e
+#  define MIPS_CVT_fmt_S		0x20
+#  define MIPS_CVT_fmt_D		0x21
+#  define MIPS_CVT_fmt_W		0x24
+#  define MIPS_CVT_fmt_L		0x25
+#  define MIPS_PLL			0x2c
+#  define MIPS_PLU			0x2d
+#  define MIPS_PUL			0x2e
+#  define MIPS_PUU			0x2f
+#  define MIPS_MADD_fmt_S		(0x20 | MIPS_fmt_S)
+#  define MIPS_MADD_fmt_D		(0x20 | MIPS_fmt_D)
+#  define MIPS_MADD_fmt_PS		(0x20 | MIPS_fmt_PS)
+#  define MIPS_MSUB_fmt_S		(0x28 | MIPS_fmt_S)
+#  define MIPS_MSUB_fmt_D		(0x28 | MIPS_fmt_D)
+#  define MIPS_MSUB_fmt_PS		(0x28 | MIPS_fmt_PS)
+#  define MIPS_NMADD_fmt_S		(0x30 | MIPS_fmt_S)
+#  define MIPS_NMADD_fmt_D		(0x30 | MIPS_fmt_D)
+#  define MIPS_NMADD_fmt_PS		(0x30 | MIPS_fmt_PS)
+#  define MIPS_NMSUB_fmt_S		(0x38 | MIPS_fmt_S)
+#  define MIPS_NMSUB_fmt_D		(0x38 | MIPS_fmt_D)
+#  define MIPS_NMSUB_fmt_PS		(0x38 | MIPS_fmt_PS)
+#  define MIPS_cond_F			0x30
+#  define MIPS_cond_UN			0x31
+#  define MIPS_cond_EQ			0x32
+#  define MIPS_cond_UEQ			0x33
+#  define MIPS_cond_OLT			0x34
+#  define MIPS_cond_ULT			0x35
+#  define MIPS_cond_OLE			0x36
+#  define MIPS_cond_ULE			0x37
+#  define MIPS_cond_SF			0x38
+#  define MIPS_cond_NGLE		0x39
+#  define MIPS_cond_SEQ			0x3a
+#  define MIPS_cond_NGL			0x3b
+#  define MIPS_cond_LT			0x3c
+#  define MIPS_cond_NGE			0x3d
+#  define MIPS_cond_LE			0x3e
+#  define MIPS_cond_UGT			0x3f
+#  define ADD_S(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_S,ft,fs,fd,MIPS_ADD_fmt)
+#  define ADD_D(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_D,ft,fs,fd,MIPS_ADD_fmt)
+#  define SUB_S(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_S,ft,fs,fd,MIPS_SUB_fmt)
+#  define SUB_D(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_D,ft,fs,fd,MIPS_SUB_fmt)
+#  define MUL_S(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_S,ft,fs,fd,MIPS_MUL_fmt)
+#  define MUL_D(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_D,ft,fs,fd,MIPS_MUL_fmt)
+#  define DIV_S(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_S,ft,fs,fd,MIPS_DIV_fmt)
+#  define DIV_D(fd,fs,ft)		hrrrit(MIPS_COP1,MIPS_fmt_D,ft,fs,fd,MIPS_DIV_fmt)
+#  define ABS_S(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_ABS_fmt)
+#  define ABS_D(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_ABS_fmt)
+#  define NEG_S(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_NEG_fmt)
+#  define NEG_D(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_NEG_fmt)
+#  define SQRT_S(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_SQRT_fmt)
+#  define SQRT_D(fd,fs)			hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_SQRT_fmt)
+#  define MFC1(rt, fs)			hrrrit(MIPS_COP1,MIPS_MF,rt,fs,0,0)
+#  define MTC1(rt, fs)			hrrrit(MIPS_COP1,MIPS_MT,rt,fs,0,0)
+#  define DMFC1(rt, fs)			hrrrit(MIPS_COP1,MIPS_DMF,rt,fs,0,0)
+#  define DMTC1(rt, fs)			hrrrit(MIPS_COP1,MIPS_DMT,rt,fs,0,0)
+#  define CVT_D_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_CVT_fmt_D)
+#  define CVT_D_W(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_W,0,fs,fd,MIPS_CVT_fmt_D)
+#  define CVT_D_L(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_L,0,fs,fd,MIPS_CVT_fmt_D)
+#  define CVT_L_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_CVT_fmt_L)
+#  define CVT_L_D(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_CVT_fmt_L)
+#  define CVT_PS_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_CVT_fmt_PS)
+#  define CVT_S_D(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_CVT_fmt_S)
+#  define CVT_S_W(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_W,0,fs,fd,MIPS_CVT_fmt_S)
+#  define CVT_S_L(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_L,0,fs,fd,MIPS_CVT_fmt_S)
+#  define CVT_S_PL(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_PS,0,fs,fd,MIPS_CVT_fmt_S_PL)
+#  define CVT_S_PU(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_PS,0,fs,fd,MIPS_CVT_fmt_S_PU)
+#  define CVT_W_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_CVT_fmt_W)
+#  define CVT_W_D(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_CVT_fmt_W)
+#  define TRUNC_L_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_TRUNC_fmt_L)
+#  define TRUNC_L_D(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_TRUNC_fmt_L)
+#  define TRUNC_W_S(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_TRUNC_fmt_W)
+#  define TRUNC_W_D(fd,fs)		hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_TRUNC_fmt_W)
+#  define LWC1(rt, of, rb)		hrri(MIPS_LWC1, rb, rt, of)
+#  define SWC1(rt, of, rb)		hrri(MIPS_SWC1, rb, rt, of)
+#  define LDC1(rt, of, rb)		hrri(MIPS_LDC1, rb, rt, of)
+#  define SDC1(rt, of, rb)		hrri(MIPS_SDC1, rb, rt, of)
+#  define MOV_S(fd, fs)			hrrrit(MIPS_COP1,MIPS_fmt_S,0,fs,fd,MIPS_MOV_fmt)
+#  define MOV_D(fd, fs)			hrrrit(MIPS_COP1,MIPS_fmt_D,0,fs,fd,MIPS_MOV_fmt)
+#  define BC1F(im)			hrri(MIPS_COP1,MIPS_BC,MIPS_BCF,im)
+#  define BC1T(im)			hrri(MIPS_COP1,MIPS_BC,MIPS_BCT,im)
+#  define C_F_S(fs,ft)			c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_F)
+#  define C_F_D(fs,ft)			c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_F)
+#  define C_F_PS(fs,ft)			c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_F)
+#  define C_UN_S(fs,ft)			c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_UN)
+#  define C_UN_D(fs,ft)			c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_UN)
+#  define C_UN_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_UN)
+#  define C_EQ_S(fs,ft)			c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_EQ)
+#  define C_EQ_D(fs,ft)			c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_EQ)
+#  define C_EQ_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_EQ)
+#  define C_UEQ_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_UEQ)
+#  define C_UEQ_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_UEQ)
+#  define C_UEQ_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_UEQ)
+#  define C_OLT_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_OLT)
+#  define C_OLT_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_OLT)
+#  define C_OLT_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_OLT)
+#  define C_ULT_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_ULT)
+#  define C_ULT_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_ULT)
+#  define C_ULT_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_ULT)
+#  define C_OLE_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_OLE)
+#  define C_OLE_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_OLE)
+#  define C_OLE_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_OLE)
+#  define C_ULE_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_ULE)
+#  define C_ULE_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_ULE)
+#  define C_ULE_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_ULE)
+#  define C_SF_S(fs,ft)			c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_SF)
+#  define C_SF_D(fs,ft)			c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_SF)
+#  define C_SF_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_SF)
+#  define C_NGLE_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_NGLE)
+#  define C_NGLE_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_NGLE)
+#  define C_NGLE_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_NGLE)
+#  define C_SEQ_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_SEQ)
+#  define C_SEQ_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_SEQ)
+#  define C_SEQ_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_SEQ)
+#  define C_NGL_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_NGL)
+#  define C_NGL_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_NGL)
+#  define C_NGL_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_NGL)
+#  define C_NLT_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_NLT)
+#  define C_NLT_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_NLT)
+#  define C_NLT_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_NLT)
+#  define C_NGE_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_NGE)
+#  define C_NGE_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_NGE)
+#  define C_NGE_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_NGE)
+#  define C_NLE_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_NLE)
+#  define C_NLE_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_NLE)
+#  define C_NLE_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_NLE)
+#  define C_UGT_S(fs,ft)		c_cond_fmt(MIPS_fmt_S,ft,fs,MIPS_cond_UGT)
+#  define C_UGT_D(fs,ft)		c_cond_fmt(MIPS_fmt_D,ft,fs,MIPS_cond_UGT)
+#  define C_UGT_PS(fs,ft)		c_cond_fmt(MIPS_fmt_PS,ft,fs,MIPS_cond_UGT)
+#  define c_cond_fmt(fm,ft,fs,cc)	_c_cond_fmt(_jit,fm,ft,fs,cc)
+static void
+_c_cond_fmt(jit_state_t *_jit, int32_t fm,
+	    int32_t ft, int32_t fs, int32_t cc);
+#  define addr_f(r0,r1,r2)		ADD_S(r0,r1,r2)
+#  define addi_f(r0,r1,i0)		_addi_f(_jit,r0,r1,i0)
+static void _addi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define addr_d(r0,r1,r2)		ADD_D(r0,r1,r2)
+#  define addi_d(r0,r1,i0)		_addi_d(_jit,r0,r1,i0)
+static void _addi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define subr_f(r0,r1,r2)		SUB_S(r0,r1,r2)
+#  define subi_f(r0,r1,i0)		_subi_f(_jit,r0,r1,i0)
+static void _subi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define subr_d(r0,r1,r2)		SUB_D(r0,r1,r2)
+#  define subi_d(r0,r1,i0)		_subi_d(_jit,r0,r1,i0)
+static void _subi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define rsbr_f(r0,r1,r2)		subr_f(r0,r2,r1)
+#  define rsbi_f(r0,r1,i0)		_rsbi_f(_jit,r0,r1,i0)
+static void _rsbi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define rsbr_d(r0,r1,r2)		subr_d(r0,r2,r1)
+#  define rsbi_d(r0,r1,i0)		_rsbi_d(_jit,r0,r1,i0)
+static void _rsbi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define mulr_f(r0,r1,r2)		MUL_S(r0,r1,r2)
+#  define muli_f(r0,r1,i0)		_muli_f(_jit,r0,r1,i0)
+static void _muli_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define mulr_d(r0,r1,r2)		MUL_D(r0,r1,r2)
+#  define muli_d(r0,r1,i0)		_muli_d(_jit,r0,r1,i0)
+static void _muli_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define divr_f(r0,r1,r2)		DIV_S(r0,r1,r2)
+#  define divi_f(r0,r1,i0)		_divi_f(_jit,r0,r1,i0)
+static void _divi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define divr_d(r0,r1,r2)		DIV_D(r0,r1,r2)
+#  define divi_d(r0,r1,i0)		_divi_d(_jit,r0,r1,i0)
+static void _divi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define absr_f(r0,r1)			ABS_S(r0,r1)
+#  define absr_d(r0,r1)			ABS_D(r0,r1)
+#  define negr_f(r0,r1)			NEG_S(r0,r1)
+#  define negr_d(r0,r1)			NEG_D(r0,r1)
+#  define sqrtr_f(r0,r1)		SQRT_S(r0,r1)
+#  define sqrtr_d(r0,r1)		SQRT_D(r0,r1)
+#  define movr_w_f(r0, r1)		MTC1(r1, r0)
+#  define movr_f_w(r0, r1)		MFC1(r1, r0)
+#  define movi_f_w(r0, i0)		_movi_f_w(_jit, r0, i0)
+static void _movi_f_w(jit_state_t*,int32_t,jit_float32_t*);
+#  define extr_f(r0, r1)		_extr_f(_jit, r0, r1)
+static void _extr_f(jit_state_t*,int32_t,int32_t);
+#  define truncr_f_i(r0, r1)		_truncr_f_i(_jit, r0, r1)
+static void _truncr_f_i(jit_state_t*,int32_t,int32_t);
+#  if __WORDSIZE == 64
+#    define truncr_f_l(r0, r1)		_truncr_f_l(_jit, r0, r1)
+static void _truncr_f_l(jit_state_t*,int32_t,int32_t);
+#  endif
+#  define extr_d_f(r0, r1)		CVT_S_D(r0, r1)
+#  define ldr_f(r0, r1)			LWC1(r0, 0, r1)
+#  define ldi_f(r0, i0)			_ldi_f(_jit, r0, i0)
+static void _ldi_f(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_f(r0, r1, r2)		_ldxr_f(_jit, r0, r1, r2)
+static void _ldxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_f(r0, r1, i0)		_ldxi_f(_jit, r0, r1, i0)
+static void _ldxi_f(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define str_f(r0, r1)			SWC1(r1, 0, r0)
+#  define sti_f(i0, r0)			_sti_f(_jit, i0, r0)
+static void _sti_f(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_f(r0, r1, r2)		_stxr_f(_jit, r0, r1, r2)
+static void _stxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_f(i0, r0, r1)		_stxi_f(_jit, i0, r0, r1)
+static void _stxi_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define movr_f(r0, r1)		_movr_f(_jit, r0, r1)
+static void _movr_f(jit_state_t*,int32_t,int32_t);
+#  define movi_f(r0, i0)		_movi_f(_jit, r0, i0)
+static void _movi_f(jit_state_t*,int32_t,jit_float32_t*);
+#  if NEW_ABI
+#    if __WORDSIZE == 32
+#      define movi64(r0, i0)		_movi64(_jit, r0, i0)
+static void _movi64(jit_state_t*,int32_t,int64_t);
+#    else
+#      define movi64(r0, i0)		movi(r0, i0)
+#    endif
+#    define movr_w_d(r0, r1)		DMTC1(r1, r0)
+#    define movr_d_w(r0, r1)		DMFC1(r0, r1)
+#    define movi_d_w(r0, i0)		_movi_d_w(_jit,r0,i0)
+static void _movi_d_w(jit_state_t*,int32_t,jit_float64_t*);
+#  else
+#    define movr_ww_d(r0, r1, r2)	_movr_ww_d(_jit, r0, r1, r2)
+static void _movr_ww_d(jit_state_t*,int32_t,int32_t,int32_t);
+#    define movr_d_ww(r0, r1, r2)	_movr_d_ww(_jit, r0, r1, r2)
+static void _movr_d_ww(jit_state_t*,int32_t,int32_t,int32_t);
+#    define movi_d_ww(r0, r1, i0)	_movi_d_ww(_jit, r0, r1, i0)
+static void _movi_d_ww(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  endif
+#  define extr_d(r0, r1)		_extr_d(_jit, r0, r1)
+static void _extr_d(jit_state_t*,int32_t,int32_t);
+#  define truncr_d_i(r0, r1)		_truncr_d_i(_jit, r0, r1)
+static void _truncr_d_i(jit_state_t*,int32_t,int32_t);
+#  if __WORDSIZE == 64
+#    define truncr_d_l(r0, r1)		_truncr_d_l(_jit, r0, r1)
+static void _truncr_d_l(jit_state_t*,int32_t,int32_t);
+#  endif
+#  define ldr_d(r0, r1)			_ldr_d(_jit, r0, r1)
+static void _ldr_d(jit_state_t*,int32_t,int32_t);
+#  define ldi_d(r0, i0)			_ldi_d(_jit, r0, i0)
+static void _ldi_d(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_d(r0, r1, r2)		_ldxr_d(_jit, r0, r1, r2)
+static void _ldxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_d(r0, r1, i0)		_ldxi_d(_jit, r0, r1, i0)
+static void _ldxi_d(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define str_d(r0, r1)			_str_d(_jit, r0, r1)
+static void _str_d(jit_state_t*,int32_t,int32_t);
+#  define sti_d(i0, r0)			_sti_d(_jit, i0, r0)
+static void _sti_d(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_d(r0, r1, r2)		_stxr_d(_jit, r0, r1, r2)
+static void _stxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_d(i0, r0, r1)		_stxi_d(_jit, i0, r0, r1)
+static void _stxi_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define movr_d(r0, r1)		_movr_d(_jit, r0, r1)
+static void _movr_d(jit_state_t*,int32_t,int32_t);
+#  define movi_d(r0, i0)		_movi_d(_jit, r0, i0)
+static void _movi_d(jit_state_t*,int32_t,jit_float64_t*);
+#  define ltr_f(r0, r1, r2)		_ltr_f(_jit, r0, r1, r2)
+static void _ltr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lti_f(r0, r1, i2)		_lti_f(_jit, r0, r1, i2)
+static void _lti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ler_f(r0, r1, r2)		_ler_f(_jit, r0, r1, r2)
+static void _ler_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lei_f(r0, r1, i2)		_lei_f(_jit, r0, r1, i2)
+static void _lei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define eqr_f(r0, r1, r2)		_eqr_f(_jit, r0, r1, r2)
+static void _eqr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define eqi_f(r0, r1, i2)		_eqi_f(_jit, r0, r1, i2)
+static void _eqi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ger_f(r0, r1, r2)		_ger_f(_jit, r0, r1, r2)
+static void _ger_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gei_f(r0, r1, i2)		_gei_f(_jit, r0, r1, i2)
+static void _gei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define gtr_f(r0, r1, r2)		_gtr_f(_jit, r0, r1, r2)
+static void _gtr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gti_f(r0, r1, i2)		_gti_f(_jit, r0, r1, i2)
+static void _gti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ner_f(r0, r1, r2)		_ner_f(_jit, r0, r1, r2)
+static void _ner_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define nei_f(r0, r1, i2)		_nei_f(_jit, r0, r1, i2)
+static void _nei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unltr_f(r0, r1, r2)		_unltr_f(_jit, r0, r1, r2)
+static void _unltr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlti_f(r0, r1, i2)		_unlti_f(_jit, r0, r1, i2)
+static void _unlti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unler_f(r0, r1, r2)		_unler_f(_jit, r0, r1, r2)
+static void _unler_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlei_f(r0, r1, i2)		_unlei_f(_jit, r0, r1, i2)
+static void _unlei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define uneqr_f(r0, r1, r2)		_uneqr_f(_jit, r0, r1, r2)
+static void _uneqr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define uneqi_f(r0, r1, i2)		_uneqi_f(_jit, r0, r1, i2)
+static void _uneqi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unger_f(r0, r1, r2)		_unger_f(_jit, r0, r1, r2)
+static void _unger_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungei_f(r0, r1, i2)		_ungei_f(_jit, r0, r1, i2)
+static void _ungei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ungtr_f(r0, r1, r2)		_ungtr_f(_jit, r0, r1, r2)
+static void _ungtr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungti_f(r0, r1, i2)		_ungti_f(_jit, r0, r1, i2)
+static void _ungti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ltgtr_f(r0, r1, r2)		_ltgtr_f(_jit, r0, r1, r2)
+static void _ltgtr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ltgti_f(r0, r1, i2)		_ltgti_f(_jit, r0, r1, i2)
+static void _ltgti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ordr_f(r0, r1, r2)		_ordr_f(_jit, r0, r1, r2)
+static void _ordr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ordi_f(r0, r1, i2)		_ordi_f(_jit, r0, r1, i2)
+static void _ordi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unordr_f(r0, r1, r2)		_unordr_f(_jit, r0, r1, r2)
+static void _unordr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unordi_f(r0, r1, i2)		_unordi_f(_jit, r0, r1, i2)
+static void _unordi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define bltr_f(i0, r0, r1)		_bltr_f(_jit, i0, r0, r1)
+static jit_word_t _bltr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blti_f(i0, r0, i1)		_blti_f(_jit, i0, r0, i1)
+static jit_word_t
+_blti_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bler_f(i0, r0, r1)		_bler_f(_jit, i0, r0, r1)
+static jit_word_t _bler_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blei_f(i0, r0, i1)		_blei_f(_jit, i0, r0, i1)
+static jit_word_t
+_blei_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define beqr_f(i0, r0, r1)		_beqr_f(_jit, i0, r0, r1)
+static jit_word_t _beqr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define beqi_f(i0, r0, i1)		_beqi_f(_jit, i0, r0, i1)
+static jit_word_t
+_beqi_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bger_f(i0, r0, r1)		_bger_f(_jit, i0, r0, r1)
+static jit_word_t _bger_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgei_f(i0, r0, i1)		_bgei_f(_jit, i0, r0, i1)
+static jit_word_t
+_bgei_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bgtr_f(i0, r0, r1)		_bgtr_f(_jit, i0, r0, r1)
+static jit_word_t _bgtr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgti_f(i0, r0, i1)		_bgti_f(_jit, i0, r0, i1)
+static jit_word_t
+_bgti_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bner_f(i0, r0, r1)		_bner_f(_jit, i0, r0, r1)
+static jit_word_t _bner_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bnei_f(i0, r0, i1)		_bnei_f(_jit, i0, r0, i1)
+static jit_word_t
+_bnei_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bunltr_f(i0, r0, r1)		_bunltr_f(_jit, i0, r0, r1)
+static jit_word_t _bunltr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlti_f(i0, r0, i1)		_bunlti_f(_jit, i0, r0, i1)
+static jit_word_t
+_bunlti_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bunler_f(i0, r0, r1)		_bunler_f(_jit, i0, r0, r1)
+static jit_word_t _bunler_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlei_f(i0, r0, i1)		_bunlei_f(_jit, i0, r0, i1)
+static jit_word_t
+_bunlei_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define buneqr_f(i0, r0, r1)		_buneqr_f(_jit, i0, r0, r1)
+static jit_word_t _buneqr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define buneqi_f(i0, r0, i1)		_buneqi_f(_jit, i0, r0, i1)
+static jit_word_t
+_buneqi_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bunger_f(i0, r0, r1)		_bunger_f(_jit, i0, r0, r1)
+static jit_word_t _bunger_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungei_f(i0, r0, i1)		_bungei_f(_jit, i0, r0, i1)
+static jit_word_t
+_bungei_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bungtr_f(i0, r0, r1)		_bungtr_f(_jit, i0, r0, r1)
+static jit_word_t _bungtr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungti_f(i0, r0, i1)		_bungti_f(_jit, i0, r0, i1)
+static jit_word_t
+_bungti_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bltgtr_f(i0, r0, r1)		_bltgtr_f(_jit, i0, r0, r1)
+static jit_word_t _bltgtr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bltgti_f(i0, r0, i1)		_bltgti_f(_jit, i0, r0, i1)
+static jit_word_t
+_bltgti_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bordr_f(i0, r0, r1)		_bordr_f(_jit, i0, r0, r1)
+static jit_word_t _bordr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bordi_f(i0, r0, i1)		_bordi_f(_jit, i0, r0, i1)
+static jit_word_t
+_bordi_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define bunordr_f(i0, r0, r1)		_bunordr_f(_jit, i0, r0, r1)
+static jit_word_t _bunordr_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunordi_f(i0, r0, i1)		_bunordi_f(_jit, i0, r0, i1)
+static jit_word_t
+_bunordi_f(jit_state_t*, jit_word_t, int32_t, jit_float32_t*);
+#  define extr_f_d(r0, r1)		CVT_D_S(r0, r1)
+#  define ltr_d(r0, r1, r2)		_ltr_d(_jit, r0, r1, r2)
+static void _ltr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lti_d(r0, r1, i2)		_lti_d(_jit, r0, r1, i2)
+static void _lti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ler_d(r0, r1, r2)		_ler_d(_jit, r0, r1, r2)
+static void _ler_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lei_d(r0, r1, i2)		_lei_d(_jit, r0, r1, i2)
+static void _lei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define eqr_d(r0, r1, r2)		_eqr_d(_jit, r0, r1, r2)
+static void _eqr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define eqi_d(r0, r1, i2)		_eqi_d(_jit, r0, r1, i2)
+static void _eqi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ger_d(r0, r1, r2)		_ger_d(_jit, r0, r1, r2)
+static void _ger_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gei_d(r0, r1, i2)		_gei_d(_jit, r0, r1, i2)
+static void _gei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define gtr_d(r0, r1, r2)		_gtr_d(_jit, r0, r1, r2)
+static void _gtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gti_d(r0, r1, i2)		_gti_d(_jit, r0, r1, i2)
+static void _gti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ner_d(r0, r1, r2)		_ner_d(_jit, r0, r1, r2)
+static void _ner_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define nei_d(r0, r1, i2)		_nei_d(_jit, r0, r1, i2)
+static void _nei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unltr_d(r0, r1, r2)		_unltr_d(_jit, r0, r1, r2)
+static void _unltr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlti_d(r0, r1, i2)		_unlti_d(_jit, r0, r1, i2)
+static void _unlti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unler_d(r0, r1, r2)		_unler_d(_jit, r0, r1, r2)
+static void _unler_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlei_d(r0, r1, i2)		_unlei_d(_jit, r0, r1, i2)
+static void _unlei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define uneqr_d(r0, r1, r2)		_uneqr_d(_jit, r0, r1, r2)
+static void _uneqr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define uneqi_d(r0, r1, i2)		_uneqi_d(_jit, r0, r1, i2)
+static void _uneqi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unger_d(r0, r1, r2)		_unger_d(_jit, r0, r1, r2)
+static void _unger_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungei_d(r0, r1, i2)		_ungei_d(_jit, r0, r1, i2)
+static void _ungei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ungtr_d(r0, r1, r2)		_ungtr_d(_jit, r0, r1, r2)
+static void _ungtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungti_d(r0, r1, i2)		_ungti_d(_jit, r0, r1, i2)
+static void _ungti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ltgtr_d(r0, r1, r2)		_ltgtr_d(_jit, r0, r1, r2)
+static void _ltgtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ltgti_d(r0, r1, i2)		_ltgti_d(_jit, r0, r1, i2)
+static void _ltgti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ordr_d(r0, r1, r2)		_ordr_d(_jit, r0, r1, r2)
+static void _ordr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ordi_d(r0, r1, i2)		_ordi_d(_jit, r0, r1, i2)
+static void _ordi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unordr_d(r0, r1, r2)		_unordr_d(_jit, r0, r1, r2)
+static void _unordr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unordi_d(r0, r1, i2)		_unordi_d(_jit, r0, r1, i2)
+static void _unordi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define bltr_d(i0, r0, r1)		_bltr_d(_jit, i0, r0, r1)
+static jit_word_t _bltr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blti_d(i0, r0, i1)		_blti_d(_jit, i0, r0, i1)
+static jit_word_t
+_blti_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bler_d(i0, r0, r1)		_bler_d(_jit, i0, r0, r1)
+static jit_word_t _bler_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blei_d(i0, r0, i1)		_blei_d(_jit, i0, r0, i1)
+static jit_word_t
+_blei_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define beqr_d(i0, r0, r1)		_beqr_d(_jit, i0, r0, r1)
+static jit_word_t _beqr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define beqi_d(i0, r0, i1)		_beqi_d(_jit, i0, r0, i1)
+static jit_word_t
+_beqi_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bger_d(i0, r0, r1)		_bger_d(_jit, i0, r0, r1)
+static jit_word_t _bger_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgei_d(i0, r0, i1)		_bgei_d(_jit, i0, r0, i1)
+static jit_word_t
+_bgei_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bgtr_d(i0, r0, r1)		_bgtr_d(_jit, i0, r0, r1)
+static jit_word_t _bgtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgti_d(i0, r0, i1)		_bgti_d(_jit, i0, r0, i1)
+static jit_word_t
+_bgti_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bner_d(i0, r0, r1)		_bner_d(_jit, i0, r0, r1)
+static jit_word_t _bner_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bnei_d(i0, r0, i1)		_bnei_d(_jit, i0, r0, i1)
+static jit_word_t
+_bnei_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bunltr_d(i0, r0, r1)		_bunltr_d(_jit, i0, r0, r1)
+static jit_word_t _bunltr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlti_d(i0, r0, i1)		_bunlti_d(_jit, i0, r0, i1)
+static jit_word_t
+_bunlti_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bunler_d(i0, r0, r1)		_bunler_d(_jit, i0, r0, r1)
+static jit_word_t _bunler_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlei_d(i0, r0, i1)		_bunlei_d(_jit, i0, r0, i1)
+static jit_word_t
+_bunlei_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define buneqr_d(i0, r0, r1)		_buneqr_d(_jit, i0, r0, r1)
+static jit_word_t _buneqr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define buneqi_d(i0, r0, i1)		_buneqi_d(_jit, i0, r0, i1)
+static jit_word_t
+_buneqi_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bunger_d(i0, r0, r1)		_bunger_d(_jit, i0, r0, r1)
+static jit_word_t _bunger_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungei_d(i0, r0, i1)		_bungei_d(_jit, i0, r0, i1)
+static jit_word_t
+_bungei_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bungtr_d(i0, r0, r1)		_bungtr_d(_jit, i0, r0, r1)
+static jit_word_t _bungtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungti_d(i0, r0, i1)		_bungti_d(_jit, i0, r0, i1)
+static jit_word_t
+_bungti_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bltgtr_d(i0, r0, r1)		_bltgtr_d(_jit, i0, r0, r1)
+static jit_word_t _bltgtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bltgti_d(i0, r0, i1)		_bltgti_d(_jit, i0, r0, i1)
+static jit_word_t
+_bltgti_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bordr_d(i0, r0, r1)		_bordr_d(_jit, i0, r0, r1)
+static jit_word_t _bordr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bordi_d(i0, r0, i1)		_bordi_d(_jit, i0, r0, i1)
+static jit_word_t
+_bordi_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define bunordr_d(i0, r0, r1)		_bunordr_d(_jit, i0, r0, r1)
+static jit_word_t _bunordr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunordi_d(i0, r0, i1)		_bunordi_d(_jit, i0, r0, i1)
+static jit_word_t
+_bunordi_d(jit_state_t*, jit_word_t, int32_t, jit_float64_t*);
+#  define vaarg_d(r0, r1)		_vaarg_d(_jit, r0, r1)
+static void _vaarg_d(jit_state_t*, int32_t, int32_t);
+#endif
+
+#if CODE
+static void
+_c_cond_fmt(jit_state_t *_jit, int32_t fm,
+	    int32_t ft, int32_t fs, int32_t cc)
+{
+    jit_instr_t		i;
+    i.cc.b = cc;
+    i.fs.b = fs;
+    i.ft.b = ft;
+    i.fm.b = fm;
+    i.hc.b = MIPS_COP1;
+    ii(i.op);
+}
+
+#  define fpr_opi(name, type, size)					\
+static void								\
+_##name##i_##type(jit_state_t *_jit,					\
+		  int32_t r0, int32_t r1,			\
+		  jit_float##size##_t *i0)				\
+{									\
+    int32_t		reg = jit_get_reg(jit_class_fpr);		\
+    movi_##type(rn(reg), i0);						\
+    name##r_##type(r0, r1, rn(reg));					\
+    jit_unget_reg(reg);							\
+}
+#  define fpr_bopi(name, type, size)					\
+static jit_word_t							\
+_b##name##i_##type(jit_state_t *_jit,					\
+		  jit_word_t i0, int32_t r0,			\
+		  jit_float##size##_t *i1)				\
+{									\
+    jit_word_t		word;						\
+    int32_t		reg = jit_get_reg(jit_class_fpr|		\
+					  jit_class_nospill);		\
+    movi_##type(rn(reg), i1);						\
+    word = b##name##r_##type(i0, r0, rn(reg));				\
+    jit_unget_reg(reg);							\
+    return (word);							\
+}
+#  define fopi(name)			fpr_opi(name, f, 32)
+#  define fbopi(name)			fpr_bopi(name, f, 32)
+#  define dopi(name)			fpr_opi(name, d, 64)
+#  define dbopi(name)			fpr_bopi(name, d, 64)
+
+fopi(add)
+fopi(sub)
+fopi(rsb)
+fopi(mul)
+fopi(div)
+
+static void
+_movi_f_w(jit_state_t *_jit, int32_t r0, jit_float32_t *i0)
+{
+    union {
+	int32_t	i;
+	jit_float32_t	f;
+    } data;
+
+    data.f = *i0;
+    movi(r0, data.i);
+}
+
+static void
+_extr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+#  if __WORDSIZE == 32
+    MTC1(r1, rn(t0));
+    CVT_S_W(r0, rn(t0));
+#  else
+    DMTC1(r1, rn(t0));
+    CVT_S_L(r0, rn(t0));
+#  endif
+    jit_unget_reg(t0);
+}
+
+static void
+_truncr_f_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+    TRUNC_W_S(rn(t0), r1);
+    MFC1(r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+#  if __WORDSIZE == 64
+static void
+_truncr_f_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+    TRUNC_L_S(rn(t0), r1);
+    DMFC1(r0, rn(t0));
+    jit_unget_reg(t0);
+}
+#  endif
+
+static void
+_ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LWC1(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_f(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_f(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	LWC1(r0, i0, r1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_f(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SWC1(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_f(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_f(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	SWC1(r1, i0, r0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_f(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_movr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	MOV_S(r0, r1);
+}
+
+static void
+_movi_f(jit_state_t *_jit, int32_t r0, jit_float32_t *i0)
+{
+    union {
+	int32_t	i;
+	jit_float32_t	f;
+    } data;
+    int32_t		reg;
+
+    data.f = *i0;
+    if (data.i) {
+	if (_jitc->no_data) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movi(rn(reg), data.i);
+	    MTC1(rn(reg), r0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    ldi_f(r0, (jit_word_t)i0);
+    }
+    else
+	MTC1(_ZERO_REGNO, r0);
+}
+
+dopi(add)
+dopi(sub)
+dopi(rsb)
+dopi(mul)
+dopi(div)
+
+#if NEW_ABI
+/* n32 abi requires 64 bit cpu */
+static void
+_movi64(jit_state_t *_jit, int32_t r0, int64_t i0)
+{
+    if (i0 == 0)
+	OR(r0, _ZERO_REGNO, _ZERO_REGNO);
+    else if (i0 >= -32678 && i0 <= 32767)
+	DADDIU(r0, _ZERO_REGNO, i0);
+    else if (i0 >= 0 && i0 <= 65535)
+	ORI(r0, _ZERO_REGNO, i0);
+    else {
+	if (i0 >= 0 && i0 <= 0x7fffffffLL)
+	    LUI(r0, i0 >> 16);
+	else if (i0 >= 0 && i0 <= 0xffffffffLL) {
+	    if (i0 & 0xffff0000LL) {
+		ORI(r0, _ZERO_REGNO, (jit_word_t)(i0 >> 16));
+		DSLL(r0, r0, 16);
+	    }
+	}
+	else {
+	    movi(r0, (jit_word_t)(i0 >> 32));
+	    if (i0 & 0xffff0000LL) {
+		DSLL(r0, r0, 16);
+		ORI(r0, r0, (jit_word_t)(i0 >> 16));
+		DSLL(r0, r0, 16);
+	    }
+	    else
+		DSLL32(r0, r0, 0);
+	}
+	if ((jit_word_t)i0 & 0xffff)
+	    ORI(r0, r0, (jit_word_t)i0 & 0xffff);
+    }
+}
+
+static void
+_movi_d_w(jit_state_t *_jit, int32_t r0, jit_float64_t *i0)
+{
+    jit_word_t		w;
+    union {
+	int64_t	l;
+	jit_float64_t	d;
+    } data;
+    if (_jitc->no_data) {
+	data.d = *i0;
+	movi64(r0, data.l);
+    }
+    else {
+	w = (jit_word_t)i0;
+	if (can_sign_extend_short_p(w))
+	    LD(r0, w, _ZERO_REGNO);
+	else {
+	    movi(r0, w);
+	    LD(r0, 0, r0);
+	}
+    }
+}
+
+#else
+static void
+_movr_ww_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    assert(r1 == r2 - 1);
+    MTC1(r1, r0 + BE_P);
+    MTC1(r2, r0 + LE_P);
+}
+
+static void
+_movr_d_ww(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    assert(r0 == r1 - 1);
+    MFC1(r0, r2 + BE_P);
+    MFC1(r1, r2 + LE_P);
+}
+
+static void
+_movi_d_ww(jit_state_t *_jit, int32_t r0, int32_t r1, jit_float64_t *i0)
+{
+    union {
+	int32_t	i[2];
+	int64_t	l;
+	jit_float64_t	d;
+    } data;
+
+    data.d = *i0;
+    movi(r0, data.i[0]);
+    movi(r1, data.i[1]);
+}
+#endif
+
+static void
+_extr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+#  if __WORDSIZE == 32
+    MTC1(r1, rn(t0));
+    CVT_D_W(r0, rn(t0));
+#  else
+    DMTC1(r1, rn(t0));
+    CVT_D_L(r0, rn(t0));
+#  endif
+    jit_unget_reg(t0);
+}
+
+static void
+_truncr_d_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+    TRUNC_W_D(rn(t0), r1);
+    MFC1(r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+#  if __WORDSIZE == 64
+static void
+_truncr_d_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_fpr);
+    TRUNC_L_D(rn(t0), r1);
+    DMFC1(r0, rn(t0));
+    jit_unget_reg(t0);
+}
+#  endif
+
+static void
+_ldr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+#  if __WORDSIZE == 64 || NEW_ABI
+    LDC1(r0, 0, r1);
+#  else
+    LWC1(r0 + BE_P, 0, r1);
+    LWC1(r0 + LE_P, 4, r1);
+#  endif
+}
+
+static void
+_ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+#  if __WORDSIZE == 64 || NEW_ABI
+    if (can_sign_extend_short_p(i0))
+	LDC1(r0, i0, _ZERO_REGNO);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	LDC1(r0, 0, rn(reg));
+	jit_unget_reg(reg);
+    }
+#  else
+    if (can_sign_extend_short_p(i0) && can_sign_extend_short_p(i0 + 4)) {
+	LWC1(r0 + BE_P, i0, _ZERO_REGNO);
+	LWC1(r0 + LE_P, i0 + 4, _ZERO_REGNO);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	LWC1(r0 + BE_P, 0, rn(reg));
+	LWC1(r0 + LE_P, 4, rn(reg));
+	jit_unget_reg(reg);
+    }
+#  endif
+}
+
+static void
+_ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r1, r2);
+    ldr_d(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+#  if __WORDSIZE == 64 || NEW_ABI
+    if (can_sign_extend_short_p(i0))
+	LDC1(r0, i0, r1);
+#  else
+    if (can_sign_extend_short_p(i0) && can_sign_extend_short_p(i0 + 4)) {
+	LWC1(r0 + BE_P, i0, r1);
+	LWC1(r0 + LE_P, i0 + 4, r1);
+    }
+#  endif
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r1, i0);
+	ldr_d(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_str_d(jit_state_t *_jit,int32_t r0, int32_t r1)
+{
+#  if __WORDSIZE == 64 || NEW_ABI
+    SDC1(r1, 0, r0);
+#  else
+    SWC1(r1 + BE_P, 0, r0);
+    SWC1(r1 + LE_P, 4, r0);
+#  endif
+}
+
+static void
+_sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+#  if __WORDSIZE == 64 || NEW_ABI
+    if (can_sign_extend_short_p(i0))
+	SDC1(r0, i0, _ZERO_REGNO);
+#  else
+    if (can_sign_extend_short_p(i0) && can_sign_extend_short_p(i0 + 4)) {
+	SWC1(r0 + BE_P, i0, _ZERO_REGNO);
+	SWC1(r0 + LE_P, i0 + 4, _ZERO_REGNO);
+    }
+#  endif
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_d(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    addr(rn(reg), r0, r1);
+    str_d(rn(reg), r2);
+    jit_unget_reg(reg);
+}
+
+static void
+_stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+#  if __WORDSIZE == 64 || NEW_ABI
+    if (can_sign_extend_short_p(i0))
+	SDC1(r1, i0, r0);
+#  else
+    if (can_sign_extend_short_p(i0) && can_sign_extend_short_p(i0 + 4)) {
+	SWC1(r1 + BE_P, i0, r0);
+	SWC1(r1 + LE_P, i0 + 4, r0);
+    }
+#  endif
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	addi(rn(reg), r0, i0);
+	str_d(rn(reg), r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	MOV_D(r0, r1);
+}
+
+static void
+_movi_d(jit_state_t *_jit, int32_t r0, jit_float64_t *i0)
+{
+    union {
+	int32_t	i[2];
+	int64_t	l;
+	jit_float64_t	d;
+    } data;
+    int32_t		reg;
+
+    data.d = *i0;
+#  if __WORDSIZE == 64 || NEW_ABI
+    if (data.l) {
+	if (_jitc->no_data) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movi64(rn(reg), data.l);
+	    DMTC1(rn(reg), r0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    ldi_d(r0, (jit_word_t)i0);
+    }
+    else
+	DMTC1(_ZERO_REGNO, r0);
+#  else
+    if (_jitc->no_data)
+	reg = jit_get_reg(jit_class_gpr);
+    if (data.i[0]) {
+	if (_jitc->no_data) {
+	    movi(rn(reg), data.i[0]);
+	    MTC1(rn(reg), r0 + BE_P);
+	}
+	else
+	    ldi_f(r0 + BE_P, (jit_word_t)i0);
+    }
+    else
+	MTC1(_ZERO_REGNO, r0 + BE_P);
+    if (data.i[1]) {
+	if (_jitc->no_data) {
+	    movi(rn(reg), data.i[1]);
+	    MTC1(rn(reg), r0 + LE_P);
+	}
+	else
+	    ldi_f(r0 + LE_P, ((jit_word_t)i0) + 4);
+    }
+    else
+	MTC1(_ZERO_REGNO, r0 + LE_P);
+    if (_jitc->no_data)
+	jit_unget_reg(reg);
+#  endif
+}
+
+static void
+_ltr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(lt)
+
+static void
+_ler_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(le)
+
+static void
+_eqr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(eq)
+
+static void
+_ger_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(ge)
+
+static void
+_gtr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(gt)
+
+static void
+_ner_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(ne)
+
+static void
+_unltr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(unlt)
+
+static void
+_unler_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(unle)
+
+static void
+_uneqr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(uneq)
+
+static void
+_unger_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(unge)
+
+static void
+_ungtr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(ungt)
+
+static void
+_ltgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(ltgt)
+
+static void
+_ordr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(ord)
+
+static void
+_unordr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+fopi(unord)
+
+static jit_word_t
+_bltr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(lt)
+
+static jit_word_t
+_bler_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(le)
+
+static jit_word_t
+_beqr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(eq)
+
+static jit_word_t
+_bger_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(ge)
+
+static jit_word_t
+_bgtr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(gt)
+
+static jit_word_t
+_bner_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(ne)
+
+static jit_word_t
+_bunltr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(unlt)
+
+static jit_word_t
+_bunler_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(unle)
+
+static jit_word_t
+_buneqr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(uneq)
+
+static jit_word_t
+_bunger_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(unge)
+
+static jit_word_t
+_bungtr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(ungt)
+
+static jit_word_t
+_bltgtr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(ltgt)
+
+static jit_word_t
+_bordr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_S(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(ord)
+
+static jit_word_t
+_bunordr_f(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_S(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+fbopi(unord)
+
+static void
+_ltr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(lt)
+
+static void
+_ler_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(le)
+
+static void
+_eqr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(eq)
+
+static void
+_ger_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(ge)
+
+static void
+_gtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(gt)
+
+static void
+_ner_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(ne)
+
+static void
+_unltr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(unlt)
+
+static void
+_unler_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(unle)
+
+static void
+_uneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(uneq)
+
+static void
+_unger_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(unge)
+
+static void
+_ungtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(ungt)
+
+static void
+_ltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(ltgt)
+
+static void
+_ordr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(ord)
+
+static void
+_unordr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(0);
+    /* delay slot */
+    movi(r0, 1);
+    movi(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+dopi(unord)
+
+static jit_word_t
+_bltr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(lt)
+
+static jit_word_t
+_bler_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(le)
+
+static jit_word_t
+_beqr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(eq)
+
+static jit_word_t
+_bger_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(ge)
+
+static jit_word_t
+_bgtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(gt)
+
+static jit_word_t
+_bner_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_EQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(ne)
+
+static jit_word_t
+_bunltr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(unlt)
+
+static jit_word_t
+_bunler_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_ULE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(unle)
+
+static jit_word_t
+_buneqr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(uneq)
+
+static jit_word_t
+_bunger_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLT_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(unge)
+
+static jit_word_t
+_bungtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_OLE_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(ungt)
+
+static jit_word_t
+_bltgtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UEQ_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(ltgt)
+
+static jit_word_t
+_bordr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_D(r1, r2);
+    w = _jit->pc.w;
+    BC1F(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(ord)
+
+static jit_word_t
+_bunordr_d(jit_state_t *_jit, jit_word_t i0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    C_UN_D(r1, r2);
+    w = _jit->pc.w;
+    BC1T(((i0 - w) >> 2) - 1);
+    NOP(1);
+    return (w);
+}
+dbopi(unord)
+
+static void
+_vaarg_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+#if !NEW_ABI
+    int32_t		reg;
+#endif
+    assert(_jitc->function->self.call & jit_call_varargs);
+#if !NEW_ABI
+    /* Align, if required. */
+    reg = jit_get_reg(jit_class_gpr);
+    andi(rn(reg), r1, 7);
+    addr(r1, r1, rn(reg));
+    jit_unget_reg(reg);
+#endif
+
+    /* Load argument. */
+    ldr_d(r0, r1);
+
+    /* Update va_list. */
+    addi(r1, r1, sizeof(jit_float64_t));
+}
+
+#  undef fopi
+#  undef fbopi
+#  undef dopi
+#  undef dbopi
+#  undef fpr_bopi
+#  undef fpr_opi
+#endif
diff --git a/libguile/lightening/lightening/mips.c b/libguile/lightening/lightening/mips.c
new file mode 100644
index 000000000..3b2370f29
--- /dev/null
+++ b/libguile/lightening/lightening/mips.c
@@ -0,0 +1,1935 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if defined(__linux__)
+#  include <sys/cachectl.h>
+#endif
+
+# define JIT_RA0                _A0
+# define JIT_FA0                _F12
+# define JIT_SP         _SP
+# define JIT_RET                _V0
+# define JIT_FRET               _F0
+
+#if NEW_ABI
+#  define NUM_WORD_ARGS			8
+#  define STACK_SLOT			8
+#  define STACK_SHIFT			3
+#else
+#  define NUM_WORD_ARGS			4
+#  define STACK_SLOT			4
+#  define STACK_SHIFT			2
+#endif
+#if NEW_ABI && __BYTE_ORDER == __BIG_ENDIAN && __WORDSIZE == 32
+#  define WORD_ADJUST			4
+#else
+#  define WORD_ADJUST			0
+#endif
+#define jit_arg_reg_p(i)		((i) >= 0 && (i) < NUM_WORD_ARGS)
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+#  define C_DISP			0
+#  define S_DISP			0
+#  define I_DISP			0
+#else
+#  define C_DISP			STACK_SLOT - sizeof(int8_t)
+#  define S_DISP			STACK_SLOT - sizeof(int16_t)
+#  define I_DISP			STACK_SLOT - sizeof(int32_t)
+#endif
+
+/*
+ * Types
+ */
+typedef struct jit_pointer_t jit_va_list_t;
+
+/*
+ * Prototypes
+ */
+#define jit_make_arg(node)		_jit_make_arg(_jit,node)
+static jit_node_t *_jit_make_arg(jit_state_t*,jit_node_t*);
+#define jit_make_arg_f(node)		_jit_make_arg_f(_jit,node)
+static jit_node_t *_jit_make_arg_f(jit_state_t*,jit_node_t*);
+#define jit_make_arg_d(node)		_jit_make_arg_d(_jit,node)
+static jit_node_t *_jit_make_arg_d(jit_state_t*,jit_node_t*);
+#define patch(instr, node)		_patch(_jit, instr, node)
+static void _patch(jit_state_t*,jit_word_t,jit_node_t*);
+
+#define PROTO				1
+#  include "rewind.c"
+#  include "mips-cpu.c"
+#  include "mips-fpu.c"
+#undef PROTO
+
+/*
+ * Initialization
+ */
+static const jit_register_t _rvs[] = {
+    { rc(gpr) | 0x01,			"at" },
+    { rc(gpr) | 0x02,			"v0" },
+    { rc(gpr) | 0x03,			"v1" },
+#if !NEW_ABI
+    { rc(gpr) | 0x08,			"t0" },
+    { rc(gpr) | 0x09,			"t1" },
+    { rc(gpr) | 0x0a,			"t2" },
+    { rc(gpr) | 0x0b,			"t3" },
+#endif
+    { rc(gpr) | 0x0c,			"t4" },
+    { rc(gpr) | 0x0d,			"t5" },
+    { rc(gpr) | 0x0e,			"t6" },
+    { rc(gpr) | 0x0f,			"t7" },
+    { rc(gpr) | 0x18,			"t8" },
+    { rc(gpr) | 0x19,			"t9" },
+    { rc(sav) | rc(gpr) | 0x10,		"s0" },
+    { rc(sav) | rc(gpr) | 0x11,		"s1" },
+    { rc(sav) | rc(gpr) | 0x12,		"s2" },
+    { rc(sav) | rc(gpr) | 0x13,		"s3" },
+    { rc(sav) | rc(gpr) | 0x14,		"s4" },
+    { rc(sav) | rc(gpr) | 0x15,		"s5" },
+    { rc(sav) | rc(gpr) | 0x16,		"s6" },
+    { rc(sav) | rc(gpr) | 0x17,		"s7" },
+    { 0x00,				"zero" },
+    { 0x1a,				"k0" },
+    { 0x1b,				"k1" },
+    { rc(sav) | 0x1f,			"ra" },
+    { rc(sav) | 0x1c,			"gp" },
+    { rc(sav) | 0x1d,			"sp" },
+    { rc(sav) | 0x1e,			"fp" },
+#if NEW_ABI
+    { rc(gpr) | 0x0b,			"a7" },
+    { rc(gpr) | 0x0a,			"a6" },
+    { rc(gpr) | 0x09,			"a5" },
+    { rc(gpr) | 0x08,			"a4" },
+#endif
+    { rc(arg) | rc(gpr) | 0x07,		"a3" },
+    { rc(arg) | rc(gpr) | 0x06,		"a2" },
+    { rc(arg) | rc(gpr) | 0x05,		"a1" },
+    { rc(arg) | rc(gpr) | 0x04,		"a0" },
+    { rc(fpr) | 0x00,			"$f0" },
+    { rc(fpr) | 0x02,			"$f2" },
+    { rc(fpr) | 0x04,			"$f4" },
+    { rc(fpr) | 0x06,			"$f6" },
+    { rc(fpr) | 0x08,			"$f8" },
+    { rc(fpr) | 0x0a,			"$f10" },
+#if !NEW_ABI
+    { rc(sav) | rc(fpr) | 0x10,		"$f16" },
+    { rc(sav) | rc(fpr) | 0x12,		"$f18" },
+#endif
+    { rc(sav) | rc(fpr) | 0x14,		"$f20" },
+    { rc(sav) | rc(fpr) | 0x16,		"$f22" },
+    { rc(sav) | rc(fpr) | 0x18,		"$f24" },
+    { rc(sav) | rc(fpr) | 0x1a,		"$f26" },
+    { rc(sav) | rc(fpr) | 0x1c,		"$f28" },
+    { rc(sav) | rc(fpr) | 0x1e,		"$f30" },
+#if NEW_ABI
+    { rc(arg) | rc(fpr) | 0x13,		"$f19" },
+    { rc(arg) | rc(fpr) | 0x12,		"$f18" },
+    { rc(arg) | rc(fpr) | 0x11,		"$f17" },
+    { rc(arg) | rc(fpr) | 0x10,		"$f16" },
+    { rc(arg) | rc(fpr) | 0x0f,		"$f15" },
+    { rc(arg) | rc(fpr) | 0x0e,		"$f14" },
+    { rc(arg) | rc(fpr) | 0x0d,		"$f13" },
+    { rc(arg) | rc(fpr) | 0x0c,		"$f12" },
+#else
+    { rc(arg) | rc(fpr) | 0x0e,		"$f14" },
+    { rc(arg) | rc(fpr) | 0x0c,		"$f12" },
+#endif
+    { _NOREG,				"<none>" },
+};
+
+/*
+ * Implementation
+ */
+void
+jit_get_cpu(void)
+{
+}
+
+void
+_jit_init(jit_state_t *_jit)
+{
+    _jitc->reglen = jit_size(_rvs) - 1;
+/* Could also:
+ *	o reserve a register for carry	(overkill)
+ *	o use MTLO/MFLO			(performance hit)
+ * So, keep a register allocated after setting carry, and implicitly
+ * deallocate it if it can no longer be tracked
+ */
+    jit_carry = _NOREG;
+}
+
+void
+_jit_prolog(jit_state_t *_jit)
+{
+    int32_t		 offset;
+
+    if (_jitc->function)
+	jit_epilog();
+    assert(jit_regset_cmp_ui(&_jitc->regarg, 0) == 0);
+    jit_regset_set_ui(&_jitc->regsav, 0);
+    offset = _jitc->functions.offset;
+    if (offset >= _jitc->functions.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->functions.ptr,
+		    _jitc->functions.length * sizeof(jit_function_t),
+		    (_jitc->functions.length + 16) * sizeof(jit_function_t));
+	_jitc->functions.length += 16;
+    }
+    _jitc->function = _jitc->functions.ptr + _jitc->functions.offset++;
+    _jitc->function->self.size = stack_framesize;
+    _jitc->function->self.argi = _jitc->function->self.argf =
+	_jitc->function->self.aoff = _jitc->function->self.alen = 0;
+    _jitc->function->self.call = jit_call_default;
+    jit_alloc((jit_pointer_t *)&_jitc->function->regoff,
+	      _jitc->reglen * sizeof(int32_t));
+
+    /* _no_link here does not mean the jit_link() call can be removed
+     * by rewriting as:
+     * _jitc->function->prolog = jit_new_node(jit_code_prolog);
+     */
+    _jitc->function->prolog = jit_new_node_no_link(jit_code_prolog);
+    jit_link(_jitc->function->prolog);
+    _jitc->function->prolog->w.w = offset;
+    _jitc->function->epilog = jit_new_node_no_link(jit_code_epilog);
+    /*	u:	label value
+     *	v:	offset in blocks vector
+     *	w:	offset in functions vector
+     */
+    _jitc->function->epilog->w.w = offset;
+
+    jit_regset_new(&_jitc->function->regset);
+}
+
+int32_t
+_jit_allocai(jit_state_t *_jit, int32_t length)
+{
+    assert(_jitc->function);
+    switch (length) {
+	case 0:	case 1:						break;
+	case 2:		_jitc->function->self.aoff &= -2;	break;
+	case 3:	case 4:	_jitc->function->self.aoff &= -4;	break;
+	default:	_jitc->function->self.aoff &= -8;	break;
+    }
+    _jitc->function->self.aoff -= length;
+    if (!_jitc->realize) {
+	jit_inc_synth_ww(allocai, _jitc->function->self.aoff, length);
+	jit_dec_synth();
+    }
+    return (_jitc->function->self.aoff);
+}
+
+void
+_jit_allocar(jit_state_t *_jit, int32_t u, int32_t v)
+{
+    int32_t		 reg;
+    assert(_jitc->function);
+    jit_inc_synth_ww(allocar, u, v);
+    if (!_jitc->function->allocar) {
+	_jitc->function->aoffoff = jit_allocai(sizeof(int32_t));
+	_jitc->function->allocar = 1;
+    }
+    reg = jit_get_reg(jit_class_gpr);
+    jit_negr(reg, v);
+    jit_andi(reg, reg, -8);
+    jit_ldxi_i(u, JIT_FP, _jitc->function->aoffoff);
+    jit_addr(u, u, reg);
+    jit_addr(JIT_SP, JIT_SP, reg);
+    jit_stxi_i(_jitc->function->aoffoff, JIT_FP, u);
+    jit_unget_reg(reg);
+    jit_dec_synth();
+}
+
+void
+_jit_ret(jit_state_t *_jit)
+{
+    jit_node_t		*instr;
+    assert(_jitc->function);
+    jit_inc_synth(ret);
+    /* jump to epilog */
+    instr = jit_jmpi();
+    jit_patch_at(instr, _jitc->function->epilog);
+    jit_dec_synth();
+}
+
+void
+_jit_retr(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr, u);
+    if (JIT_RET != u)
+	jit_movr(JIT_RET, u);
+    jit_live(JIT_RET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti(jit_state_t *_jit, jit_word_t u)
+{
+    jit_inc_synth_w(reti, u);
+    jit_movi(JIT_RET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_f(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_f, u);
+    if (JIT_FRET != u)
+	jit_movr_f(JIT_FRET, u);
+    else
+	jit_live(JIT_FRET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_f(jit_state_t *_jit, jit_float32_t u)
+{
+    jit_inc_synth_f(reti_f, u);
+    jit_movi_f(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_d(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_d, u);
+    if (JIT_FRET != u)
+	jit_movr_d(JIT_FRET, u);
+    else
+	jit_live(JIT_FRET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_d(jit_state_t *_jit, jit_float64_t u)
+{
+    jit_inc_synth_d(reti_d, u);
+    jit_movi_d(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_epilog(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    assert(_jitc->function->epilog->next == NULL);
+    jit_link(_jitc->function->epilog);
+    _jitc->function = NULL;
+}
+
+jit_bool_t
+_jit_arg_register_p(jit_state_t *_jit, jit_node_t *u)
+{
+    if (u->code == jit_code_arg)
+	return (jit_arg_reg_p(u->u.w));
+    assert(u->code == jit_code_arg_f || u->code == jit_code_arg_d);
+#if NEW_ABI
+    return (jit_arg_reg_p(u->u.w));
+#else
+    return (u->u.w < 8);
+#endif
+}
+
+static jit_node_t *
+_jit_make_arg(jit_state_t *_jit, jit_node_t *node)
+{
+    int32_t		 offset;
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->self.argi))
+	offset = _jitc->function->self.argi++;
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += STACK_SLOT;
+    }
+#else
+    offset = (_jitc->function->self.size - stack_framesize) >> STACK_SHIFT;
+    _jitc->function->self.argi = 1;
+    if (offset >= 4)
+	offset = _jitc->function->self.size;
+    _jitc->function->self.size += STACK_SLOT;
+#endif
+    if (node == (jit_node_t *)0)
+	node = jit_new_node(jit_code_arg);
+    else
+	link_node(node);
+    node->u.w = offset;
+    node->v.w = ++_jitc->function->self.argn;
+    jit_link_prolog();
+    return (node);
+}
+
+static jit_node_t *
+_jit_make_arg_f(jit_state_t *_jit, jit_node_t *node)
+{
+    int32_t		 offset;
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->self.argi)) {
+	offset = _jitc->function->self.argi++;
+	if (_jitc->function->self.call & jit_call_varargs)
+	    offset += 8;
+    }
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += STACK_SLOT;
+    }
+#else
+    offset = (_jitc->function->self.size - stack_framesize) >> STACK_SHIFT;
+    if (offset < NUM_WORD_ARGS) {
+	if (!_jitc->function->self.argi &&
+	    !(_jitc->function->self.call & jit_call_varargs)) {
+	    if (offset == 0)
+		offset = 4;
+	    else {
+		offset = 6;
+		_jitc->function->self.argi = 1;
+	    }
+	    /* Use as flag to rewind in case of varargs function */
+	    ++_jitc->function->self.argf;
+	}
+    }
+    else
+	offset = _jitc->function->self.size;
+    _jitc->function->self.size += STACK_SLOT;
+#endif
+    if (node == (jit_node_t *)0)
+	node = jit_new_node(jit_code_arg_f);
+    else
+	link_node(node);
+    node->u.w = offset;
+    node->v.w = ++_jitc->function->self.argn;
+    jit_link_prolog();
+    return (node);
+}
+
+static jit_node_t *
+_jit_make_arg_d(jit_state_t *_jit, jit_node_t *node)
+{
+    int32_t		 offset;
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->self.argi)) {
+	offset = _jitc->function->self.argi++;
+	if (_jitc->function->self.call & jit_call_varargs)
+	    offset += 8;
+    }
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += STACK_SLOT;
+    }
+#else
+    if (_jitc->function->self.size & 7) {
+	_jitc->function->self.size += 4;
+	_jitc->function->self.argi = 1;
+    }
+    offset = (_jitc->function->self.size - stack_framesize) >> STACK_SHIFT;
+    if (offset < NUM_WORD_ARGS) {
+	if (!_jitc->function->self.argi &&
+	    !(_jitc->function->self.call & jit_call_varargs)) {
+	    offset += 4;
+	    /* Use as flag to rewind in case of varargs function */
+	    ++_jitc->function->self.argf;
+	}
+    }
+    else
+	offset = _jitc->function->self.size;
+    _jitc->function->self.size += sizeof(jit_float64_t);
+#endif
+    if (node == (jit_node_t *)0)
+	node = jit_new_node(jit_code_arg_d);
+    else
+	link_node(node);
+    node->u.w = offset;
+    node->v.w = ++_jitc->function->self.argn;
+    jit_link_prolog();
+    return (node);
+}
+
+void
+_jit_ellipsis(jit_state_t *_jit)
+{
+    if (_jitc->prepare) {
+	assert(!(_jitc->function->call.call & jit_call_varargs));
+	_jitc->function->call.call |= jit_call_varargs;
+#if !NEW_ABI
+	if (_jitc->function->call.argf)
+	    rewind_prepare();
+#endif
+    }
+    else {
+	assert(!(_jitc->function->self.call & jit_call_varargs));
+#if NEW_ABI
+	/* If varargs start in a register, allocate extra 64 bytes. */
+	if (jit_arg_reg_p(_jitc->function->self.argi))
+	    rewind_prolog();
+	/* Do not set during possible rewind. */
+	_jitc->function->self.call |= jit_call_varargs;
+#else
+	_jitc->function->self.call |= jit_call_varargs;
+	if (_jitc->function->self.argf)
+	    rewind_prolog();
+#endif
+	_jitc->function->vagp = _jitc->function->self.argi;
+    }
+    jit_inc_synth(ellipsis);
+    if (_jitc->prepare)
+	jit_link_prepare();
+    else
+	jit_link_prolog();
+    jit_dec_synth();
+}
+
+void
+_jit_va_push(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(va_push, u);
+    jit_pushargr(u);
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_arg(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    return (jit_make_arg((jit_node_t*)0));
+}
+
+jit_node_t *
+_jit_arg_f(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    return (jit_make_arg_f((jit_node_t*)0));
+}
+
+jit_node_t *
+_jit_arg_d(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    return (jit_make_arg_d((jit_node_t*)0));
+}
+
+void
+_jit_getarg_c(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_c, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_c(u, _A0 - v->u.w);
+    else
+	jit_ldxi_c(u, _FP, v->u.w + C_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_uc(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_uc, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_uc(u, _A0 - v->u.w);
+    else
+	jit_ldxi_uc(u, _FP, v->u.w + C_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_s(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_s, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_s(u, _A0 - v->u.w);
+    else
+	jit_ldxi_s(u, _FP, v->u.w + S_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_us(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_us, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_us(u, _A0 - v->u.w);
+    else
+	jit_ldxi_us(u, _FP, v->u.w + S_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_i(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_i, u, v);
+    if (jit_arg_reg_p(v->u.w)) {
+#if __WORDSIZE == 64
+	jit_extr_i(u, _A0 - v->u.w);
+#else
+	jit_movr(u, _A0 - v->u.w);
+#endif
+    }
+    else
+	jit_ldxi_i(u, _FP, v->u.w + I_DISP);
+    jit_dec_synth();
+}
+
+#if __WORDSIZE == 64
+void
+_jit_getarg_ui(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_ui, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_ui(u, _A0 - v->u.w);
+    else
+	jit_ldxi_ui(u, _FP, v->u.w + I_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_l(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_l, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(u, _A0 - v->u.w);
+    else
+	jit_ldxi_l(u, _FP, v->u.w);
+    jit_dec_synth();
+}
+#endif
+
+void
+_jit_putargr(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    jit_inc_synth_wp(putargr, u, v);
+    assert(v->code == jit_code_arg);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(_A0 - v->u.w, u);
+    else
+	jit_stxi(v->u.w + WORD_ADJUST, _FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi(jit_state_t *_jit, jit_word_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(putargi, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movi(_A0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(v->u.w + WORD_ADJUST, _FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(getarg_f, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr_f(u, _F12 - v->u.w);
+    else if (jit_arg_reg_p(v->u.w - 8))
+	jit_movr_w_f(u, _A0 - v->u.w - 8);
+#else
+    if (v->u.w < 4)
+	jit_movr_w_f(u, _A0 - v->u.w);
+    else if (v->u.w < 8)
+	jit_movr_f(u, _F12 - ((v->u.w - 4) >> 1));
+#endif
+    else
+	jit_ldxi_f(u, _FP, v->u.w);
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(putargr_f, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr_f(_F12 - v->u.w, u);
+    else if (jit_arg_reg_p(v->u.w - 8))
+	jit_movr_f_w(_A0 - v->u.w - 8, u);
+#else
+    if (v->u.w < 4)
+	jit_movr_f_w(_A0 - v->u.w, u);
+    else if (v->u.w < 8)
+	jit_movr_f(_F12 - ((v->u.w - 4) >> 1), u);
+#endif
+    else
+	jit_stxi_f(v->u.w, _FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_f(jit_state_t *_jit, jit_float32_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_fp(putargi_f, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movi_f(_F12 - v->u.w, u);
+    else if (jit_arg_reg_p(v->u.w - 8)) {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_movr_f_w(_A0 - v->u.w - 8, u);
+	jit_unget_reg(regno);
+    }
+#else
+    if (v->u.w < 4) {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_movr_f_w(_A0 - ((v->u.w - 4) >> 1), regno);
+	jit_unget_reg(regno);
+    }
+    else if (v->u.w < 8)
+	jit_movi_f(_F12 - ((v->u.w - 4) >> 1), u);
+#endif
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_stxi_f(v->u.w, _FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(getarg_d, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr_d(u, _F12 - v->u.w);
+    else if (jit_arg_reg_p(v->u.w - 8))
+	jit_movr_d_w(_A0 - v->u.w - 8, u);
+#else
+    if (v->u.w < 4)
+	jit_movr_ww_d(u, _A0 - v->u.w, _A0 - (v->u.w + 1));
+    else if (v->u.w < 8)
+	jit_movr_d(u, _F12 - ((v->u.w - 4) >> 1));
+#endif
+    else
+	jit_ldxi_d(u, _FP, v->u.w);
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(putargr_d, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr_d(_F12 - v->u.w, u);
+    else if (jit_arg_reg_p(v->u.w - 8))
+	jit_movr_d_w(_A0 - v->u.w - 8, u);
+#else
+    if (v->u.w < 4)
+	jit_movr_d_ww(_A0 - v->u.w, _A0 - (v->u.w + 1), u);
+    else if (v->u.w < 8)
+	jit_movr_d(_F12 - ((v->u.w - 4) >> 1), u);
+#endif
+    else
+	jit_stxi_d(v->u.w, _FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_d(jit_state_t *_jit, jit_float64_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_dp(putargi_d, u, v);
+#if NEW_ABI
+    if (jit_arg_reg_p(v->u.w))
+	jit_movi_d(_F12 - v->u.w, u);
+    else if (jit_arg_reg_p(v->u.w - 8)) {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_movr_d_w(_A0 - v->u.w - 8, u);
+	jit_unget_reg(regno);
+    }
+#else
+    if (v->u.w < 4) {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_movr_d_ww(_A0 - v->u.w, _A0 - (v->u.w + 1), regno);
+	jit_unget_reg(regno);
+    }
+    else if (v->u.w < 8)
+	jit_movi_d(_F12 - ((v->u.w - 4) >> 1), u);
+#endif
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_d(v->u.w, _FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(pushargr, u);
+    jit_link_prepare();
+#if NEW_ABI
+    assert(_jitc->function);
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movr(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	jit_stxi(_jitc->function->call.size + WORD_ADJUST, JIT_SP, u);
+	_jitc->function->call.size += STACK_SLOT;
+    }
+#else
+    jit_word_t		offset;
+    assert(_jitc->function);
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    _jitc->function->call.argi = 1;
+    if (jit_arg_reg_p(offset))
+	jit_movr(_A0 - offset, u);
+    else
+	jit_stxi(_jitc->function->call.size, JIT_SP, u);
+    _jitc->function->call.size += STACK_SLOT;
+#endif
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi(jit_state_t *_jit, jit_word_t u)
+{
+    int32_t		regno;
+#if !NEW_ABI
+    jit_word_t		offset;
+#endif
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargi, u);
+    jit_link_prepare();
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movi(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(_jitc->function->call.size + WORD_ADJUST, JIT_SP, regno);
+	_jitc->function->call.size += STACK_SLOT;
+	jit_unget_reg(regno);
+    }
+#else
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    ++_jitc->function->call.argi;
+    if (jit_arg_reg_p(offset))
+	jit_movi(_A0 - offset, u);
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(_jitc->function->call.size, JIT_SP, regno);
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += STACK_SLOT;
+#endif
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_f(jit_state_t *_jit, int32_t u)
+{
+#if !NEW_ABI
+    jit_word_t		offset;
+#endif
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_f, u);
+    jit_link_prepare();
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	if (!(_jitc->function->call.call & jit_call_varargs))
+	    jit_movr_f(_F12 - _jitc->function->call.argi, u);
+	else
+	    jit_movr_f_w(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	jit_stxi_f(_jitc->function->call.size, JIT_SP, u);
+	_jitc->function->call.size += STACK_SLOT;
+    }
+#else
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    if (offset < 2 && !_jitc->function->call.argi &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	++_jitc->function->call.argf;
+	jit_movr_f(_F12 - offset, u);
+    }
+    else if (offset < 4) {
+	++_jitc->function->call.argi;
+	jit_movr_f_w(_A0 - offset, u);
+    }
+    else
+	jit_stxi_f(_jitc->function->call.size, JIT_SP, u);
+    _jitc->function->call.size += STACK_SLOT;
+#endif
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_f(jit_state_t *_jit, jit_float32_t u)
+{
+    int32_t		regno;
+#if !NEW_ABI
+    jit_word_t		offset;
+#endif
+    assert(_jitc->function);
+    jit_inc_synth_f(pushargi_f, u);
+    jit_link_prepare();
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	if (!(_jitc->function->call.call & jit_call_varargs))
+	    jit_movi_f(_F12 - _jitc->function->call.argi, u);
+	else
+	    jit_movi_f_w(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_stxi_f(_jitc->function->call.size, JIT_SP, regno);
+	_jitc->function->call.size += STACK_SLOT;
+	jit_unget_reg(regno);
+    }
+#else
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    if (offset < 2 && !_jitc->function->call.argi &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	++_jitc->function->call.argf;
+	jit_movi_f(_F12 - offset, u);
+    }
+    else if (offset < 4) {
+	++_jitc->function->call.argi;
+	jit_movi_f_w(_A0 - offset, u);
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_stxi_f(_jitc->function->call.size, JIT_SP, regno);
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += STACK_SLOT;
+#endif
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_d(jit_state_t *_jit, int32_t u)
+{
+#if !NEW_ABI
+    jit_bool_t		adjust;
+    jit_word_t		offset;
+#endif
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_d, u);
+    jit_link_prepare();
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	if (!(_jitc->function->call.call & jit_call_varargs))
+	    jit_movr_d(_F12 - _jitc->function->call.argi, u);
+	else
+	    jit_movr_d_w(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	jit_stxi_d(_jitc->function->call.size, JIT_SP, u);
+	_jitc->function->call.size += STACK_SLOT;
+    }
+#else
+    adjust = !!_jitc->function->call.argi;
+    if (_jitc->function->call.size & 7) {
+	_jitc->function->call.size += 4;
+	adjust = 1;
+    }
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    if (offset < 3) {
+	if (adjust || (_jitc->function->call.call & jit_call_varargs)) {
+	    jit_movr_d_ww(_A0 - offset, _A0 - (offset + 1), u);
+	    _jitc->function->call.argi += 2;
+	}
+	else {
+	    jit_movr_d(_F12 - (offset >> 1), u);
+	    ++_jitc->function->call.argf;
+	}
+    }
+    else
+	jit_stxi_d(_jitc->function->call.size, JIT_SP, u);
+    _jitc->function->call.size += sizeof(jit_float64_t);
+#endif
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_d(jit_state_t *_jit, jit_float64_t u)
+{
+    int32_t		regno;
+#if !NEW_ABI
+    jit_bool_t		adjust;
+    jit_word_t		offset;
+#endif
+    assert(_jitc->function);
+    jit_inc_synth_d(pushargi_d, u);
+    jit_link_prepare();
+#if NEW_ABI
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	if (!(_jitc->function->call.call & jit_call_varargs))
+	    jit_movi_d(_F12 - _jitc->function->call.argi, u);
+	else
+	    jit_movi_d_w(_A0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_d(_jitc->function->call.size, JIT_SP, regno);
+	_jitc->function->call.size += STACK_SLOT;
+	jit_unget_reg(regno);
+    }
+#else
+    adjust = !!_jitc->function->call.argi;
+    if (_jitc->function->call.size & 7) {
+	_jitc->function->call.size += 4;
+	adjust = 1;
+    }
+    offset = _jitc->function->call.size >> STACK_SHIFT;
+    if (offset < 3) {
+	if (adjust || (_jitc->function->call.call & jit_call_varargs)) {
+	    jit_movi_d_ww(_A0 - offset, _A0 - (offset + 1), u);
+	    _jitc->function->call.argi += 2;
+	}
+	else {
+	    jit_movi_d(_F12 - (offset >> 1), u);
+	    ++_jitc->function->call.argf;
+	}
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_d(_jitc->function->call.size, JIT_SP, regno);
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += sizeof(jit_float64_t);
+#endif
+    jit_dec_synth();
+}
+
+jit_bool_t
+_jit_regarg_p(jit_state_t *_jit, jit_node_t *node, int32_t regno)
+{
+    int32_t		spec;
+
+    spec = jit_class(_rvs[regno].spec);
+    if (spec & jit_class_arg) {
+	if (spec & jit_class_gpr) {
+	    regno = _A0 - regno;
+	    if (regno >= 0 && regno < node->v.w)
+		return (1);
+	}
+	else if (spec & jit_class_fpr) {
+	    regno = _F12 - regno;
+	    if (regno >= 0 && regno < node->w.w)
+		return (1);
+	}
+    }
+
+    return (0);
+}
+
+void
+_jit_finishr(jit_state_t *_jit, int32_t r0)
+{
+    jit_node_t		*call;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishr, r0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    jit_movr(_T9, r0);
+    call = jit_callr(_T9);
+    call->v.w = _jitc->function->self.argi;
+#if NEW_ABI
+    call->w.w = call->v.w;
+#else
+    call->w.w = _jitc->function->self.argf;
+#endif
+    _jitc->function->call.argi = _jitc->function->call.argf =
+	_jitc->function->call.size = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_finishi(jit_state_t *_jit, jit_pointer_t i0)
+{
+    jit_node_t		*call;
+    jit_node_t		*node;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishi, (jit_word_t)i0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    node = jit_movi(_T9, (jit_word_t)i0);
+    call = jit_callr(_T9);
+    call->v.w = _jitc->function->call.argi;
+#if NEW_ABI
+    call->w.w = call->v.w;
+#else
+    call->w.w = _jitc->function->call.argf;
+#endif
+    _jitc->function->call.argi = _jitc->function->call.argf =
+	_jitc->function->call.size = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+    return (node);
+}
+
+void
+_jit_retval_c(jit_state_t *_jit, int32_t r0)
+{
+    jit_extr_c(r0, JIT_RET);
+}
+
+void
+_jit_retval_uc(jit_state_t *_jit, int32_t r0)
+{
+    jit_extr_uc(r0, JIT_RET);
+}
+
+void
+_jit_retval_s(jit_state_t *_jit, int32_t r0)
+{
+    jit_extr_s(r0, JIT_RET);
+}
+
+void
+_jit_retval_us(jit_state_t *_jit, int32_t r0)
+{
+    jit_extr_us(r0, JIT_RET);
+}
+
+void
+_jit_retval_i(jit_state_t *_jit, int32_t r0)
+{
+#if __WORDSIZE == 32
+    if (r0 != JIT_RET)
+	jit_movr(r0, JIT_RET);
+#else
+    jit_extr_i(r0, JIT_RET);
+#endif
+}
+
+#if __WORDSIZE == 64
+void
+_jit_retval_ui(jit_state_t *_jit, int32_t r0)
+{
+    jit_extr_ui(r0, JIT_RET);
+}
+
+void
+_jit_retval_l(jit_state_t *_jit, int32_t r0)
+{
+    if (r0 != JIT_RET)
+	jit_movr(r0, JIT_RET);
+}
+#endif
+
+void
+_jit_retval_f(jit_state_t *_jit, int32_t r0)
+{
+    if (r0 != JIT_FRET)
+	jit_movr_f(r0, JIT_FRET);
+}
+
+void
+_jit_retval_d(jit_state_t *_jit, int32_t r0)
+{
+    if (r0 != JIT_FRET)
+	jit_movr_d(r0, JIT_FRET);
+}
+
+jit_pointer_t
+_emit_code(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    jit_node_t		*temp;
+    jit_word_t		 word;
+    int32_t		 value;
+    int32_t		 offset;
+    struct {
+	jit_node_t	*node;
+	jit_word_t	 word;
+#if DEVEL_DISASSEMBLER
+	jit_word_t	 prevw;
+#endif
+	int32_t	 patch_offset;
+    } undo;
+#if DEVEL_DISASSEMBLER
+    jit_word_t		 prevw;
+#endif
+
+    _jitc->function = NULL;
+
+    jit_reglive_setup();
+
+    undo.word = 0;
+    undo.node = NULL;
+    undo.patch_offset = 0;
+#define case_rr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w), rn(node->v.w));		\
+		break
+#define case_rw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), node->v.w);		\
+		break
+#define case_wr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w));		\
+		break
+#define case_rrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w),				\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), rn(node->v.w), node->w.w);	\
+		break
+#define case_rrrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), node->w.w);		\
+		break
+#define case_rrf(name, type, size)					\
+	    case jit_code_##name##i##type:				\
+		assert(node->flag & jit_flag_data);			\
+		name##i##type(rn(node->u.w), rn(node->v.w),		\
+			      (jit_float##size##_t *)node->w.n->u.w);	\
+		break
+#define case_wrr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w), rn(node->w.w));	\
+		break
+#define case_brr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##r##type(temp->u.w, rn(node->v.w),		\
+				  rn(node->w.w));			\
+		else {							\
+		    word = name##r##type(_jit->pc.w,			\
+					 rn(node->v.w), rn(node->w.w));	\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i##type(temp->u.w,				\
+				  rn(node->v.w), node->w.w);		\
+		else {							\
+		    word = name##i##type(_jit->pc.w,			\
+					 rn(node->v.w), node->w.w);	\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brf(name, type, size)					\
+	    case jit_code_##name##i##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i##type(temp->u.w, rn(node->v.w),		\
+				(jit_float##size##_t *)node->w.n->u.w);	\
+		else {							\
+		    word = name##i##type(_jit->pc.w, rn(node->v.w),	\
+				(jit_float##size##_t *)node->w.n->u.w);	\
+		    patch(word, node);					\
+		}							\
+		break
+#if DEVEL_DISASSEMBLER
+    prevw = _jit->pc.w;
+#endif
+    for (node = _jitc->head; node; node = node->next) {
+	if (_jit->pc.uc >= _jitc->code.end)
+	    return (NULL);
+
+#if DEVEL_DISASSEMBLER
+	node->offset = (jit_uword_t)_jit->pc.w - (jit_uword_t)prevw;
+	prevw = _jit->pc.w;
+#endif
+	value = jit_classify(node->code);
+	jit_regarg_set(node, value);
+	switch (node->code) {
+	    case jit_code_align:
+		assert(!(node->u.w & (node->u.w - 1)) &&
+		       node->u.w <= sizeof(jit_word_t));
+		if (node->u.w == sizeof(jit_word_t) &&
+		    (word = _jit->pc.w & (sizeof(jit_word_t) - 1)))
+		    nop(sizeof(jit_word_t) - word);
+		break;
+	    case jit_code_note:		case jit_code_name:
+		node->u.w = _jit->pc.w;
+		break;
+	    case jit_code_label:
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		break;
+		case_rrr(add,);
+		case_rrw(add,);
+		case_rrr(addc,);
+		case_rrw(addc,);
+		case_rrr(addx,);
+		case_rrw(addx,);
+		case_rrr(sub,);
+		case_rrw(sub,);
+		case_rrr(subc,);
+		case_rrw(subc,);
+		case_rrr(subx,);
+		case_rrw(subx,);
+		case_rrw(rsb,);
+		case_rrr(mul,);
+		case_rrw(mul,);
+		case_rrrr(qmul,);
+		case_rrrw(qmul,);
+		case_rrrr(qmul, _u);
+		case_rrrw(qmul, _u);
+		case_rrr(div,);
+		case_rrw(div,);
+		case_rrr(div, _u);
+		case_rrw(div, _u);
+		case_rrrr(qdiv,);
+		case_rrrw(qdiv,);
+		case_rrrr(qdiv, _u);
+		case_rrrw(qdiv, _u);
+		case_rrr(rem,);
+		case_rrw(rem,);
+		case_rrr(rem, _u);
+		case_rrw(rem, _u);
+		case_rrr(lsh,);
+		case_rrw(lsh,);
+		case_rrr(rsh,);
+		case_rrw(rsh,);
+		case_rrr(rsh, _u);
+		case_rrw(rsh, _u);
+		case_rrr(and,);
+		case_rrw(and,);
+		case_rrr(or,);
+		case_rrw(or,);
+		case_rrr(xor,);
+		case_rrw(xor,);
+		case_rr(trunc, _f_i);
+		case_rr(trunc, _d_i);
+#if __WORDSIZE == 64
+		case_rr(trunc, _f_l);
+		case_rr(trunc, _d_l);
+#endif
+		case_rr(ld, _c);
+		case_rw(ld, _c);
+		case_rr(ld, _uc);
+		case_rw(ld, _uc);
+		case_rr(ld, _s);
+		case_rw(ld, _s);
+		case_rr(ld, _us);
+		case_rw(ld, _us);
+		case_rr(ld, _i);
+		case_rw(ld, _i);
+#if __WORDSIZE == 64
+		case_rr(ld, _ui);
+		case_rw(ld, _ui);
+		case_rr(ld, _l);
+		case_rw(ld, _l);
+#endif
+		case_rrr(ldx, _c);
+		case_rrw(ldx, _c);
+		case_rrr(ldx, _uc);
+		case_rrw(ldx, _uc);
+		case_rrr(ldx, _s);
+		case_rrw(ldx, _s);
+		case_rrr(ldx, _us);
+		case_rrw(ldx, _us);
+		case_rrr(ldx, _i);
+		case_rrw(ldx, _i);
+#if __WORDSIZE == 64
+		case_rrr(ldx, _ui);
+		case_rrw(ldx, _ui);
+		case_rrr(ldx, _l);
+		case_rrw(ldx, _l);
+#endif
+		case_rr(st, _c);
+		case_wr(st, _c);
+		case_rr(st, _s);
+		case_wr(st, _s);
+		case_rr(st, _i);
+		case_wr(st, _i);
+#if __WORDSIZE == 64
+		case_rr(st, _l);
+		case_wr(st, _l);
+#endif
+		case_rrr(stx, _c);
+		case_wrr(stx, _c);
+		case_rrr(stx, _s);
+		case_wrr(stx, _s);
+		case_rrr(stx, _i);
+		case_wrr(stx, _i);
+#if __WORDSIZE == 64
+		case_rrr(stx, _l);
+		case_wrr(stx, _l);
+#endif
+		case_rr(hton, _us);
+		case_rr(hton, _ui);
+#if __WORDSIZE == 64
+		case_rr(hton, _ul);
+#endif
+		case_rr(ext, _c);
+		case_rr(ext, _uc);
+		case_rr(ext, _s);
+		case_rr(ext, _us);
+#if __WORDSIZE == 64
+		case_rr(ext, _i);
+		case_rr(ext, _ui);
+#endif
+		case_rr(mov,);
+	    case jit_code_movi:
+		if (node->flag & jit_flag_node) {
+		    temp = node->v.n;
+		    if (temp->code == jit_code_data ||
+			(temp->code == jit_code_label &&
+			 (temp->flag & jit_flag_patch)))
+			movi(rn(node->u.w), temp->u.w);
+		    else {
+			assert(temp->code == jit_code_label ||
+			       temp->code == jit_code_epilog);
+			word = movi_p(rn(node->u.w), node->v.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    movi(rn(node->u.w), node->v.w);
+		break;
+		case_rr(neg,);
+		case_rr(com,);
+		case_rrr(lt,);
+		case_rrw(lt,);
+		case_rrr(lt, _u);
+		case_rrw(lt, _u);
+		case_rrr(le,);
+		case_rrw(le,);
+		case_rrr(le, _u);
+		case_rrw(le, _u);
+		case_rrr(eq,);
+		case_rrw(eq,);
+		case_rrr(ge,);
+		case_rrw(ge,);
+		case_rrr(ge, _u);
+		case_rrw(ge, _u);
+		case_rrr(gt,);
+		case_rrw(gt,);
+		case_rrr(gt, _u);
+		case_rrw(gt, _u);
+		case_rrr(ne,);
+		case_rrw(ne,);
+		case_brr(blt,);
+		case_brw(blt,);
+		case_brr(blt, _u);
+		case_brw(blt, _u);
+		case_brr(ble,);
+		case_brw(ble,);
+		case_brr(ble, _u);
+		case_brw(ble, _u);
+		case_brr(beq,);
+		case_brw(beq,);
+		case_brr(bge,);
+		case_brw(bge,);
+		case_brr(bge, _u);
+		case_brw(bge, _u);
+		case_brr(bgt,);
+		case_brw(bgt,);
+		case_brr(bgt, _u);
+		case_brw(bgt, _u);
+		case_brr(bne,);
+		case_brw(bne,);
+		case_brr(boadd,);
+		case_brw(boadd,);
+		case_brr(boadd, _u);
+		case_brw(boadd, _u);
+		case_brr(bxadd,);
+		case_brw(bxadd,);
+		case_brr(bxadd, _u);
+		case_brw(bxadd, _u);
+		case_brr(bosub,);
+		case_brw(bosub,);
+		case_brr(bosub, _u);
+		case_brw(bosub, _u);
+		case_brr(bxsub,);
+		case_brw(bxsub,);
+		case_brr(bxsub, _u);
+		case_brw(bxsub, _u);
+		case_brr(bms,);
+		case_brw(bms,);
+		case_brr(bmc,);
+		case_brw(bmc,);
+		case_rrr(add, _f);
+		case_rrf(add, _f, 32);
+		case_rrr(sub, _f);
+		case_rrf(sub, _f, 32);
+		case_rrf(rsb, _f, 32);
+		case_rrr(mul, _f);
+		case_rrf(mul, _f, 32);
+		case_rrr(div, _f);
+		case_rrf(div, _f, 32);
+		case_rr(abs, _f);
+		case_rr(neg, _f);
+		case_rr(sqrt, _f);
+		case_rr(ext, _f);
+		case_rr(ld, _f);
+		case_rw(ld, _f);
+		case_rrr(ldx, _f);
+		case_rrw(ldx, _f);
+		case_rr(st, _f);
+		case_wr(st, _f);
+		case_rrr(stx, _f);
+		case_wrr(stx, _f);
+		case_rr(mov, _f);
+	    case jit_code_movi_f:
+		assert(node->flag & jit_flag_data);
+		movi_f(rn(node->u.w), (jit_float32_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _d_f);
+		case_rrr(lt, _f);
+		case_rrf(lt, _f, 32);
+		case_rrr(le, _f);
+		case_rrf(le, _f, 32);
+		case_rrr(eq, _f);
+		case_rrf(eq, _f, 32);
+		case_rrr(ge, _f);
+		case_rrf(ge, _f, 32);
+		case_rrr(gt, _f);
+		case_rrf(gt, _f, 32);
+		case_rrr(ne, _f);
+		case_rrf(ne, _f, 32);
+		case_rrr(unlt, _f);
+		case_rrf(unlt, _f, 32);
+		case_rrr(unle, _f);
+		case_rrf(unle, _f, 32);
+		case_rrr(uneq, _f);
+		case_rrf(uneq, _f, 32);
+		case_rrr(unge, _f);
+		case_rrf(unge, _f, 32);
+		case_rrr(ungt, _f);
+		case_rrf(ungt, _f, 32);
+		case_rrr(ltgt, _f);
+		case_rrf(ltgt, _f, 32);
+		case_rrr(ord, _f);
+		case_rrf(ord, _f, 32);
+		case_rrr(unord, _f);
+		case_rrf(unord, _f, 32);
+		case_brr(blt, _f);
+		case_brf(blt, _f, 32);
+		case_brr(ble, _f);
+		case_brf(ble, _f, 32);
+		case_brr(beq, _f);
+		case_brf(beq, _f, 32);
+		case_brr(bge, _f);
+		case_brf(bge, _f, 32);
+		case_brr(bgt, _f);
+		case_brf(bgt, _f, 32);
+		case_brr(bne, _f);
+		case_brf(bne, _f, 32);
+		case_brr(bunlt, _f);
+		case_brf(bunlt, _f, 32);
+		case_brr(bunle, _f);
+		case_brf(bunle, _f, 32);
+		case_brr(buneq, _f);
+		case_brf(buneq, _f, 32);
+		case_brr(bunge, _f);
+		case_brf(bunge, _f, 32);
+		case_brr(bungt, _f);
+		case_brf(bungt, _f, 32);
+		case_brr(bltgt, _f);
+		case_brf(bltgt, _f, 32);
+		case_brr(bord, _f);
+		case_brf(bord, _f, 32);
+		case_brr(bunord, _f);
+		case_brf(bunord, _f, 32);
+		case_rrr(add, _d);
+		case_rrf(add, _d, 64);
+		case_rrr(sub, _d);
+		case_rrf(sub, _d, 64);
+		case_rrf(rsb, _d, 64);
+		case_rrr(mul, _d);
+		case_rrf(mul, _d, 64);
+		case_rrr(div, _d);
+		case_rrf(div, _d, 64);
+		case_rr(abs, _d);
+		case_rr(neg, _d);
+		case_rr(sqrt, _d);
+		case_rr(ext, _d);
+		case_rr(ld, _d);
+		case_rw(ld, _d);
+		case_rrr(ldx, _d);
+		case_rrw(ldx, _d);
+		case_rr(st, _d);
+		case_wr(st, _d);
+		case_rrr(stx, _d);
+		case_wrr(stx, _d);
+		case_rr(mov, _d);
+	    case jit_code_movi_d:
+		assert(node->flag & jit_flag_data);
+		movi_d(rn(node->u.w), (jit_float64_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _f_d);
+		case_rrr(lt, _d);
+		case_rrf(lt, _d, 64);
+		case_rrr(le, _d);
+		case_rrf(le, _d, 64);
+		case_rrr(eq, _d);
+		case_rrf(eq, _d, 64);
+		case_rrr(ge, _d);
+		case_rrf(ge, _d, 64);
+		case_rrr(gt, _d);
+		case_rrf(gt, _d, 64);
+		case_rrr(ne, _d);
+		case_rrf(ne, _d, 64);
+		case_rrr(unlt, _d);
+		case_rrf(unlt, _d, 64);
+		case_rrr(unle, _d);
+		case_rrf(unle, _d, 64);
+		case_rrr(uneq, _d);
+		case_rrf(uneq, _d, 64);
+		case_rrr(unge, _d);
+		case_rrf(unge, _d, 64);
+		case_rrr(ungt, _d);
+		case_rrf(ungt, _d, 64);
+		case_rrr(ltgt, _d);
+		case_rrf(ltgt, _d, 64);
+		case_rrr(ord, _d);
+		case_rrf(ord, _d, 64);
+		case_rrr(unord, _d);
+		case_rrf(unord, _d, 64);
+		case_brr(blt, _d);
+		case_brf(blt, _d, 64);
+		case_brr(ble, _d);
+		case_brf(ble, _d, 64);
+		case_brr(beq, _d);
+		case_brf(beq, _d, 64);
+		case_brr(bge, _d);
+		case_brf(bge, _d, 64);
+		case_brr(bgt, _d);
+		case_brf(bgt, _d, 64);
+		case_brr(bne, _d);
+		case_brf(bne, _d, 64);
+		case_brr(bunlt, _d);
+		case_brf(bunlt, _d, 64);
+		case_brr(bunle, _d);
+		case_brf(bunle, _d, 64);
+		case_brr(buneq, _d);
+		case_brf(buneq, _d, 64);
+		case_brr(bunge, _d);
+		case_brf(bunge, _d, 64);
+		case_brr(bungt, _d);
+		case_brf(bungt, _d, 64);
+		case_brr(bltgt, _d);
+		case_brf(bltgt, _d, 64);
+		case_brr(bord, _d);
+		case_brf(bord, _d, 64);
+		case_brr(bunord, _d);
+		case_brf(bunord, _d, 64);
+	    case jit_code_jmpr:
+		jmpr(rn(node->u.w));
+		break;
+	    case jit_code_jmpi:
+		if (node->flag & jit_flag_node) {
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    if (temp->flag & jit_flag_patch)
+			jmpi(temp->u.w);
+		    else {
+			word = jmpi(_jit->pc.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    jmpi(node->u.w);
+		break;
+	    case jit_code_callr:
+		callr(rn(node->u.w));
+		break;
+	    case jit_code_calli:
+		if (node->flag & jit_flag_node) {
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    word = calli_p(temp->u.w);
+		    if (!(temp->flag & jit_flag_patch))
+			patch(word, node);
+		}
+		else
+		    calli(node->u.w);
+		break;
+	    case jit_code_prolog:
+		_jitc->function = _jitc->functions.ptr + node->w.w;
+		undo.node = node;
+		undo.word = _jit->pc.w;
+#if DEVEL_DISASSEMBLER
+		undo.prevw = prevw;
+#endif
+		undo.patch_offset = _jitc->patches.offset;
+	    restart_function:
+		_jitc->again = 0;
+		prolog(node);
+		break;
+	    case jit_code_epilog:
+		assert(_jitc->function == _jitc->functions.ptr + node->w.w);
+		if (_jitc->again) {
+		    for (temp = undo.node->next;
+			 temp != node; temp = temp->next) {
+			if (temp->code == jit_code_label ||
+			    temp->code == jit_code_epilog)
+			    temp->flag &= ~jit_flag_patch;
+		    }
+		    temp->flag &= ~jit_flag_patch;
+		    node = undo.node;
+		    _jit->pc.w = undo.word;
+#if DEVEL_DISASSEMBLER
+		    prevw = undo.prevw;
+#endif
+		    _jitc->patches.offset = undo.patch_offset;
+		    goto restart_function;
+		}
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		epilog(node);
+		_jitc->function = NULL;
+		break;
+#if !NEW_ABI
+	    case jit_code_movr_w_f:
+		movr_w_f(rn(node->u.w), rn(node->v.w));
+		break;
+#endif
+	    case jit_code_movr_f_w:
+		movr_f_w(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_movi_f_w:
+		assert(node->flag & jit_flag_data);
+		movi_f_w(rn(node->u.w), (jit_float32_t *)node->v.n->u.w);
+		break;
+#if NEW_ABI
+	    case jit_code_movr_d_w:
+		movr_d_w(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_movi_d_w:
+		assert(node->flag & jit_flag_data);
+		movi_d_w(rn(node->u.w), (jit_float64_t *)node->v.n->u.w);
+		break;
+#else
+	    case jit_code_movr_ww_d:
+		movr_ww_d(rn(node->u.w), rn(node->v.w), rn(node->w.w));
+		break;
+	    case jit_code_movr_d_ww:
+		movr_d_ww(rn(node->u.w), rn(node->v.w), rn(node->w.w));
+		break;
+	    case jit_code_movi_d_ww:
+		assert(node->flag & jit_flag_data);
+		movi_d_ww(rn(node->u.w), rn(node->v.w),
+			  (jit_float64_t *)node->w.n->u.w);
+		break;
+#endif
+	    case jit_code_va_start:
+		vastart(rn(node->u.w));
+		break;
+	    case jit_code_va_arg:
+		vaarg(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_va_arg_d:
+		vaarg_d(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_live:
+	    case jit_code_arg:			case jit_code_ellipsis:
+	    case jit_code_va_push:
+	    case jit_code_allocai:		case jit_code_allocar:
+	    case jit_code_arg_f:		case jit_code_arg_d:
+	    case jit_code_va_end:
+	    case jit_code_ret:
+	    case jit_code_retr:			case jit_code_reti:
+	    case jit_code_retr_f:		case jit_code_reti_f:
+	    case jit_code_retr_d:		case jit_code_reti_d:
+	    case jit_code_getarg_c:		case jit_code_getarg_uc:
+	    case jit_code_getarg_s:		case jit_code_getarg_us:
+	    case jit_code_getarg_i:
+#if __WORDSIZE == 64
+	    case jit_code_getarg_ui:		case jit_code_getarg_l:
+#endif
+	    case jit_code_getarg_f:		case jit_code_getarg_d:
+	    case jit_code_putargr:		case jit_code_putargi:
+	    case jit_code_putargr_f:		case jit_code_putargi_f:
+	    case jit_code_putargr_d:		case jit_code_putargi_d:
+	    case jit_code_pushargr:		case jit_code_pushargi:
+	    case jit_code_pushargr_f:		case jit_code_pushargi_f:
+	    case jit_code_pushargr_d:		case jit_code_pushargi_d:
+	    case jit_code_retval_c:		case jit_code_retval_uc:
+	    case jit_code_retval_s:		case jit_code_retval_us:
+	    case jit_code_retval_i:
+#if __WORDSIZE == 64
+	    case jit_code_retval_ui:		case jit_code_retval_l:
+#endif
+	    case jit_code_retval_f:		case jit_code_retval_d:
+	    case jit_code_prepare:
+	    case jit_code_finishr:		case jit_code_finishi:
+		break;
+	    default:
+		abort();
+	}
+	if (jit_carry != _NOREG) {
+	    switch (node->code) {
+		case jit_code_note:
+		case jit_code_addcr:		case jit_code_addci:
+		case jit_code_addxr:		case jit_code_addxi:
+		case jit_code_subcr:		case jit_code_subci:
+		case jit_code_subxr:		case jit_code_subxi:
+		    break;
+		default:
+		    jit_unget_reg(jit_carry);
+		    jit_carry = _NOREG;
+		    break;
+	    }
+	}
+	jit_regarg_clr(node, value);
+	assert(_jitc->regarg == jit_carry == _NOREG ? 0 : (1 << jit_carry));
+	assert(_jitc->synth == 0);
+	/* update register live state */
+	jit_reglive(node);
+    }
+#undef case_brf
+#undef case_brw
+#undef case_brr
+#undef case_wrr
+#undef case_rrf
+#undef case_rrw
+#undef case_rrr
+#undef case_wr
+#undef case_rw
+#undef case_rr
+
+    for (offset = 0; offset < _jitc->patches.offset; offset++) {
+	node = _jitc->patches.ptr[offset].node;
+	word = node->code == jit_code_movi ? node->v.n->u.w : node->u.n->u.w;
+	patch_at(_jitc->patches.ptr[offset].inst, word);
+    }
+
+    jit_flush(_jit->code.ptr, _jit->pc.uc);
+
+    return (_jit->code.ptr);
+}
+
+#define CODE				1
+#  include "rewind.c"
+#  include "mips-cpu.c"
+#  include ", 2018mips-fpu.c"
+#undef CODE
+
+void
+jit_flush(void *fptr, void *tptr)
+{
+#if defined(__linux__)
+    jit_word_t		f, t, s;
+
+    s = sysconf(_SC_PAGE_SIZE);
+    f = (jit_word_t)fptr & -s;
+    t = (((jit_word_t)tptr) + s - 1) & -s;
+    _flush_cache((void *)f, t - f, ICACHE);
+#endif
+}
+
+void
+_emit_ldxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    ldxi(rn(r0), rn(r1), i0);
+}
+
+void
+_emit_stxi(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    stxi(i0, rn(r0), rn(r1));
+}
+
+void
+_emit_ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    ldxi_d(rn(r0), rn(r1), i0);
+}
+
+void
+_emit_stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    stxi_d(i0, rn(r0), rn(r1));
+}
+
+static void
+_patch(jit_state_t *_jit, jit_word_t instr, jit_node_t *node)
+{
+    int32_t		 flag;
+
+    assert(node->flag & jit_flag_node);
+    if (node->code == jit_code_movi)
+	flag = node->v.n->flag;
+    else
+	flag = node->u.n->flag;
+    assert(!(flag & jit_flag_patch));
+    if (_jitc->patches.offset >= _jitc->patches.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->patches.ptr,
+		    _jitc->patches.length * sizeof(jit_patch_t),
+		    (_jitc->patches.length + 1024) * sizeof(jit_patch_t));
+	_jitc->patches.length += 1024;
+    }
+    _jitc->patches.ptr[_jitc->patches.offset].inst = instr;
+    _jitc->patches.ptr[_jitc->patches.offset].node = node;
+    ++_jitc->patches.offset;
+}
diff --git a/libguile/lightening/lightening/mips.h b/libguile/lightening/lightening/mips.h
new file mode 100644
index 000000000..e669966aa
--- /dev/null
+++ b/libguile/lightening/lightening/mips.h
@@ -0,0 +1,115 @@
+/*
+ * Copyright (C) 2012-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_mips_h
+#define _jit_mips_h
+
+#define JIT_HASH_CONSTS		1
+#define JIT_NUM_OPERANDS	3
+
+#if _MIPS_SIM != _ABIO32
+#    define NEW_ABI		1
+#endif
+
+/*
+ * Types
+ */
+#define JIT_FP			_FP
+typedef enum {
+#define jit_r(i)		(_V0 + (i))
+#if NEW_ABI
+#  define jit_r_num()		7
+#else
+#  define jit_r_num()		11
+#endif
+#define jit_v(i)		(_S0 + (i))
+#define jit_v_num()		8
+#define jit_f(i)		(_F0 + (i))
+#if NEW_ABI
+#  define jit_f_num()		6
+#else
+#  define jit_f_num()		8
+#endif
+    _AT,
+#define JIT_R0			_V0
+#define JIT_R1			_V1
+#if NEW_ABI
+#  define JIT_R2		_T4
+#  define JIT_R3		_T5
+#  define JIT_R4		_T6
+#  define JIT_R5		_T7
+#  define JIT_R6		_T8
+#else
+#  define JIT_R2		_T0
+#  define JIT_R3		_T1
+#  define JIT_R4		_T2
+#  define JIT_R5		_T3
+#  define JIT_R6		_T4
+#  define JIT_R7		_T5
+#  define JIT_R8		_T6
+#  define JIT_R9		_T7
+#  define JIT_R10		_T8
+#endif
+    _V0, _V1,
+#if !NEW_ABI
+    _T0, _T1, _T2, _T3,
+#endif
+    _T4, _T5, _T6, _T7, _T8, _T9,
+#define JIT_V0			_S0
+#define JIT_V1			_S1
+#define JIT_V2			_S2
+#define JIT_V3			_S3
+#define JIT_V4			_S4
+#define JIT_V5			_S5
+#define JIT_V6			_S6
+#define JIT_V7			_S7
+    _S0, _S1, _S2, _S3, _S4, _S5, _S6, _S7,
+    _ZERO, _K0, _K1, _RA,
+    _GP,
+    _SP, _FP,
+#if NEW_ABI
+    _A7, _A6, _A5, _A4,
+#endif
+    _A3, _A2, _A1, _A0,
+#define JIT_F0			_F0
+#define JIT_F1			_F2
+#define JIT_F2			_F4
+#define JIT_F3			_F6
+#define JIT_F4			_F8
+#define JIT_F5			_F10
+#if !NEW_ABI
+#  define JIT_F6		_F16
+#  define JIT_F7		_F18
+#endif
+    _F0, _F2, _F4, _F6, _F8, _F10,
+    /* callee save float registers */
+#if !NEW_ABI
+    _F16, _F18,
+#endif
+    _F20, _F22, _F24, _F26, _F28, _F30,
+#if NEW_ABI
+    _F19, _F18, _F17, _F16, _F15, _F14, _F13, _F12,
+#else
+    _F14, _F12,
+#endif
+#define JIT_NOREG		_NOREG
+    _NOREG,
+} jit_reg_t;
+
+#endif /* _jit_mips_h */
diff --git a/libguile/lightening/lightening/ppc-cpu.c b/libguile/lightening/lightening/ppc-cpu.c
new file mode 100644
index 000000000..6f911dd1f
--- /dev/null
+++ b/libguile/lightening/lightening/ppc-cpu.c
@@ -0,0 +1,3483 @@
+/*
+ * Copyright (C) 2012-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+#  if __WORDSIZE == 32
+#    define gpr_save_area		72	/* r14~r31 = 18 * 4 */
+#    define params_offset		24
+#    define can_sign_extend_int_p(im)	1
+#    define can_zero_extend_int_p(im)	1
+#    define fits_uint32_p(im)		1
+#  else
+#    define gpr_save_area		144	/* r14~r31 = 18 * 8 */
+#    if ABI_ELFv2
+#      define params_offset		32
+#    else
+#      define params_offset		48
+#    endif
+#    define can_sign_extend_int_p(im)					\
+	(((im) >= 0 && (long)(im) <=  0x7fffffffL) ||			\
+	 ((im) <  0 && (long)(im) >= -0x80000000L))
+#    define can_zero_extend_int_p(im)					\
+	((im) >= 0 && (im) < 0x80000000L)
+#    define fits_uint32_p(im)		((im & 0xffffffff00000000L) == 0)
+#  endif
+#  define fpr_save_area			64
+#  define alloca_offset			-(gpr_save_area + fpr_save_area)
+#  define ii(i)				*_jit->pc.ui++ = i
+#  if __WORDSIZE == 32
+#    define iw(i)			*_jit->pc.ui++ = i
+#  else
+#    define iw(i)			*_jit->pc.ul++ = i
+#  endif
+#  define can_sign_extend_short_p(im)	((im) >= -32768 && (im) <= 32767)
+#  define can_zero_extend_short_p(im)	((im) >= 0 && (im) <= 65535)
+#  define can_sign_extend_jump_p(im)	((im) >= -33554432 && (im) <= 33554431)
+#  define _R0_REGNO			0
+#  define _SP_REGNO			1
+#  define _R2_REGNO			2
+#  define _R11_REGNO			11
+#  define _R12_REGNO			12
+#  define _FP_REGNO			31
+#  if __WORDSIZE == 32
+#    define ldr(r0,r1)			ldr_i(r0,r1)
+#    define ldxi(r0,r1,i0)		ldxi_i(r0,r1,i0)
+#    define stxi(i0,r0,r1)		stxi_i(i0,r0,r1)
+#  else
+#    define ldr(r0,r1)			ldr_l(r0,r1)
+#    define ldxi(r0,r1,i0)		ldxi_l(r0,r1,i0)
+#    define stxi(i0,r0,r1)		stxi_l(i0,r0,r1)
+#  endif
+#  define FXO(o,d,a,b,e,x)		_FXO(_jit,o,d,a,b,e,x,0)
+#  define FXO_(o,d,a,b,e,x)		_FXO(_jit,o,d,a,b,e,x,1)
+static void _FXO(jit_state_t*,int,int,int,int,int,int,int);
+#  define FDs(o,d,a,s)			_FDs(_jit,o,d,a,s)
+static void _FDs(jit_state_t*,int,int,int,int);
+#  define FDu(o,d,a,s)			_FDu(_jit,o,d,a,s)
+static void _FDu(jit_state_t*,int,int,int,int);
+#  define FX(o,d,a,b,x)			_FX(_jit,o,d,a,b,x,0)
+#  define FX_(o,d,a,b,x)		_FX(_jit,o,d,a,b,x,1)
+static void _FX(jit_state_t*,int,int,int,int,int,int);
+#  define FI(o,t,a,k)			_FI(_jit,o,t,a,k)
+static void _FI(jit_state_t*,int,int,int,int);
+#  define FB(o,bo,bi,t,a,k)		_FB(_jit,o,bo,bi,t,a,k)
+static void _FB(jit_state_t*,int,int,int,int,int,int);
+#  define FXL(o,bo,bi,x)		_FXL(_jit,o,bo,bi,x,0)
+#  define FXL_(o,bo,bi,x)		_FXL(_jit,o,bo,bi,x,1)
+static void _FXL(jit_state_t*,int,int,int,int,int);
+#  define FC(o,d,l,a,b,x)		_FC(_jit,o,d,l,a,b,x)
+static void _FC(jit_state_t*,int,int,int,int,int,int);
+#  define FCI(o,d,l,a,s)		_FCI(_jit,o,d,l,a,s)
+static void _FCI(jit_state_t*,int,int,int,int,int);
+#  define FXFX(o,s,x,f)			_FXFX(_jit,o,s,x,f)
+static void _FXFX(jit_state_t*,int,int,int,int);
+#  define FM(o,s,a,h,b,e,r)		_FM(_jit,o,s,a,h,b,e,r)
+static void _FM(jit_state_t*,int,int,int,int,int,int,int);
+#  if __WORDSIZE == 64
+#    define FMDS(o,s,a,b,e,x)		_FMDS(_jit,o,s,a,b,e,x,0)
+#    define FMDS_(o,s,a,b,e,x)		_FMDS(_jit,o,s,a,b,e,x,1)
+static void _FMDS(jit_state_t*,int,int,int,int,int,int,int);
+#    define FMD(o,s,a,h,b,x,i)		_FMD(_jit,o,s,a,h,b,x,i,0)
+#    define FMD_(o,s,a,h,b,x,i)		_FMD(_jit,o,s,a,h,b,x,i,1)
+static void _FMD(jit_state_t*,int,int,int,int,int,int,int,int);
+#  define FXS(o,d,a,h,x,i)		_FXS(_jit,o,d,a,h,x,i,0)
+#  define FXS_(o,d,a,h,x,i)		_FXS(_jit,o,d,a,h,x,i,1)
+static void _FXS(jit_state_t*,int,int,int,int,int,int,int);
+#  endif
+#  define CR_0				0
+#  define CR_1				1
+#  define CR_2				2
+#  define CR_3				3
+#  define CR_4				4
+#  define CR_5				5
+#  define CR_6				6
+#  define CR_7				7
+#  define CR_LT				0
+#  define CR_GT				1
+#  define CR_EQ				2
+#  define CR_SO				3
+#  define CR_UN				3
+#  define BCC_F				4
+#  define BCC_T				12
+#  define ADD(d,a,b)			FXO(31,d,a,b,0,266)
+#  define ADD_(d,a,b)			FXO_(31,d,a,b,0,266)
+#  define ADDO(d,a,b)			FXO(31,d,a,b,1,266)
+#  define ADDO_(d,a,b)			FXO_(31,d,a,b,1,266)
+#  define ADDC(d,a,b)			FXO_(31,d,a,b,0,10)
+#  define ADDC_(d,a,b)			FXO_(31,d,a,b,0,10)
+#  define ADDCO(d,a,b)			FXO(31,d,a,b,1,10)
+#  define ADDCO_(d,a,b)			FXO_(31,d,a,b,1,10)
+#  define ADDE(d,a,b)			FXO(31,d,a,b,0,138)
+#  define ADDE_(d,a,b)			FXO_(31,d,a,b,0,138)
+#  define ADDEO(d,a,b)			FXO(31,d,a,b,1,138)
+#  define ADDEO_(d,a,b)			FXO_(31,d,a,b,1,138)
+#  define ADDI(d,a,s)			FDs(14,d,a,s)
+#  define ADDIC(d,a,s)			FDs(12,d,a,s)
+#  define ADDIC_(d,a,s)			FDs(13,d,a,s)
+#  define ADDIS(d,a,s)			FDs(15,d,a,s)
+#  define LIS(d,s)			ADDIS(d,0,s)
+#  define ADDME(d,a)			FXO(31,d,a,0,0,234)
+#  define ADDME_(d,a)			FXO_(31,d,a,0,0,234)
+#  define ADDMEO(d,a)			FXO(31,d,a,0,1,234)
+#  define ADDMEO_(d,a)			FXO_(31,d,a,0,1,234)
+#  define ADDZE(d,a)			FXO(31,d,a,0,0,202)
+#  define ADDZE_(d,a)			FXO_(31,d,a,0,0,202)
+#  define ADDZEO(d,a)			FXO(31,d,a,0,1,202)
+#  define ADDZEO_(d,a)			FXO_(31,d,a,0,1,202)
+#  define AND(d,a,b)			FX(31,a,d,b,28)
+#  define ANDC(d,a,b)			FXO(31,a,d,b,0,60)
+#  define ANDC_(d,a,b)			FXO_(31,a,d,b,0,60)
+#  define AND_(d,a,b)			FX_(31,a,b,d,28)
+#  define ANDI_(d,a,u)			FDu(28,a,d,u)
+#  define ANDIS_(d,a,u)			FDu(29,a,d,u)
+#  define B(t)				FI(18,t,0,0)
+#  define BA(t)				FI(18,t,1,0)
+#  define BL(t)				FI(18,t,0,1)
+#  define BLA(t)			FI(18,t,1,1)
+#  define BC(o,i,t)			FB(16,o,i,t,0,0)
+#  define BCA(o,i,t)			FB(16,o,i,t,1,0)
+#  define BCL(o,i,t)			FB(16,o,i,t,0,1)
+#  define BCLA(o,i,t)			FB(16,o,i,t,1,1)
+#  define BLT(t)			BC(BCC_T,CR_LT,t)
+#  define BLE(t)			BC(BCC_F,CR_GT,t)
+#  define BEQ(t)			BC(BCC_T,CR_EQ,t)
+#  define BGE(t)			BC(BCC_F,CR_LT,t)
+#  define BGT(t)			BC(BCC_T,CR_GT,t)
+#  define BNE(t)			BC(BCC_F,CR_EQ,t)
+#  define BUN(t)			BC(BCC_T,CR_UN,t)
+#  define BNU(t)			BC(BCC_F,CR_UN,t)
+#  define BCCTR(o,i)			FXL(19,o,i,528)
+#  define BCCTRL(o,i)			FXL_(19,o,i,528)
+#  define BLTCTR()			BCCTR(BCC_T,CR_LT)
+#  define BLECTR()			BCCTR(BCC_F,CR_GT)
+#  define BEQCTR()			BCCTR(BCC_T,CR_EQ)
+#  define BGECTR()			BCCTR(BCC_F,CR_LT)
+#  define BGTCTR()			BCCTR(BCC_T,CR_GT)
+#  define BNECTR()			BCCTR(BCC_F,CR_EQ)
+#  define BCTR()			BCCTR(20,0)
+#  define BCTRL()			BCCTRL(20,0)
+#  define BCLR(o,i)			FXL(19,o,i,16)
+#  define BCLRL(o,i)			FXL_(19,o,i,16)
+#  define BLTLR()			BCLR(BCC_T,CR_LT)
+#  define BLELR()			BCLR(BCC_F,CR_GT)
+#  define BEQLR()			BCLR(BCC_T,CR_EQ)
+#  define BGELR()			BCLR(BCC_F,CR_LT)
+#  define BGTLR()			BCLR(BCC_T,CR_GT)
+#  define BNELR()			BCLR(BCC_F,CR_EQ)
+#  define BLR()				BCLR(20,0)
+#  define BLRL()			BCLRL(20,0)
+#  define XCMP(cr,l,a,b)		FC(31,cr,l,a,b,0)
+#  define CMPD(a,b)			XCMP(0,1,a,b)
+#  define CMPW(a,b)			XCMP(0,0,a,b)
+#  define XCMPI(cr,l,a,s)		FCI(11,cr,l,a,s)
+#  define CMPDI(a,s)			XCMPI(0,1,a,s)
+#  define CMPWI(a,s)			XCMPI(0,0,a,s)
+#  define XCMPL(cr,l,a,b)		FC(31,cr,l,a,b,32)
+#  define CMPLD(a,b)			XCMPL(0,1,a,b)
+#  define CMPLW(a,b)			XCMPL(0,0,a,b)
+#  define XCMPLI(cr,l,a,u)		FCI(10,cr,l,a,u)
+#  define CMPLDI(a,s)			XCMPLI(0,1,a,s)
+#  define CMPLWI(a,s)			XCMPLI(0,0,a,s)
+#  define CNTLZW(a,s)			FX(31,s,a,0,26)
+#  define CNTLZW_(a,s)			FX_(31,s,a,0,26)
+#  define CRAND(d,a,b)			FX(19,d,a,b,257)
+#  define CRANDC(d,a,b)			FX(19,d,a,b,129)
+#  define CREQV(d,a,b)			FX(19,d,a,b,289)
+#  define CRSET(d)			CREQV(d,d,d)
+#  define CRNAND(d,a,b)			FX(19,d,a,b,225)
+#  define CRNOR(d,a,b)			FX(19,d,a,b,33)
+#  define CRNOT(d,a)			CRNOR(d,a,a)
+#  define CROR(d,a,b)			FX(19,d,a,b,449)
+#  define CRMOVE(d,a)			CROR(d,a,a)
+#  define CRORC(d,a,b)			FX(19,d,a,b,417)
+#  define CRXOR(d,a,b)			FX(19,d,a,b,193)
+#  define CRCLR(d)			CRXOR(d,d,d)
+#  define DCBA(a,b)			FX(31,0,a,b,758)
+#  define DCBF(a,b)			FX(31,0,a,b,86)
+#  define DCBI(a,b)			FX(31,0,a,b,470)
+#  define DCBST(a,b)			FX(31,0,a,b,54)
+#  define DCBT(a,b)			FX(31,0,a,b,278)
+#  define DCBTST(a,b)			FX(31,0,a,b,246)
+#  define DCBZ(a,b)			FX(31,0,a,b,1014)
+#  define DIVW(d,a,b)			FXO(31,d,a,b,0,491)
+#  define DIVW_(d,a,b)			FXO_(31,d,a,b,0,491)
+#  define DIVWO(d,a,b)			FXO(31,d,a,b,1,491)
+#  define DIVWO_(d,a,b)			FXO_(31,d,a,b,1,491)
+#  define DIVWU(d,a,b)			FXO(31,d,a,b,0,459)
+#  define DIVWU_(d,a,b)			FXO_(31,d,a,b,0,459)
+#  define DIVWUO(d,a,b)			FXO(31,d,a,b,1,459)
+#  define DIVWUO_(d,a,b)		FXO_(31,d,a,b,1,459)
+#  define DIVD(d,a,b)			FXO(31,d,a,b,0,489)
+#  define DIVD_(d,a,b)			FXO_(31,d,a,b,0,489)
+#  define DIVDO(d,a,b)			FXO(31,d,a,b,1,489)
+#  define DIVDO_(d,a,b)			FXO_(31,d,a,b,1,489)
+#  define DIVDU(d,a,b)			FXO(31,d,a,b,0,457)
+#  define DIVDU_(d,a,b)			FXO_(31,d,a,b,0,457)
+#  define DIVDUO(d,a,b)			FXO(31,d,a,b,1,457)
+#  define DIVDUO_(d,a,b)		FXO_(31,d,a,b,1,457)
+#  define ECIWX(d,a,b)			FX(31,d,a,b,310)
+#  define ECOWX(s,a,b)			FX(31,s,a,b,438)
+#  define EIEIO()			FX(31,0,0,0,854)
+#  define EQV(d,a,b)			FX(31,a,d,b,284)
+#  define EQV_(d,a,b)			FX_(31,a,d,b,284)
+#  define EXTSB(d,a)			FX(31,a,d,0,954)
+#  define EXTSB_(d,a)			FX_(31,a,d,0,954)
+#  define EXTSH(d,a)			FX(31,a,d,0,922)
+#  define EXTSH_(d,a)			FX_(31,a,d,0,922)
+#  define EXTSW(d,a)			FX(31,a,d,0,986)
+#  define EXTSW_(d,a)			FX_(31,a,d,0,986)
+#  define ICIB(a,b)			FX(31,0,a,b,982)
+#  define ISYNC()			FXL(19,0,0,150)
+#  define LBZ(d,a,s)			FDs(34,d,a,s)
+#  define LBZU(d,a,s)			FDs(35,d,a,s)
+#  define LBZUX(d,a,b)			FX(31,d,a,b,119)
+#  define LBZX(d,a,b)			FX(31,d,a,b,87)
+#  define LHA(d,a,s)			FDs(42,d,a,s)
+#  define LHAU(d,a,s)			FDs(43,d,a,s)
+#  define LHAUX(d,a,b)			FX(31,d,a,b,375)
+#  define LHAX(d,a,b)			FX(31,d,a,b,343)
+#  define LHRBX(d,a,b)			FX(31,d,a,b,790)
+#  define LHZ(d,a,s)			FDs(40,d,a,s)
+#  define LHZU(d,a,s)			FDs(41,d,a,s)
+#  define LHZUX(d,a,b)			FX(31,d,a,b,311)
+#  define LHZX(d,a,b)			FX(31,d,a,b,279)
+#  define LA(d,a,s)			ADDI(d,a,s)
+#  define LI(d,s)			ADDI(d,0,s)
+#  define LMW(d,a,s)			FDs(46,d,a,s)
+#  define LSWI(d,a,n)			FX(31,d,a,n,597)
+#  define LSWX(d,a,b)			FX(31,d,a,b,533)
+#  define LWARX(d,a,b)			FX(31,d,a,b,20)
+#  define LWBRX(d,a,b)			FX(31,d,a,b,534)
+#  define LWA(d,a,s)			FDs(58,d,a,s|2)
+#  define LWAUX(d,a,b)			FX(31,d,a,b,373)
+#  define LWAX(d,a,b)			FX(31,d,a,b,341)
+#  define LWZ(d,a,s)			FDs(32,d,a,s)
+#  define LWZU(d,a,s)			FDs(33,d,a,s)
+#  define LWZUX(d,a,b)			FX(31,d,a,b,55)
+#  define LWZX(d,a,b)			FX(31,d,a,b,23)
+#  define LD(d,a,s)			FDs(58,d,a,s)
+#  define LDX(d,a,b)			FX(31,d,a,b,21)
+#  define MCRF(d,s)			FXL(19,d<<2,(s)<<2,0)
+#  if DEBUG
+/* In case instruction is emulated, check the kernel can handle it.
+   Will only generate it if DEBUG is enabled.
+"""
+Chapter 6. Optional Facilities and Instructions that are being
+Phased Out of the Architecture
+...
+6.1 Move To Condition Register from XER
+The mcrxr instruction is being phased out of the archi-
+tecture. Its description is included here as an aid to
+constructing operating system code to emulate it.
+
+Move to Condition Register from XER
+X-form
+mcrxr BF
+31	BF	//	///	///	512	/
+0	6	9	11	16	21	31
+CR(4xBF:4xBF+3) <- XER(32:35)
+XER(32:35) <- 0b0000
+The contents of XER(32:35) are copied to Condition Reg-
+ister field BF. XER(32:35) are set to zero.
+Special Registers Altered:
+CR field BF XER(32:35)
+
+Programming Note
+Warning: This instruction has been phased out of
+the architecture. Attempting to execute this
+instruction will cause the system illegal instruction
+error handler to be invoked
+"""
+ */
+#    define MCRXR(d)			FX(31,d<<2,0,0,512)
+#  else
+#    define MCRXR(cr)			_MCRXR(_jit,cr);
+static void _MCRXR(jit_state_t*, int32_t);
+#  endif
+#  define MFCR(d)			FX(31,d,0,0,19)
+#  define MFMSR(d)			FX(31,d,0,0,83)
+#  define MFSPR(d,s)			FXFX(31,d,s<<5,339)
+#  define MFXER(d)			MFSPR(d,1)
+#  define MFLR(d)			MFSPR(d,8)
+#  define MFCTR(d)			MFSPR(d,9)
+#  define MFSR(d,s)			FX(31,d,s,0,595)
+#  define MFSRIN(d,b)			FX(31,d,0,b,659)
+#  define MFTB(d,x,y)			FXFX(31,d,(x)|((y)<<5),371)
+#  define MFTBL(d)			MFTB(d,8,12)
+#  define MFTBU(d)			MFTB(d,8,13)
+#  define MTCRF(c,s)			FXFX(31,s,c<<1,144)
+#  define MTCR(s)			MTCRF(0xff,s)
+#  define MTMSR(s)			FX(31,s,0,0,146)
+#  define MTSPR(d,s)			FXFX(31,d,s<<5,467)
+#  define MTXER(d)			MTSPR(d,1)
+#  define MTLR(d)			MTSPR(d,8)
+#  define MTCTR(d)			MTSPR(d,9)
+#  define MTSR(r,s)			FX(31,s<<1,r,0,210)
+#  define MTSRIN(r,b)			FX(31,r<<1,0,b,242)
+#  define MULLI(d,a,s)			FDs(07,d,a,s)
+#  define MULHW(d,a,b)			FXO(31,d,a,b,0,75)
+#  define MULHW_(d,a,b)			FXO_(31,d,a,b,0,75)
+#  define MULHWU(d,a,b)			FXO(31,d,a,b,0,11)
+#  define MULHWU_(d,a,b)		FXO_(31,d,a,b,0,11)
+#  define MULLW(d,a,b)			FXO(31,d,a,b,0,235)
+#  define MULLW_(d,a,b)			FXO_(31,d,a,b,0,235)
+#  define MULLWO(d,a,b)			FXO(31,d,a,b,1,235)
+#  define MULLWO_(d,a,b)		FXO_(31,d,a,b,1,235)
+#  define MULHD(d,a,b)			FXO(31,d,a,b,0,73)
+#  define MULHD_(d,a,b)			FXO_(31,d,a,b,0,73)
+#  define MULHDU(d,a,b)			FXO(31,d,a,b,0,9)
+#  define MULHDU_(d,a,b)		FXO_(31,d,a,b,0,9)
+#  define MULLD(d,a,b)			FXO(31,d,a,b,0,233)
+#  define MULLD_(d,a,b)			FXO_(31,d,a,b,0,233)
+#  define MULLDO(d,a,b)			FXO(31,d,a,b,1,233)
+#  define MULLDO_(d,a,b)		FXO_(31,d,a,b,1,233)
+#  define NAND(d,a,b)			FX(31,a,d,b,476)
+#  define NAND_(d,a,b)			FX_(31,a,d,b,476)
+#  define NEG(d,a)			FXO(31,d,a,0,0,104)
+#  define NEG_(d,a)			FXO_(31,d,a,0,0,104)
+#  define NEGO(d,a)			FXO(31,d,a,0,1,104)
+#  define NEGO_(d,a)			FXO_(31,d,a,0,1,104)
+#  define NOR(d,a,b)			FX(31,a,d,b,124)
+#  define NOR_(d,a,b)			FX_(31,a,d,b,124)
+#  define NOT(d,s)			NOR(d,s,s)
+#  define OR(d,a,b)			FX(31,a,d,b,444)
+#  define OR_(d,a,b)			FX_(31,a,d,b,444)
+#  define MR(d,a)			OR(d,a,a)
+#  define ORC(d,a,b)			FX(31,a,d,b,412)
+#  define ORC_(d,a,b)			FX_(31,a,d,b,412)
+#  define ORI(d,a,u)			FDu(24,a,d,u)
+#  define NOP()				ORI(0,0,0)
+#  define ORIS(d,a,u)			FDu(25,a,d,u)
+#  define RFI()				FXL(19,0,0,50)
+#  define RLWIMI(d,s,h,b,e)		FM(20,s,d,h,b,e,0)
+#  define RLWIMI_(d,s,h,b,e)		FM(20,s,d,h,b,e,1)
+#  define INSLWI(a,s,n,b)		RLWIMI(a,s,32-b,b,b+n-1)
+#  define INSRWI(a,s,n,b)		RLWIMI(a,s,32-(b+n),b,(b+n)-1)
+#  define RLWINM(a,s,h,b,e)		FM(21,s,a,h,b,e,0)
+#  define RLWINM_(a,s,h,b,e)		FM(21,s,a,h,b,e,1)
+#  define EXTLWI(a,s,n,b)		RLWINM(a,s,b,0,n-1)
+#  define EXTRWI(a,s,n,b)		RLWINM(a,s,b+n,32-n,31)
+#  define ROTLWI(a,s,n)			RLWINM(a,s,n,0,31)
+#  define ROTRWI(a,s,n)			RLWINM(a,s,32-n,0,31)
+#  define SLWI(a,s,n)			RLWINM(a,s,n,0,31-n)
+#  define SRWI(a,s,n)			RLWINM(a,s,32-n,n,31)
+#  define CLRLWI(a,s,n)			RLWINM(a,s,0,n,31)
+#  define CLRRWI(a,s,n)			RLWINM(a,s,0,0,31-n)
+#  define CLRLSWI(a,s,b,n)		RLWINM(a,s,n,b-n,31-n)
+#  define RLWNM(a,s,b,m,e)		FM(23,s,a,b,m,e,0)
+#  define RLWNM_(a,s,b,m,e)		FM(23,s,a,b,m,e,1)
+#  define ROTLW(a,s,b)			RLWNM(a,s,b,0,31)
+#  define SC()				FDu(17,0,0,2)
+#  define SLW(a,s,b)			FX(31,s,a,b,24)
+#  define SLW_(a,s,b)			FX_(31,s,a,b,24)
+#  define SRAW(a,s,b)			FX(31,s,a,b,792)
+#  define SRAW_(a,s,b)			FX_(31,s,a,b,792)
+#  define SRAWI(a,s,h)			FX(31,s,a,h,824)
+#  define SRAWI_(a,s,h)			FX_(31,s,a,h,824)
+#  define SRW(a,s,b)			FX(31,s,a,b,536)
+#  define SRW_(a,s,b)			FX_(31,s,a,b,536)
+#  if __WORDSIZE == 64
+#    define RLDICL(a,s,h,b)		FMD(30,s,a,h&~32,b,0,h>>5)
+#    define RLDICL_(a,s,h,b)		FMD_(30,s,a,h&~32,b,0,h>>5)
+#    define EXTRDI(x,y,n,b)		RLDICL(x,y,(b+n),(64-n))
+#    define SRDI(x,y,n)			RLDICL(x,y,(64-n),n)
+#    define CLRLDI(x,y,n)		RLDICL(x,y,0,n)
+#    define RLDICR(a,s,h,e)		FMD(30,s,a,h&~32,e,1,h>>5)
+#    define RLDICR_(a,s,h,e)		FMD_(30,s,a,h&~32,e,1,h>>5)
+#    define EXTRLI(x,y,n,b)		RLDICR(x,y,b,(n-1))
+#    define SLDI(x,y,n)			RLDICR(x,y,n,(63-n))
+#    define CLRRDI(x,y,n)		RLDICR(x,y,0,(63-n))
+#    define RLDIC(a,s,h,b)		FMD(30,s,a,h&~32,b,2,h>>5)
+#    define RLDIC_(a,s,h,b)		FMD_(30,s,a,h&~32,b,2,h>>5)
+#    define CLRLSLDI(x,y,b,n)		RLDIC(x,y,n,(b-n))
+#    define RLDCL(a,s,h,b)		FMDS(30,s,a,h,b,8)
+#    define RLDCL_(a,s,h,b)		FMDS_(30,s,a,h,b,8)
+#    define ROTLD(x,y,z)		RLDCL(x,y,z,0)
+#    define RLDCR(a,s,b,e)		FMDS(30,s,a,b,e,0)
+#    define RLDCR_(a,s,b,e)		FMDS_(30,s,a,b,e,0)
+#    define RLDIMI(a,s,h,b)		FMD(30,s,a,h&~32,b,3,h>>5)
+#    define RLDIMI_(a,s,h,b)		FMD_(30,s,a,h&~32,b,3,h>>5)
+#    define INSRDI(x,y,n,b)		RLDIMI(x,y,(64-(b+n)),b)
+#    define SLD(a,s,b)			FX(31,s,a,b,27)
+#    define SLD_(a,s,b)			FX_(31,s,a,b,27)
+#    define SRD(a,s,b)			FX(31,s,a,b,539)
+#    define SRD_(a,s,b)			FX_(31,s,a,b,539)
+#    define SRADI(a,s,h)		FXS(31,s,a,h&~32,413,h>>5)
+#    define SRADI_(a,s,h)		FXS_(31,s,a,h&~32,413,h>>5)
+#    define SRAD(a,s,b)			FX(31,s,a,b,794)
+#    define SRAD_(a,s,b)		FX_(31,s,a,b,794)
+#  endif
+#  define STB(s,a,d)			FDs(38,s,a,d)
+#  define STBU(s,a,d)			FDs(39,s,a,d)
+#  define STBUX(s,a,b)			FX(31,s,a,b,247)
+#  define STBX(s,a,b)			FX(31,s,a,b,215)
+#  define STH(s,a,d)			FDs(44,s,a,d)
+#  define STHBRX(s,a,b)			FX(31,s,a,b,918)
+#  define STHU(s,a,d)			FDs(45,s,a,d)
+#  define STHUX(s,a,b)			FX(31,s,a,b,439)
+#  define STHX(s,a,b)			FX(31,s,a,b,407)
+#  define STMW(s,a,d)			FDs(47,s,a,d)
+#  define STWSI(s,a,nb)			FX(31,s,a,nb,725)
+#  define STSWX(s,a,b)			FX(31,s,a,b,661)
+#  define STW(s,a,d)			FDs(36,s,a,d)
+#  define STWBRX(s,a,b)			FX(31,s,a,b,662)
+#  define STWCX_(s,a,b)			FX_(31,s,a,b,150)
+#  define STWU(s,a,d)			FDs(37,s,a,d)
+#  define STWUX(s,a,b)			FX(31,s,a,b,183)
+#  define STWX(s,a,b)			FX(31,s,a,b,151)
+#  define STD(s,a,d)			FDs(62,s,a,d)
+#  define STDX(s,a,b)			FX(31,s,a,b,149)
+#  define STDU(s,a,d)			FDs(62,s,a,d|1)
+#  define STDUX(s,a,b)			FX(31,s,a,b,181)
+#  define SUBF(d,a,b)			FXO(31,d,a,b,0,40)
+#  define SUBF_(d,a,b)			FXO_(31,d,a,b,0,40)
+#  define SUBFO(d,a,b)			FXO(31,d,a,b,1,40)
+#  define SUBFO_(d,a,b)			FXO_(31,d,a,b,1,40)
+#  define SUB(d,a,b)			SUBF(d,b,a)
+#  define SUB_(d,a,b)			SUBF_(d,b,a)
+#  define SUBO(d,a,b)			SUBFO(d,b,a)
+#  define SUBO_(d,a,b)			SUBFO_(d,b,a)
+#  define SUBI(d,a,s)			ADDI(d,a,-s)
+#  define SUBIS(d,a,s)			ADDIS(d,a,-s)
+#  define SUBFC(d,a,b)			FXO(31,d,a,b,0,8)
+#  define SUBFC_(d,a,b)			FXO_(31,d,a,b,0,8)
+#  define SUBFCO(d,a,b)			FXO(31,d,a,b,1,8)
+#  define SUBFCO_(d,a,b)		FXO_(31,d,a,b,1,8)
+#  define SUBC(d,a,b)			SUBFC(d,b,a)
+#  define SUBIC(d,a,s)			ADDIC(d,a,-s)
+#  define SUBIC_(d,a,s)			ADDIC_(d,a,-s)
+#  define SUBFE(d,a,b)			FXO(31,d,a,b,0,136)
+#  define SUBFE_(d,a,b)			FXO_(31,d,a,b,0,136)
+#  define SUBFEO(d,a,b)			FXO(31,d,a,b,1,136)
+#  define SUBFEO_(d,a,b)		FXO_(31,d,a,b,1,136)
+#  define SUBE(d,a,b)			SUBFE(d,b,a)
+#  define SUBFIC(d,a,s)			FDs(8,d,a,s)
+#  define SUBFME(d,a)			FXO(31,d,a,0,0,232)
+#  define SUBFME_(d,a)			FXO_(31,d,a,0,0,232)
+#  define SUBFMEO(d,a)			FXO(31,d,a,0,1,232)
+#  define SUBFMEO_(d,a)			FXO_(31,d,a,0,1,232)
+#  define SUBFZE(d,a)			FXO(31,d,a,0,0,200)
+#  define SUBFZE_(d,a)			FXO_(31,d,a,0,0,200)
+#  define SUBFZEO(d,a)			FXO(31,d,a,0,1,200)
+#  define SUBFZEO_(d,a)			FXO_(31,d,a,0,1,200)
+#  define SYNC()			FX(31,0,0,0,598)
+#  define TLBIA()			FX(31,0,0,0,370)
+#  define TLBIE(b)			FX(31,0,0,b,306)
+#  define TLBSYNC()			FX(31,0,0,0,566)
+#  define TW(t,a,b)			FX(31,t,a,b,4)
+#  define TWEQ(a,b)			FX(31,4,a,b,4)
+#  define TWLGE(a,b)			FX(31,5,a,b,4)
+#  define TRAP()			FX(31,31,0,0,4)
+#  define TWI(t,a,s)			FDs(3,t,a,s)
+#  define TWGTI(a,s)			TWI(8,a,s)
+#  define TWLLEI(a,s)			TWI(6,a,s)
+#  define XOR(d,a,b)			FX(31,a,d,b,316)
+#  define XOR_(d,a,b)			FX_(31,a,d,b,316)
+#  define XORI(s,a,u)			FDu(26,a,s,u)
+#  define XORIS(s,a,u)			FDu(27,a,s,u)
+#  define nop(c)			_nop(_jit,c)
+static void _nop(jit_state_t*,int32_t);
+#  define movr(r0,r1)			_movr(_jit,r0,r1)
+static void _movr(jit_state_t*,int32_t,int32_t);
+#  define movi(r0,i0)			_movi(_jit,r0,i0)
+static void _movi(jit_state_t*,int32_t,jit_word_t);
+#  define movi_p(r0,i0)			_movi_p(_jit,r0,i0)
+static jit_word_t _movi_p(jit_state_t*,int32_t,jit_word_t);
+#  define negr(r0,r1)			NEG(r0,r1)
+#  define comr(r0,r1)			NOT(r0,r1)
+#  define extr_c(r0,r1)			EXTSB(r0,r1)
+#  define extr_uc(r0,r1)		ANDI_(r0,r1,0xff)
+#  define extr_s(r0,r1)			EXTSH(r0,r1)
+#  define extr_us(r0,r1)		ANDI_(r0,r1,0xffff)
+#  if __WORDSIZE == 64
+#    define extr_i(r0,r1)		EXTSW(r0,r1)
+#    define extr_ui(r0,r1)		CLRLDI(r0,r1,32)
+#  endif
+#  if __BYTE_ORDER == __BIG_ENDIAN
+#    define bswapr_us(r0,r1)		extr_us(r0,r1)
+#    if __WORDSIZE == 32
+#      define bswapr_ui(r0,r1)		movr(r0,r1)
+#    else
+#      define bswapr_ui(r0,r1)		extr_ui(r0,r1)
+#      define bswapr_ul(r0,r1)		movr(r0,r1)
+#    endif
+#  else
+#    define bswapr_us(r0,r1)		_bswapr_us(_jit,r0,r1)
+static void _bswapr_us(jit_state_t*,int32_t,int32_t);
+#    define bswapr_ui(r0,r1)		_bswapr_ui(_jit,r0,r1)
+static void _bswapr_ui(jit_state_t*,int32_t,int32_t);
+#    if __WORDSIZE == 64
+#      define bswapr_ul(r0,r1)		_bswapr_ul(_jit,r0,r1)
+static void _bswapr_ul(jit_state_t*,int32_t,int32_t);
+#    endif
+#  endif
+#  define addr(r0,r1,r2)		ADD(r0,r1,r2)
+#  define addi(r0,r1,i0)		_addi(_jit,r0,r1,i0)
+static void _addi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define addcr(r0,r1,r2)		ADDC(r0,r1,r2)
+#  define addci(r0,r1,i0)		_addci(_jit,r0,r1,i0)
+static void _addci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define addxr(r0,r1,r2)		ADDE(r0,r1,r2)
+#  define addxi(r0,r1,i0)		_addxi(_jit,r0,r1,i0)
+static void _addxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subr(r0,r1,r2)		SUB(r0,r1,r2)
+#  define subi(r0,r1,i0)		_subi(_jit,r0,r1,i0)
+static void _subi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subcr(r0,r1,r2)		SUBC(r0,r1,r2)
+#  define subci(r0,r1,i0)		_subci(_jit,r0,r1,i0)
+static void _subci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subxr(r0,r1,r2)		SUBFE(r0,r2,r1)
+#  define subxi(r0,r1,i0)		_subxi(_jit,r0,r1,i0)
+static void _subxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define rsbi(r0, r1, i0)		_rsbi(_jit, r0, r1, i0)
+static void _rsbi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define mulr(r0,r1,r2)		MULLW(r0,r1,r2)
+#    define mullr(r0,r1,r2)		MULLW(r0,r1,r2)
+#    define mulhr(r0,r1,r2)		MULHW(r0,r1,r2)
+#    define mulhr_u(r0,r1,r2)		MULHWU(r0,r1,r2)
+#  else
+#    define mulr(r0,r1,r2)		MULLD(r0,r1,r2)
+#    define mullr(r0,r1,r2)		MULLD(r0,r1,r2)
+#    define mulhr(r0,r1,r2)		MULHD(r0,r1,r2)
+#    define mulhr_u(r0,r1,r2)		MULHDU(r0,r1,r2)
+#  endif
+#  define muli(r0,r1,i0)		_muli(_jit,r0,r1,i0)
+static void _muli(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qmulr(r0,r1,r2,r3)		iqmulr(r0,r1,r2,r3,1)
+#  define qmulr_u(r0,r1,r2,r3)		iqmulr(r0,r1,r2,r3,0)
+#  define iqmulr(r0,r1,r2,r3,cc)	_iqmulr(_jit,r0,r1,r2,r3,cc)
+static void _iqmulr(jit_state_t*,int32_t,int32_t,
+		    int32_t,int32_t,jit_bool_t);
+#  define qmuli(r0,r1,r2,i0)		iqmuli(r0,r1,r2,i0,1)
+#  define qmuli_u(r0,r1,r2,i0)		iqmuli(r0,r1,r2,i0,0)
+#  define iqmuli(r0,r1,r2,i0,cc)	_iqmuli(_jit,r0,r1,r2,i0,cc)
+static void _iqmuli(jit_state_t*,int32_t,int32_t,
+		    int32_t,jit_word_t,jit_bool_t);
+#  if __WORDSIZE == 32
+#    define divr(r0,r1,r2)		DIVW(r0,r1,r2)
+#  else
+#    define divr(r0,r1,r2)		DIVD(r0,r1,r2)
+#  endif
+#  define divi(r0,r1,i0)		_divi(_jit,r0,r1,i0)
+static void _divi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define divr_u(r0,r1,r2)		DIVWU(r0,r1,r2)
+#  else
+#    define divr_u(r0,r1,r2)		DIVDU(r0,r1,r2)
+#  endif
+#  define divi_u(r0,r1,i0)		_divi_u(_jit,r0,r1,i0)
+static void _divi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qdivr(r0,r1,r2,r3)		iqdivr(r0,r1,r2,r3,1)
+#  define qdivr_u(r0,r1,r2,r3)		iqdivr(r0,r1,r2,r3,0)
+#  define iqdivr(r0,r1,r2,r3,cc)	_iqdivr(_jit,r0,r1,r2,r3,cc)
+static void _iqdivr(jit_state_t*,int32_t,int32_t,
+		    int32_t,int32_t,jit_bool_t);
+#  define qdivi(r0,r1,r2,i0)		iqdivi(r0,r1,r2,i0,1)
+#  define qdivi_u(r0,r1,r2,i0)		iqdivi(r0,r1,r2,i0,0)
+#  define iqdivi(r0,r1,r2,i0,cc)	_iqdivi(_jit,r0,r1,r2,i0,cc)
+static void _iqdivi(jit_state_t*,int32_t,int32_t,
+		    int32_t,jit_word_t,jit_bool_t);
+#  define remr(r0,r1,r2)		_remr(_jit,r0,r1,r2)
+static void _remr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi(r0,r1,i0)		_remi(_jit,r0,r1,i0)
+static void _remi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define remr_u(r0,r1,r2)		_remr_u(_jit,r0,r1,r2)
+static void _remr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi_u(r0,r1,i0)		_remi_u(_jit,r0,r1,i0)
+static void _remi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define andr(r0,r1,r2)		AND(r0,r1,r2)
+#  define andi(r0,r1,i0)		_andi(_jit,r0,r1,i0)
+static void _andi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define orr(r0,r1,r2)			OR(r0,r1,r2)
+#  define ori(r0,r1,i0)			_ori(_jit,r0,r1,i0)
+static void _ori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define xorr(r0,r1,r2)		XOR(r0,r1,r2)
+#  define xori(r0,r1,i0)		_xori(_jit,r0,r1,i0)
+static void _xori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define lshr(r0,r1,r2)		SLW(r0,r1,r2)
+#  else
+#    define lshr(r0,r1,r2)		SLD(r0,r1,r2)
+#  endif
+#  define lshi(r0,r1,i0)		_lshi(_jit,r0,r1,i0)
+static void _lshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define rshr(r0,r1,r2)		SRAW(r0,r1,r2)
+#  else
+#    define rshr(r0,r1,r2)		SRAD(r0,r1,r2)
+#  endif
+#  define rshi(r0,r1,i0)		_rshi(_jit,r0,r1,i0)
+static void _rshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define rshr_u(r0,r1,r2)		SRW(r0,r1,r2)
+#  else
+#    define rshr_u(r0,r1,r2)		SRD(r0,r1,r2)
+#  endif
+#  define rshi_u(r0,r1,i0)		_rshi_u(_jit,r0,r1,i0)
+static void _rshi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ltr(r0,r1,r2)			_ltr(_jit,r0,r1,r2)
+static void _ltr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lti(r0,r1,i0)			_lti(_jit,r0,r1,i0)
+static void _lti(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ltr_u(r0,r1,r2)		_ltr_u(_jit,r0,r1,r2)
+static void _ltr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lti_u(r0,r1,i0)		_lti_u(_jit,r0,r1,i0)
+static void _lti_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ler(r0,r1,r2)			_ler(_jit,r0,r1,r2)
+static void _ler(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lei(r0,r1,i0)			_lei(_jit,r0,r1,i0)
+static void _lei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ler_u(r0,r1,r2)		_ler_u(_jit,r0,r1,r2)
+static void _ler_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lei_u(r0,r1,i0)		_lei_u(_jit,r0,r1,i0)
+static void _lei_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define eqr(r0,r1,r2)			_eqr(_jit,r0,r1,r2)
+static void _eqr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define eqi(r0,r1,i0)			_eqi(_jit,r0,r1,i0)
+static void _eqi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ger(r0,r1,r2)			_ger(_jit,r0,r1,r2)
+static void _ger(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gei(r0,r1,i0)			_gei(_jit,r0,r1,i0)
+static void _gei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ger_u(r0,r1,r2)		_ger_u(_jit,r0,r1,r2)
+static void _ger_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gei_u(r0,r1,i0)		_gei_u(_jit,r0,r1,i0)
+static void _gei_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define gtr(r0,r1,r2)			_gtr(_jit,r0,r1,r2)
+static void _gtr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gti(r0,r1,i0)			_gti(_jit,r0,r1,i0)
+static void _gti(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define gtr_u(r0,r1,r2)		_gtr_u(_jit,r0,r1,r2)
+static void _gtr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gti_u(r0,r1,i0)		_gti_u(_jit,r0,r1,i0)
+static void _gti_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ner(r0,r1,r2)			_ner(_jit,r0,r1,r2)
+static void _ner(jit_state_t*,int32_t,int32_t,int32_t);
+#  define nei(r0,r1,i0)			_nei(_jit,r0,r1,i0)
+static void _nei(jit_state_t*,int32_t,int32_t,jit_word_t);
+#define bltr(i0,r0,r1)			_bltr(_jit,i0,r0,r1)
+static jit_word_t _bltr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blti(i0,r0,i1)			_blti(_jit,i0,r0,i1)
+static jit_word_t _blti(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bltr_u(i0,r0,r1)		_bltr_u(_jit,i0,r0,r1)
+static jit_word_t _bltr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blti_u(i0,r0,i1)		_blti_u(_jit,i0,r0,i1)
+static jit_word_t _blti_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bler(i0,r0,r1)			_bler(_jit,i0,r0,r1)
+static jit_word_t _bler(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blei(i0,r0,i1)			_blei(_jit,i0,r0,i1)
+static jit_word_t _blei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bler_u(i0,r0,r1)		_bler_u(_jit,i0,r0,r1)
+static jit_word_t _bler_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define blei_u(i0,r0,i1)		_blei_u(_jit,i0,r0,i1)
+static jit_word_t _blei_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define beqr(i0,r0,r1)			_beqr(_jit,i0,r0,r1)
+static jit_word_t _beqr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define beqi(i0,r0,i1)			_beqi(_jit,i0,r0,i1)
+static jit_word_t _beqi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bger(i0,r0,r1)			_bger(_jit,i0,r0,r1)
+static jit_word_t _bger(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgei(i0,r0,i1)			_bgei(_jit,i0,r0,i1)
+static jit_word_t _bgei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bger_u(i0,r0,r1)		_bger_u(_jit,i0,r0,r1)
+static jit_word_t _bger_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgei_u(i0,r0,i1)		_bgei_u(_jit,i0,r0,i1)
+static jit_word_t _bgei_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bgtr(i0,r0,r1)			_bgtr(_jit,i0,r0,r1)
+static jit_word_t _bgtr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgti(i0,r0,i1)			_bgti(_jit,i0,r0,i1)
+static jit_word_t _bgti(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bgtr_u(i0,r0,r1)		_bgtr_u(_jit,i0,r0,r1)
+static jit_word_t _bgtr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bgti_u(i0,r0,i1)		_bgti_u(_jit,i0,r0,i1)
+static jit_word_t _bgti_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bner(i0,r0,r1)			_bner(_jit,i0,r0,r1)
+static jit_word_t _bner(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bnei(i0,r0,i1)			_bnei(_jit,i0,r0,i1)
+static jit_word_t _bnei(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bmsr(i0,r0,r1)			_bmsr(_jit,i0,r0,r1)
+static jit_word_t _bmsr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bmsi(i0,r0,i1)			_bmsi(_jit,i0,r0,i1)
+static jit_word_t _bmsi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bmcr(i0,r0,r1)			_bmcr(_jit,i0,r0,r1)
+static jit_word_t _bmcr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bmci(i0,r0,i1)			_bmci(_jit,i0,r0,i1)
+static jit_word_t _bmci(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define boaddr(i0,r0,r1)		_boaddr(_jit,i0,r0,r1)
+static jit_word_t _boaddr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define boaddi(i0,r0,i1)		_boaddi(_jit,i0,r0,i1)
+static jit_word_t _boaddi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bxaddr(i0,r0,r1)		_bxaddr(_jit,i0,r0,r1)
+static jit_word_t _bxaddr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bxaddi(i0,r0,i1)		_bxaddi(_jit,i0,r0,i1)
+static jit_word_t _bxaddi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bosubr(i0,r0,r1)		_bosubr(_jit,i0,r0,r1)
+static jit_word_t _bosubr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bosubi(i0,r0,i1)		_bosubi(_jit,i0,r0,i1)
+static jit_word_t _bosubi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bxsubr(i0,r0,r1)		_bxsubr(_jit,i0,r0,r1)
+static jit_word_t _bxsubr(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bxsubi(i0,r0,i1)		_bxsubi(_jit,i0,r0,i1)
+static jit_word_t _bxsubi(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define boaddr_u(i0,r0,r1)		_boaddr_u(_jit,i0,r0,r1)
+static jit_word_t _boaddr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define boaddi_u(i0,r0,i1)		_boaddi_u(_jit,i0,r0,i1)
+static jit_word_t _boaddi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bxaddr_u(i0,r0,r1)		_bxaddr_u(_jit,i0,r0,r1)
+static jit_word_t _bxaddr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bxaddi_u(i0,r0,i1)		_bxaddi_u(_jit,i0,r0,i1)
+static jit_word_t _bxaddi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bosubr_u(i0,r0,r1)		_bosubr_u(_jit,i0,r0,r1)
+static jit_word_t _bosubr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bosubi_u(i0,r0,i1)		_bosubi_u(_jit,i0,r0,i1)
+static jit_word_t _bosubi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#define bxsubr_u(i0,r0,r1)		_bxsubr_u(_jit,i0,r0,r1)
+static jit_word_t _bxsubr_u(jit_state_t*,jit_word_t,int32_t,int32_t);
+#define bxsubi_u(i0,r0,i1)		_bxsubi_u(_jit,i0,r0,i1)
+static jit_word_t _bxsubi_u(jit_state_t*,jit_word_t,int32_t,jit_word_t);
+#  define ldr_c(r0,r1)			_ldr_c(_jit,r0,r1)
+static void _ldr_c(jit_state_t*,int32_t,int32_t);
+#  define ldi_c(r0,i0)			_ldi_c(_jit,r0,i0)
+static void _ldi_c(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_c(r0,r1,i0)		_ldxr_c(_jit,r0,r1,i0)
+static void _ldxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_c(r0,r1,i0)		_ldxi_c(_jit,r0,r1,i0)
+static void _ldxi_c(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldr_uc(r0,r1)			LBZX(r0, _R0_REGNO, r1)
+#  define ldi_uc(r0,i0)			_ldi_uc(_jit,r0,i0)
+static void _ldi_uc(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_uc(r0,r1,r2)		_ldxr_uc(_jit,r0,r1,r2)
+static void _ldxr_uc(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_uc(r0,r1,i0)		_ldxi_uc(_jit,r0,r1,i0)
+static void _ldxi_uc(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldr_s(r0,r1)			LHAX(r0, _R0_REGNO, r1)
+#  define ldi_s(r0,i0)			_ldi_s(_jit,r0,i0)
+static void _ldi_s(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_s(r0,r1,i0)		_ldxr_s(_jit,r0,r1,i0)
+static void _ldxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_s(r0,r1,i0)		_ldxi_s(_jit,r0,r1,i0)
+static void _ldxi_s(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldr_us(r0,r1)			LHZX(r0, _R0_REGNO, r1)
+#  define ldi_us(r0,i0)			_ldi_us(_jit,r0,i0)
+static void _ldi_us(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_us(r0,r1,i0)		_ldxr_us(_jit,r0,r1,i0)
+static void _ldxr_us(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_us(r0,r1,i0)		_ldxi_us(_jit,r0,r1,i0)
+static void _ldxi_us(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define ldr_i(r0,r1)		LWZX(r0, _R0_REGNO, r1)
+#  else
+#    define ldr_i(r0,r1)		LWAX(r0, _R0_REGNO, r1)
+#  endif
+#  define ldi_i(r0,i0)			_ldi_i(_jit,r0,i0)
+static void _ldi_i(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_i(r0,r1,i0)		_ldxr_i(_jit,r0,r1,i0)
+static void _ldxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_i(r0,r1,i0)		_ldxi_i(_jit,r0,r1,i0)
+static void _ldxi_i(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 64
+#    define ldr_ui(r0,r1)		LWZX(r0, _R0_REGNO, r1)
+#    define ldi_ui(r0,i0)		_ldi_ui(_jit,r0,i0)
+static void _ldi_ui(jit_state_t*,int32_t,jit_word_t);
+#    define ldxr_ui(r0,r1,i0)		_ldxr_ui(_jit,r0,r1,i0)
+static void _ldxr_ui(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_ui(r0,r1,i0)		_ldxi_ui(_jit,r0,r1,i0)
+static void _ldxi_ui(jit_state_t*,int32_t,int32_t,jit_word_t);
+#    define ldr_l(r0,r1)		LDX(r0, _R0_REGNO, r1)
+#    define ldi_l(r0,i0)		_ldi_l(_jit,r0,i0)
+static void _ldi_l(jit_state_t*,int32_t,jit_word_t);
+#    define ldxr_l(r0,r1,i0)		_ldxr_l(_jit,r0,r1,i0)
+static void _ldxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_l(r0,r1,i0)		_ldxi_l(_jit,r0,r1,i0)
+static void _ldxi_l(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  endif
+#  define str_c(r0,r1)			STBX(r1, _R0_REGNO, r0)
+#  define sti_c(i0,r0)			_sti_c(_jit,i0,r0)
+static void _sti_c(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_c(r0,r1,r2)		_stxr_c(_jit,r0,r1,r2)
+static void _stxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_c(i0,r0,r1)		_stxi_c(_jit,i0,r0,r1)
+static void _stxi_c(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define str_s(r0,r1)			STHX(r1, _R0_REGNO, r0)
+#  define sti_s(i0,r0)			_sti_s(_jit,i0,r0)
+static void _sti_s(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_s(r0,r1,r2)		_stxr_s(_jit,r0,r1,r2)
+static void _stxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_s(i0,r0,r1)		_stxi_s(_jit,i0,r0,r1)
+static void _stxi_s(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define str_i(r0,r1)			STWX(r1, _R0_REGNO, r0)
+#  define sti_i(i0,r0)			_sti_i(_jit,i0,r0)
+static void _sti_i(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_i(r0,r1,r2)		_stxr_i(_jit,r0,r1,r2)
+static void _stxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_i(i0,r0,r1)		_stxi_i(_jit,i0,r0,r1)
+static void _stxi_i(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  if __WORDSIZE == 64
+#    define str_l(r0,r1)		STDX(r1, _R0_REGNO, r0)
+#    define sti_l(i0,r0)		_sti_l(_jit,i0,r0)
+static void _sti_l(jit_state_t*,jit_word_t,int32_t);
+#    define stxr_l(r0,r1,r2)		_stxr_l(_jit,r0,r1,r2)
+static void _stxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#    define stxi_l(i0,r0,r1)		_stxi_l(_jit,i0,r0,r1)
+static void _stxi_l(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  endif
+#  define jmpr(r0)			_jmpr(_jit,r0)
+static void _jmpr(jit_state_t*,int32_t);
+#  define jmpi(i0)			_jmpi(_jit,i0)
+static jit_word_t _jmpi(jit_state_t*,jit_word_t);
+#  define jmpi_p(i0)			_jmpi_p(_jit,i0)
+static jit_word_t _jmpi_p(jit_state_t*,jit_word_t) maybe_unused;
+#  define callr(r0)			_callr(_jit,r0)
+static void _callr(jit_state_t*,int32_t);
+#  define calli(i0)			_calli(_jit,i0)
+static void _calli(jit_state_t*,jit_word_t);
+#  define calli_p(i0)			_calli_p(_jit,i0)
+static jit_word_t _calli_p(jit_state_t*,jit_word_t);
+#  define prolog(node)			_prolog(_jit, node)
+static void _prolog(jit_state_t*, jit_node_t*);
+#  define epilog(node)			_epilog(_jit, node)
+static void _epilog(jit_state_t*, jit_node_t*);
+#  define vastart(r0)			_vastart(_jit, r0)
+static void _vastart(jit_state_t*, int32_t);
+#  define vaarg(r0, r1)			_vaarg(_jit, r0, r1)
+static void _vaarg(jit_state_t*, int32_t, int32_t);
+#  define patch_at(i,l)			_patch_at(_jit,i,l)
+static void _patch_at(jit_state_t*,jit_word_t,jit_word_t);
+#endif
+
+#if CODE
+#  define _u16(v)			((v) & 0xffff)
+#  define _u26(v)			((v) & 0x3ffffff)
+static void
+_FXO(jit_state_t *_jit, int o, int d, int a, int b, int e, int x, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(d & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(b & ~((1 << 5) - 1)));
+    assert(!(e & ~((1 << 1) - 1)));
+    assert(!(x & ~((1 << 9) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    ii((o<<26)|(d<<21)|(a<<16)|(b<<11)|(e<<10)|(x<<1)|r);
+}
+
+static void
+_FDs(jit_state_t *_jit, int o, int d, int a, int s)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(d & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(can_sign_extend_short_p(s));
+    ii((o<<26)|(d<<21)|(a<<16)|_u16(s));
+}
+
+static void
+_FDu(jit_state_t *_jit, int o, int d, int a, int s)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(d & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(can_zero_extend_short_p(s));
+    ii((o<<26)|(d<<21)|(a<<16)|_u16(s));
+}
+
+static void
+_FX(jit_state_t *_jit, int o, int s, int a, int b, int x, int r)
+{
+    assert(!(o & ~((1 <<  6) - 1)));
+    assert(!(s & ~((1 <<  5) - 1)));
+    assert(!(a & ~((1 <<  5) - 1)));
+    assert(!(b & ~((1 <<  5) - 1)));
+    assert(!(x & ~((1 << 10) - 1)));
+    assert(!(r & ~((1 <<  1) - 1)));
+    ii((o<<26)|(s<<21)|(a<<16)|(b<<11)|(x<<1)|r);
+}
+
+static void
+_FI(jit_state_t *_jit, int o, int t, int a, int k)
+{
+    assert(!(o & ~(( 1 <<  6) - 1)));
+    assert(!(t & 3) && can_sign_extend_jump_p(t));
+    assert(!(a & ~(( 1 <<  1) - 1)));
+    assert(!(k & ~(( 1 <<  1) - 1)));
+    ii((o<<26)|_u26(t)|(a<<1)|k);
+}
+
+static void
+_FB(jit_state_t *_jit, int o, int bo, int bi, int t, int a, int k)
+{
+    assert(!( o & ~((1 <<  6) - 1)));
+    assert(!(bo & ~((1 <<  5) - 1)));
+    assert(!(bi & ~((1 <<  5) - 1)));
+    assert(!(t & 3) && can_sign_extend_short_p(t));
+    assert(!(a & ~(( 1 <<  1) - 1)));
+    assert(!(k & ~(( 1 <<  1) - 1)));
+    ii((o<<26)|(bo<<21)|(bi<<16)|_u16(t)|(a<<1)|k);
+}
+
+static void
+_FXL(jit_state_t *_jit, int o, int bo, int bi, int x, int k)
+{
+    assert(!( o & ~((1 <<  6) - 1)));
+    assert(!(bo & ~((1 <<  5) - 1)));
+    assert(!(bi & ~((1 <<  5) - 1)));
+    assert(!(x & ~(( 1 << 10) - 1)));
+    assert(!(k & ~(( 1 <<  1) - 1)));
+    ii((o<<26)|(bo<<21)|(bi<<16)|(x<<1)|k);
+}
+
+static void
+_FC(jit_state_t *_jit, int o, int d, int l, int a, int b, int x)
+{
+    assert(!(o & ~((1 <<  6) - 1)));
+    assert(!(d & ~((1 <<  3) - 1)));
+    assert(!(l & ~((1 <<  1) - 1)));
+    assert(!(a & ~((1 <<  5) - 1)));
+    assert(!(b & ~((1 <<  5) - 1)));
+    assert(!(x & ~((1 << 10) - 1)));
+    ii((o<<26)|(d<<23)|(l<<21)|(a<<16)|(b<<11)|(x<<1));
+}
+
+static void
+_FCI(jit_state_t *_jit, int o, int d, int l, int a, int s)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(d & ~((1 << 3) - 1)));
+    assert(!(l & ~((1 << 1) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    if (o == 11)	assert(can_sign_extend_short_p(s));
+    else if (o == 10)	assert(can_zero_extend_short_p(s));
+#if DEBUG
+    else		abort();
+#endif
+    ii((o<<26)|(d<<23)|(l<<21)|(a<<16)|_u16(s));
+}
+
+static void
+_FXFX(jit_state_t *_jit, int o, int d, int x, int f)
+{
+    assert(!(o & ~((1 <<  6) - 1)));
+    assert(!(d & ~((1 <<  5) - 1)));
+    assert(!(x & ~((1 << 10) - 1)));
+    assert(!(f & ~((1 << 10) - 1)));
+    ii((o<<26)|(d<<21)|(x<<11)|(f<<1));
+}
+
+static void
+_FM(jit_state_t *_jit, int o, int s, int a, int h, int b, int e, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(s & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(h & ~((1 << 5) - 1)));
+    assert(!(b & ~((1 << 5) - 1)));
+    assert(!(e & ~((1 << 5) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    ii((o<<26)|(s<<21)|(a<<16)|(h<<11)|(b<<6)|(e<<1)|r);
+}
+
+#  if __WORDSIZE == 64
+static void
+_FMDS(jit_state_t *_jit, int o, int s, int a, int b, int e, int x, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(s & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(b & ~((1 << 5) - 1)));
+    assert(!(e & ~((1 << 6) - 1)));
+    assert(!(x & ~((1 << 4) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    e = (e >> 5) | ((e << 1) & 63);
+    ii((o<<26)|(s<<21)|(a<<16)|(b<<11)|(e<<5)|(x<<1)|r);
+}
+
+static void
+_FMD(jit_state_t *_jit, int o, int s, int a, int h, int e, int x, int i, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(s & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(h & ~((1 << 5) - 1)));
+    assert(!(e & ~((1 << 6) - 1)));
+    assert(!(x & ~((1 << 3) - 1)));
+    assert(!(i & ~((1 << 1) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    e = (e >> 5) | ((e << 1) & 63);
+    ii((o<<26)|(s<<21)|(a<<16)|(h<<11)|(e<<5)|(x<<2)|(i<<1)|r);
+}
+
+static void
+_FXS(jit_state_t *_jit, int o, int s, int a, int h, int x, int i, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(s & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(h & ~((1 << 5) - 1)));
+    assert(!(x & ~((1 << 9) - 1)));
+    assert(!(i & ~((1 << 1) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    ii((o<<26)|(s<<21)|(a<<16)|(h<<11)|(x<<2)|(i<<1)|r);
+}
+#endif
+
+#if !DEBUG
+/*
+ * Use the sequence commented at
+ * http://tenfourfox.blogspot.com/2011/04/attention-g5-owners-your-javascript-no.html
+ */
+static void
+_MCRXR(jit_state_t *_jit, int32_t cr)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    MFXER(rn(reg));
+    MTCRF(128, rn(reg));
+    RLWINM(rn(reg), rn(reg), 0, 0, 28);
+    MTXER(rn(reg));
+    jit_unget_reg(reg);
+}
+#endif
+
+static void
+_nop(jit_state_t *_jit, int32_t i0)
+{
+    for (; i0 > 0; i0 -= 4)
+	NOP();
+    assert(i0 == 0);
+}
+
+static void
+_movr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	MR(r0, r1);
+}
+
+static void
+_movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    if (can_sign_extend_short_p(i0))
+	LI(r0, i0);
+    else {
+	if (can_sign_extend_int_p(i0))
+	    LIS(r0, (int16_t)(i0 >> 16));
+	else if (can_zero_extend_int_p(i0)) {
+	    if (i0 & 0xffff0000) {
+		ORI(r0, r0, (uint16_t)(i0 >> 16));
+		SLWI(r0, r0, 16);
+	    }
+	}
+#  if __WORDSIZE == 64
+	else {
+	    movi(r0, (uint32_t)(i0 >> 32));
+	    if (i0 & 0xffff0000) {
+		SLDI(r0, r0, 16);
+		ORI(r0, r0, (uint16_t)(i0 >> 16));
+		SLDI(r0, r0, 16);
+	    }
+	    else
+		SLDI(r0, r0, 32);
+	}
+#  endif
+	if (i0 & 0xffff)
+	    ORI(r0, r0, (uint16_t)i0);
+    }
+}
+
+static jit_word_t
+_movi_p(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_word_t		word = _jit->pc.w;
+#  if __WORDSIZE == 32
+    LIS(r0, (int16_t)(i0 >> 16));
+    ORI(r0, r0, (uint16_t)i0);
+#  else
+    LIS(r0, (int16_t)(i0 >> 48));
+    ORI(r0, r0, (uint16_t)(i0 >> 32));
+    SLDI(r0, r0, 16);
+    ORI(r0, r0, (uint16_t)(i0 >> 16));
+    SLDI(r0, r0, 16);
+    ORI(r0, r0, (uint16_t)i0);
+#  endif
+    return (word);
+}
+
+#  if __BYTE_ORDER == __LITTLE_ENDIAN
+static void
+_bswapr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		t0;
+    t0 = jit_get_reg(jit_class_gpr);
+    rshi(rn(t0), r1, 8);
+    andi(r0, r1, 0xff);
+    andi(rn(t0), rn(t0), 0xff);
+    lshi(r0, r0, 8);
+    orr(r0, r0, rn(t0));
+    jit_unget_reg(t0);
+}
+
+static void
+_bswapr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    ROTLWI(rn(reg), r1, 8);
+    RLWIMI(rn(reg), r1, 24, 0, 7);
+    RLWIMI(rn(reg), r1, 24, 16, 23);
+    CLRLDI(r0, rn(reg), 32);
+    jit_unget_reg(reg);
+}
+
+#    if __WORDSIZE == 64
+static void
+_bswapr_ul(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    rshi_u(rn(reg), r1, 32);
+    bswapr_ui(r0, r1);
+    bswapr_ui(rn(reg), rn(reg));
+    lshi(r0, r0, 32);
+    orr(r0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+#    endif
+#  endif
+
+static void
+_addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	ADDI(r0, r1, i0);
+    else if (can_zero_extend_int_p(i0) && !(i0 & 0x0000ffff))
+	ADDIS(r0, r1, i0 >> 16);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ADD(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	ADDIC(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ADDC(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    ADDE(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    jit_word_t		ni0 = -i0;
+    if (can_sign_extend_short_p(ni0))
+	ADDI(r0, r1, ni0);
+    else if (can_zero_extend_int_p(ni0) && !(ni0 & 0x0000ffff))
+	ADDIS(r0, r1, ni0 >> 16);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	SUB(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    SUBC(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    SUBE(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_rsbi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    subi(r0, r1, i0);
+    negr(r0, r0);
+}
+
+static void
+_muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	MULLI(r0, r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	mulr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_iqmulr(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, int32_t r3, jit_bool_t sign)
+{
+    int32_t		reg;
+    if (r0 == r2 || r0 == r3) {
+	reg = jit_get_reg(jit_class_gpr);
+	mullr(rn(reg), r2, r3);
+    }
+    else
+	mullr(r0, r2, r3);
+    if (sign)
+	mulhr(r1, r2, r3);
+    else
+	mulhr_u(r1, r2, r3);
+    if (r0 == r2 || r0 == r3) {
+	movr(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_iqmuli(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    iqmulr(r0, r1, r2, rn(reg), sign);
+    jit_unget_reg(reg);
+}
+
+static void
+_divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    divr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    divr_u(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_iqdivr(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, int32_t r3, jit_bool_t sign)
+{
+    int32_t		sv0, rg0;
+    int32_t		sv1, rg1;
+
+    if (r0 == r2 || r0 == r3) {
+	sv0 = jit_get_reg(jit_class_gpr);
+	rg0 = rn(sv0);
+    }
+    else
+	rg0 = r0;
+    if (r1 == r2 || r1 == r3) {
+	sv1 = jit_get_reg(jit_class_gpr);
+	rg1 = rn(sv1);
+    }
+    else
+	rg1 = r1;
+
+    if (sign)
+	divr(rg0, r2, r3);
+    else
+	divr_u(rg0, r2, r3);
+    mulr(rg1, r3, rg0);
+    subr(rg1, r2, rg1);
+    if (rg0 != r0) {
+	movr(r0, rg0);
+	jit_unget_reg(sv0);
+    }
+    if (rg1 != r1) {
+	movr(r1, rg1);
+	jit_unget_reg(sv1);
+    }
+}
+
+static void
+_iqdivi(jit_state_t *_jit, int32_t r0, int32_t r1,
+	int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    iqdivr(r0, r1, r2, rn(reg), sign);
+    jit_unget_reg(reg);
+}
+
+static void
+_remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r1 || r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	divr(rn(reg), r1, r2);
+	mulr(rn(reg), r2, rn(reg));
+	subr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	divr(r0, r1, r2);
+	mulr(r0, r2, r0);
+	subr(r0, r1, r0);
+    }
+}
+
+static void
+_remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    remr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r1 || r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	divr_u(rn(reg), r1, r2);
+	mulr(rn(reg), r2, rn(reg));
+	subr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	divr_u(r0, r1, r2);
+	mulr(r0, r2, r0);
+	subr(r0, r1, r0);
+    }
+}
+
+static void
+_remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    remr_u(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	ANDI_(r0, r1, i0);
+    else if (can_zero_extend_int_p(i0) && !(i0 & 0x0000ffff))
+	ANDIS_(r0, r1, (jit_uword_t)i0 >> 16);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	AND(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	ORI(r0, r1, i0);
+    else if (can_zero_extend_int_p(i0) && !(i0 & 0x0000ffff))
+	ORIS(r0, r1, (jit_uword_t)i0 >> 16);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	OR(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	XORI(r0, r1, i0);
+    else if (can_zero_extend_int_p(i0) && !(i0 & 0x0000ffff))
+	XORIS(r0, r1, (jit_uword_t)i0 >> 16);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	XOR(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    if (i0 == 0)
+	movr(r0, r1);
+    else {
+#  if __WORDSIZE == 32
+	SLWI(r0, r1, i0);
+#  else
+	SLDI(r0, r1, i0);
+#  endif
+    }
+}
+
+static void
+_rshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    if (i0 == 0)
+	movr(r0, r1);
+    else {
+#  if __WORDSIZE == 32
+	SRAWI(r0, r1, i0);
+#  else
+	SRADI(r0, r1, i0);
+#  endif
+    }
+}
+
+static void
+_rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    if (i0 == 0)
+	movr(r0, r1);
+    else {
+#  if __WORDSIZE == 32
+	SRWI(r0, r1, i0);
+#  else
+	SRDI(r0, r1, i0);
+#  endif
+    }
+}
+
+static void
+_ltr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_lti(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_ltr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPLW(r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_lti_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPLW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_ler(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    CRNOT(CR_GT, CR_GT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_lei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    CRNOT(CR_GT, CR_GT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_ler_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPLW(r1, r2);
+    CRNOT(CR_GT, CR_GT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_lei_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPLW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    CRNOT(CR_GT, CR_GT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_eqr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+
+static void
+_eqi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+
+static void
+_ger(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    CRNOT(CR_LT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_gei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    CRNOT(CR_LT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_ger_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPLW(r1, r2);
+    CRNOT(CR_LT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_gei_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPLW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    CRNOT(CR_LT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+
+static void
+_gtr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_gti(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_gtr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPLW(r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_gti_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPLW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+
+static void
+_ner(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    CMPW(r1, r2);
+    CRNOT(CR_EQ, CR_EQ);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+
+static void
+_nei(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (can_sign_extend_short_p(i0))
+	CMPWI(r1, i0);
+    else if (can_zero_extend_short_p(i0))
+	CMPLWI(r1, i0);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	CMPW(r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+    CRNOT(CR_EQ, CR_EQ);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+
+static jit_word_t
+_bltr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+
+static jit_word_t
+_blti(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+
+static jit_word_t
+_bltr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPLW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+
+static jit_word_t
+_blti_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPLW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+
+static jit_word_t
+_bler(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_blei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_bler_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPLW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_blei_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPLW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_beqr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+
+static jit_word_t
+_beqi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+
+static jit_word_t
+_bger(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGE(d);
+    return (w);
+}
+
+static jit_word_t
+_bgei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGE(d);
+    return (w);
+}
+
+static jit_word_t
+_bger_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPLW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGE(d);
+    return (w);
+}
+
+static jit_word_t
+_bgei_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPLW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGE(d);
+    return (w);
+}
+
+static jit_word_t
+_bgtr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+
+static jit_word_t
+_bgti(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+
+static jit_word_t
+_bgtr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPLW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+
+static jit_word_t
+_bgti_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPLW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+
+static jit_word_t
+_bner(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    CMPW(r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNE(d);
+    return (w);
+}
+
+static jit_word_t
+_bnei(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1))
+	CMPWI(r0, i1);
+    else if (can_zero_extend_short_p(i1))
+	CMPLWI(r0, i1);
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i1);
+	CMPW(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNE(d);
+    return (w);
+}
+
+static jit_word_t
+_bmsr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    andr(rn(reg), r0, r1);
+    w = bnei(i0, rn(reg), 0);
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bmsi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    andi(rn(reg), r0, i1);
+    w = bnei(i0, rn(reg), 0);
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bmcr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    andr(rn(reg), r0, r1);
+    w = beqi(i0, rn(reg), 0);
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bmci(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    andi(rn(reg), r0, i1);
+    w = beqi(i0, rn(reg), 0);
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_boaddr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    ADDO(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);				/* GT = bit 1 of XER = OV */
+    return (w);
+}
+
+static jit_word_t
+_boaddi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = boaddr(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bxaddr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    ADDO(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_bxaddi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bxaddr(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bosubr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    SUBO(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+
+static jit_word_t
+_bosubi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bosubr(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bxsubr(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    SUBO(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+
+static jit_word_t
+_bxsubi(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bxsubr(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_boaddr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    ADDC(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);				/* EQ = bit 2 of XER = CA */
+    return (w);
+}
+
+static jit_word_t
+_boaddi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1)) {
+	ADDIC(r0, r0, i1);
+	MCRXR(CR_0);
+	w = _jit->pc.w;
+	d = (i0 - w) & ~3;
+	BEQ(d);
+	return (w);
+    }
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = boaddr_u(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bxaddr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    ADDC(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNE(d);
+    return (w);
+}
+
+static jit_word_t
+_bxaddi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    jit_word_t		d, w;
+    if (can_sign_extend_short_p(i1)) {
+	ADDIC(r0, r0, i1);
+	MCRXR(CR_0);
+	w = _jit->pc.w;
+	d = (i0 - w) & ~3;
+	BNE(d);
+	return (w);
+    }
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bxaddr_u(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bosubr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    SUBC(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNE(d);				/* PPC uses "carry" not "borrow" */
+    return (w);
+}
+
+static jit_word_t
+_bosubi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bosubr_u(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bxsubr_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    SUBC(r0, r0, r1);
+    MCRXR(CR_0);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+
+static jit_word_t
+_bxsubi_u(jit_state_t *_jit, jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bxsubr_u(i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_ldr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    ldr_uc(r0, r1);
+    extr_c(r0, r0);
+}
+
+static void
+_ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    ldi_uc(r0, i0);
+    extr_c(r0, r0);
+}
+
+static void
+_ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    ldxr_uc(r0, r1, r2);
+    extr_c(r0, r0);
+}
+
+static void
+_ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    ldxi_uc(r0, r1, i0);
+    extr_c(r0, r0);
+}
+
+static void
+_ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LBZ(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LBZ(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_uc(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LBZX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LBZX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LBZX(r0, r1, r2);
+}
+
+static void
+_ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_uc(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LBZ(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LBZ(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_uc(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LHA(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LHA(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_s(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LHAX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LHAX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LHAX(r0, r1, r2);
+}
+
+static void
+_ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_s(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LHA(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LHA(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_s(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LHZ(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LHZ(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_us(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LHZX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LHZX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LHZX(r0, r1, r2);
+}
+
+static void
+_ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_us(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LHZ(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LHZ(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_us(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+#  if __WORDSIZE == 32
+static void
+_ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LWZ(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LWZ(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_i(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LWZX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWZX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LWZX(r0, r1, r2);
+}
+
+static void
+_ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_i(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWZ(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LWZ(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_i(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+#  else
+static void
+_ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LWA(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LWA(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_i(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LWZX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWAX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LWZX(r0, r1, r2);
+}
+
+static void
+_ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_i(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWA(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LWA(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_i(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_ui(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LWZ(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LWZ(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_ui(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_ui(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LWZX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWZX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LWZX(r0, r1, r2);
+}
+
+static void
+_ldxi_ui(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_i(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LWZ(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LWZ(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_ui(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_l(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LD(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LD(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_l(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LDX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LDX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LDX(r0, r1, r2);
+}
+
+static void
+_ldxi_l(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_l(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LD(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LD(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_l(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+#  endif
+
+static void
+_sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STB(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STB(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_c(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STBX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r0);
+	    STBX(r2, rn(reg), r1);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STBX(r2, r0, r1);
+}
+
+static void
+_stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_c(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STB(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STB(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_c(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STH(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STH(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_s(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STHX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r0);
+	    STHX(r2, rn(reg), r1);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STHX(r2, r0, r1);
+}
+
+static void
+_stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_s(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STH(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STH(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_s(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STW(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STW(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_i(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STWX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r0);
+	    STWX(r2, rn(reg), r1);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STWX(r2, r0, r1);
+}
+
+static void
+_stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_i(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STW(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STW(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_i(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+
+#  if __WORDSIZE == 64
+static void
+_sti_l(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STD(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STD(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_l(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STDX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r0);
+	    STDX(r2, rn(reg), r1);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STDX(r2, r0, r1);
+}
+
+static void
+_stxi_l(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_l(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STD(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STD(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_l(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+#  endif
+
+static void
+_jmpr(jit_state_t *_jit, int32_t r0)
+{
+#if 0
+    MTLR(r0);
+    BLR();
+#else
+    MTCTR(r0);
+    BCTR();
+#endif
+}
+
+/* pc relative jump */
+static jit_word_t
+_jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+    int32_t		reg;
+    jit_word_t		w, d;
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    if (can_sign_extend_jump_p(d))
+	B(d);
+    else {
+	reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+	w = movi_p(rn(reg), i0);
+	jmpr(rn(reg));
+	jit_unget_reg(reg);
+    }
+    return (w);
+}
+
+/* absolute jump */
+static jit_word_t
+_jmpi_p(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    w = movi_p(rn(reg), i0);
+    jmpr(rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_callr(jit_state_t *_jit, int32_t r0)
+{
+#  if __powerpc__
+#    if ABI_ELFv2
+    movr(_R12_REGNO, r0);
+#    else
+    stxi(sizeof(void*) * 5, _SP_REGNO, _R2_REGNO);
+    /* FIXME Pretend to not know about r11? */
+    if (r0 == _R0_REGNO) {
+	movr(_R11_REGNO, _R0_REGNO);
+	ldxi(_R2_REGNO, _R11_REGNO, sizeof(void*));
+	ldxi(_R11_REGNO, _R11_REGNO, sizeof(void*) * 2);
+    }
+    else {
+	ldxi(_R2_REGNO, r0, sizeof(void*));
+	ldxi(_R11_REGNO, r0, sizeof(void*) * 2);
+    }
+    ldr(r0, r0);
+#    endif
+#  endif
+
+    MTCTR(r0);
+    BCTRL();
+
+#  if __powerpc__ && !ABI_ELFv2
+    ldxi(_R2_REGNO, _SP_REGNO, sizeof(void*) * 5);
+#  endif
+}
+
+/* assume fixed address or reachable address */
+static void
+_calli(jit_state_t *_jit, jit_word_t i0)
+{
+#  if __ppc__
+    jit_word_t		d;
+#  endif
+    int32_t		reg;
+#  if __ppc__
+    d = (i0 - _jit->pc.w) & ~3;
+    if (can_sign_extend_jump_p(d))
+	BL(d);
+    else
+#  endif
+    {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	callr(rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+/* absolute jump */
+static jit_word_t
+_calli_p(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    w = movi_p(rn(reg), i0);
+    callr(rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+#  if __powerpc__
+/* order is not guaranteed to be sequential */
+static int32_t save[] = {
+    _R14, _R15, _R16, _R17, _R18, _R19, _R20, _R21, _R22,
+    _R23, _R24, _R25, _R26, _R27, _R28, _R29, _R30, _R31,
+};
+#endif
+
+static void
+_prolog(jit_state_t *_jit, jit_node_t *node)
+{
+    unsigned long	regno;
+    jit_word_t		offset;
+
+    if (_jitc->function->define_frame || _jitc->function->assume_frame) {
+	int32_t	frame = -_jitc->function->frame;
+	assert(_jitc->function->self.aoff >= frame);
+	if (_jitc->function->assume_frame)
+	    return;
+	_jitc->function->self.aoff = frame;
+    }
+    if (_jitc->function->allocar) {
+	_jitc->function->self.aoff -= 2 * sizeof(jit_word_t);
+	_jitc->function->self.aoff &= -16;
+    }
+    _jitc->function->stack = ((_jitc->function->self.alen +
+			      _jitc->function->self.size -
+			      _jitc->function->self.aoff) + 15) & -16;
+
+    /* return address */
+    MFLR(_R0_REGNO);
+
+    /* params >= %r31+params_offset+(8*sizeof(jit_word_t))
+     * alloca <  %r31-80 */
+
+#if __ppc__
+    /* save any clobbered callee save gpr register */
+    regno = jit_regset_scan1(&_jitc->function->regset, _R14);
+    if (regno == ULONG_MAX || regno > _R31)
+	regno = _R31;	/* aka _FP_REGNO */
+    STMW(rn(regno), _SP_REGNO, -fpr_save_area - (32 * 4) + rn(regno) * 4);
+    for (offset = 0; offset < 8; offset++) {
+	if (jit_regset_tstbit(&_jitc->function->regset, _F14 + offset))
+	    stxi_d(-fpr_save_area + offset * 8, _SP_REGNO, rn(_F14 + offset));
+    }
+
+    stxi(8, _SP_REGNO, _R0_REGNO);
+#else		/* __powerpc__ */
+    stxi(sizeof(void*) * 2, _SP_REGNO, _R0_REGNO);
+    offset = -gpr_save_area;
+    for (regno = 0; regno < jit_size(save); regno++, offset += sizeof(void*)) {
+	if (jit_regset_tstbit(&_jitc->function->regset, save[regno]))
+	    stxi(offset, _SP_REGNO, rn(save[regno]));
+    }
+    for (offset = 0; offset < 8; offset++) {
+	if (jit_regset_tstbit(&_jitc->function->regset, _F14 + offset))
+	    stxi_d(-(gpr_save_area + 8 + offset * 8),
+		   _SP_REGNO, rn(_F14 + offset));
+    }
+
+    stxi(-(sizeof(void*)), _SP_REGNO, _FP_REGNO);
+#endif
+
+    movr(_FP_REGNO, _SP_REGNO);
+#if __WORDSIZE == 32
+    STWU(_SP_REGNO, _SP_REGNO, -_jitc->function->stack);
+#else
+    STDU(_SP_REGNO, _SP_REGNO, -_jitc->function->stack);
+#endif
+
+    if (_jitc->function->allocar) {
+	regno = jit_get_reg(jit_class_gpr);
+	movi(rn(regno), _jitc->function->self.aoff);
+	stxi_i(_jitc->function->aoffoff, _FP_REGNO, rn(regno));
+	jit_unget_reg(regno);
+    }
+
+    if (_jitc->function->self.call & jit_call_varargs) {
+	for (regno = _jitc->function->vagp; jit_arg_reg_p(regno); ++regno)
+	    stxi(params_offset + regno * sizeof(jit_word_t),
+		 _FP_REGNO, rn(JIT_RA0 - regno));
+    }
+}
+
+static void
+_epilog(jit_state_t *_jit, jit_node_t *node)
+{
+    unsigned long	regno;
+    jit_word_t		offset;
+
+    if (_jitc->function->assume_frame)
+	return;
+#if __ppc__
+    LWZ(_SP_REGNO, _SP_REGNO, 0);
+    ldxi(_R0_REGNO, _SP_REGNO, 8);
+
+    MTLR(_R0_REGNO);
+
+    regno = jit_regset_scan1(&_jitc->function->regset, _R14);
+    if (regno == ULONG_MAX || regno > _R31)
+	regno = _R31;	/* aka _FP_REGNO */
+    LMW(rn(regno), _SP_REGNO, -fpr_save_area - (32 * 4) + rn(regno) * 4);
+    for (offset = 0; offset < 8; offset++) {
+	if (jit_regset_tstbit(&_jitc->function->regset, _F14 + offset))
+	    ldxi_d(rn(_F14 + offset), _SP_REGNO, -fpr_save_area + offset * 8);
+    }
+
+#else		/* __powerpc__ */
+    if (_jitc->function->allocar)
+	ldr(_SP_REGNO, _SP_REGNO);
+    else
+	addi(_SP_REGNO, _SP_REGNO, _jitc->function->stack);
+    ldxi(_R0_REGNO, _SP_REGNO, sizeof(void*) * 2);
+    offset = -gpr_save_area;
+    for (regno = 0; regno < jit_size(save); regno++, offset += sizeof(void*)) {
+	if (jit_regset_tstbit(&_jitc->function->regset, save[regno]))
+	    ldxi(rn(save[regno]), _SP_REGNO, offset);
+    }
+    for (offset = 0; offset < 8; offset++) {
+	if (jit_regset_tstbit(&_jitc->function->regset, _F14 + offset))
+	    ldxi_d(rn(_F14 + offset), _SP_REGNO,
+		   -(gpr_save_area + 8 + offset * 8));
+    }
+
+    MTLR(_R0_REGNO);
+    ldxi(_FP_REGNO, _SP_REGNO, -(sizeof(void*)));
+#endif
+
+    BLR();
+}
+
+static void
+_vastart(jit_state_t *_jit, int32_t r0)
+{
+    assert(_jitc->function->self.call & jit_call_varargs);
+
+    /* Initialize stack pointer to the first stack argument. */
+    addi(r0, _FP_REGNO, _jitc->function->self.size);
+}
+
+static void
+_vaarg(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    assert(_jitc->function->self.call & jit_call_varargs);
+
+    /* Load argument. */
+    ldr(r0, r1);
+
+    /* Update va_list. */
+    addi(r1, r1, sizeof(jit_word_t));
+}
+
+static void
+_patch_at(jit_state_t *_jit, jit_word_t instr, jit_word_t label)
+{
+    jit_word_t		 d;
+    union {
+	int32_t	*i;
+	jit_word_t	 w;
+    } u;
+    u.w = instr;
+    switch ((u.i[0] & 0xfc000000) >> 26) {
+	case 16:					/* BCx */
+	    d = label - instr;
+	    assert(!(d & 3));
+	    if (!can_sign_extend_short_p(d)) {
+		/* use absolute address */
+		assert(can_sign_extend_short_p(label));
+		d |= 2;
+	    }
+	    u.i[0] = (u.i[0] & ~0xfffd) | (d & 0xfffe);
+	    break;
+	case 18:					/* Bx */
+#if __powerpc__ && !ABI_ELFv2
+	    if (_jitc->jump && (!(u.i[0] & 1))) {	/* jmpi label */
+		/* zero is used for toc and env, so, quick check
+		 * if this is a "jmpi main" like initial jit
+		 * instruction */
+		if (((long *)label)[1] == 0 && ((long *)label)[2] == 0) {
+		    for (d = 0; d < _jitc->prolog.offset; d++) {
+			/* not so pretty, but hides powerpc
+			 * specific abi intrinsics and/or
+			 * implementation from user */
+			if (_jitc->prolog.ptr[d] == label) {
+			    label += sizeof(void*) * 3;
+			    break;
+			}
+		    }
+		}
+	    }
+#endif
+	    d = label - instr;
+	    assert(!(d & 3));
+	    if (!can_sign_extend_jump_p(d)) {
+		/* use absolute address */
+		assert(can_sign_extend_jump_p(label));
+		d |= 2;
+	    }
+	    u.i[0] = (u.i[0] & ~0x3fffffd) | (d & 0x3fffffe);
+	    break;
+	case 15:					/* LI */
+#if __WORDSIZE == 32
+#  define MTCTR_OFF		2
+#  define BCTR_OFF		3
+#else
+#  define MTCTR_OFF		6
+#  define BCTR_OFF		7
+#endif
+	    /* movi reg label; jmpr reg */
+	    if (_jitc->jump &&
+#if 0
+		/* check for MLTR(reg) */
+		(u.i[MTCTR_OFF] >> 26) == 31 &&
+		((u.i[MTCTR_OFF] >> 16) & 0x3ff) == 8 &&
+		((u.i[MTCTR_OFF] >> 1) & 0x3ff) == 467 &&
+		/* check for BLR */
+		u.i[BCTR_OFF] == 0x4e800020) {
+#else
+		/* check for MTCTR(reg) */
+		(u.i[MTCTR_OFF] >> 26) == 31 &&
+		((u.i[MTCTR_OFF] >> 16) & 0x3ff) == 9 &&
+		((u.i[MTCTR_OFF] >> 1) & 0x3ff) == 467 &&
+		/* check for BCTR */
+		u.i[BCTR_OFF] == 0x4e800420) {
+#endif
+		/* zero is used for toc and env, so, quick check
+		 * if this is a "jmpi main" like initial jit
+		 * instruction */
+		if (((long *)label)[1] == 0 && ((long *)label)[2] == 0) {
+		    for (d = 0; d < _jitc->prolog.offset; d++) {
+			/* not so pretty, but hides powerpc
+			 * specific abi intrinsics and/or
+			 * implementation from user */
+			if (_jitc->prolog.ptr[d] == label) {
+			    label += sizeof(void*) * 3;
+			    break;
+			}
+		    }
+		}
+	    }
+#undef BCTR_OFF
+#undef MTCTR_OFF
+#if __WORDSIZE == 32
+	    assert(!(u.i[0] & 0x1f0000));
+	    u.i[0] = (u.i[0] & ~0xffff) | ((label >> 16) & 0xffff);
+	    assert((u.i[1] & 0xfc000000) >> 26 == 24);	/* ORI */
+	    assert(((u.i[1] >> 16) & 0x1f) == ((u.i[1] >> 21) & 0x1f));
+	    u.i[1] = (u.i[1] & ~0xffff) | (label & 0xffff);
+#else
+	    assert(!(u.i[0] & 0x1f0000));
+	    u.i[0] = (u.i[0] & ~0xffff) | ((label >> 48) & 0xffff);
+	    assert((u.i[1] & 0xfc000000) >> 26 == 24);	/* ORI */
+	    assert(((u.i[1] >> 16) & 0x1f) == ((u.i[1] >> 21) & 0x1f));
+	    u.i[1] = (u.i[1] & ~0xffff) | ((label >> 32) & 0xffff);
+	    /* not fully validating SLDI */
+	    assert((u.i[2] & 0xfc000000) >> 26 == 30);	/* SLDI */
+	    assert(((u.i[2] >> 16) & 0x1f) == ((u.i[2] >> 21) & 0x1f));
+	    assert((u.i[3] & 0xfc000000) >> 26 == 24);	/* ORI */
+	    assert(((u.i[3] >> 16) & 0x1f) == ((u.i[3] >> 21) & 0x1f));
+	    u.i[3] = (u.i[3] & ~0xffff) | ((label >> 16) & 0xffff);
+	    /* not fully validating SLDI */
+	    assert((u.i[4] & 0xfc000000) >> 26 == 30);	/* SLDI */
+	    assert(((u.i[4] >> 16) & 0x1f) == ((u.i[4] >> 21) & 0x1f));
+	    assert((u.i[5] & 0xfc000000) >> 26 == 24);	/* ORI */
+	    assert(((u.i[5] >> 16) & 0x1f) == ((u.i[5] >> 21) & 0x1f));
+	    u.i[5] = (u.i[5] & ~0xffff) | (label & 0xffff);
+#endif
+	    break;
+	default:
+	    assert(!"unhandled branch opcode");
+    }
+}
+#endif
diff --git a/libguile/lightening/lightening/ppc-fpu.c b/libguile/lightening/lightening/ppc-fpu.c
new file mode 100644
index 000000000..da7ac0cbe
--- /dev/null
+++ b/libguile/lightening/lightening/ppc-fpu.c
@@ -0,0 +1,1194 @@
+/*
+ * Copyright (C) 2012-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+#define FA(o,d,a,b,c,x)			_FA(_jit,o,d,a,b,c,x,0)
+#define FA_(o,d,a,b,c,x)		_FA(_jit,o,d,a,b,c,x,1)
+static void _FA(jit_state_t*,int,int,int,int,int,int,int);
+#define FXFL(o,m,b,x)			_FXFL(_jit,o,m,b,x,0)
+#define FXFL_(o,m,b,x)			_FXFL(_jit,o,m,b,x,1)
+static void _FXFL(jit_state_t*,int,int,int,int,int) maybe_unused;
+#  define FABS(d,b)			FX(63,d,0,b,264)
+#  define FABS_(d,b)			FX_(63,d,0,b,264)
+#  define FADD(d,a,b)			FA(63,d,a,b,0,21)
+#  define FADD_(d,a,b)			FA_(63,d,a,b,0,21)
+#  define FADDS(d,a,b)			FA(59,d,a,b,0,21)
+#  define FADDS_(d,a,b)			FA_(59,d,a,b,0,21)
+#  define FCFID(d,b)			FX(63,d,0,b,846)
+#  define FCMPO(cr,a,b)			FC(63,cr,0,a,b,32)
+#  define FCMPU(cr,a,b)			FC(63,cr,0,a,b,0)
+#  define FCTIW(d,b)			FX(63,d,0,b,14)
+#  define FCTIW_(d,b)			FX_(63,d,0,b,14)
+#  define FCTIWZ(d,b)			FX(63,d,0,b,15)
+#  define FCTIWZ_(d,b)			FX_(63,d,0,b,15)
+#  define FCTID(d,b)			FX(63,d,0,b,814)
+#  define FCTID_(d,b)			FX_(63,d,0,b,814)
+#  define FCTIDZ(d,b)			FX(63,d,0,b,815)
+#  define FCTIDZ_(d,b)			FX_(63,d,0,b,815)
+#  define FDIV(d,a,b)			FA(63,d,a,b,0,18)
+#  define FDIV_(d,a,b)			FA_(63,d,a,b,0,18)
+#  define FDIVS(d,a,b)			FA(59,d,a,b,0,18)
+#  define FDIVS_(d,a,b)			FA_(59,d,a,b,0,18)
+#  define FMADD(d,a,b,c)		FA(63,d,a,b,c,29)
+#  define FMADD_(d,a,b,c)		FA(63,d,a,b,c,29)
+#  define FMADDS(d,a,b,c)		FA(59,d,a,b,c,29)
+#  define FMADDS_(d,a,b,c)		FA(59,d,a,b,c,29)
+#  define FMR(d,b)			FX(63,d,0,b,72)
+#  define FMR_(d,b)			FX_(63,d,0,b,72)
+#  define FMSUB(d,a,b,c)		FA(63,d,a,b,c,28)
+#  define FMSUB_(d,a,b,c)		FA(63,d,a,b,c,28)
+#  define FMSUBS(d,a,b,c)		FA(59,d,a,b,c,28)
+#  define FMSUBS_(d,a,b,c)		FA(59,d,a,b,c,28)
+#  define FMUL(d,a,c)			FA(63,d,a,0,c,25)
+#  define FMUL_(d,a,c)			FA_(63,d,a,0,c,25)
+#  define FMULS(d,a,c)			FA(59,d,a,0,c,25)
+#  define FMULS_(d,a,c)			FA_(59,d,a,0,c,25)
+#  define FNABS(d,b)			FX(63,d,0,b,136)
+#  define FNABS_(d,b)			FX_(63,d,0,b,136)
+#  define FNEG(d,b)			FX(63,d,0,b,40)
+#  define FNEG_(d,b)			FX_(63,d,0,b,40)
+#  define FNMADD(d,a,b,c)		FA(63,d,a,b,c,31)
+#  define FNMADD_(d,a,b,c)		FA_(63,d,a,b,c,31)
+#  define FNMADDS(d,a,b,c)		FA(59,d,a,b,c,31)
+#  define FNMADDS_(d,a,b,c)		FA_(59,d,a,b,c,31)
+#  define FNMSUB(d,a,b,c)		FA(63,d,a,b,c,30)
+#  define FNMSUB_(d,a,b,c)		FA_(63,d,a,b,c,30)
+#  define FNMSUBS(d,a,b,c)		FA(59,d,a,b,c,30)
+#  define FNMSUBS_(d,a,b,c)		FA_(59,d,a,b,c,30)
+#  define FRES(d,b)			FA(59,d,0,b,0,24)
+#  define FRES_(d,b)			FA_(59,d,0,b,0,24)
+#  define FRSP(d,b)			FA(63,d,0,b,0,12)
+#  define FRSP_(d,b)			FA_(63,d,0,b,0,12)
+#  define FRSQTRE(d,b)			FA(63,d,0,b,0,26)
+#  define FRSQTRE_(d,b)			FA_(63,d,0,b,0,26)
+#  define FSEL(d,a,b,c)			FA(63,d,a,b,c,23)
+#  define FSEL_(d,a,b,c)		FA_(63,d,a,b,c,23)
+#  define FSQRT(d,b)			FA(63,d,0,b,0,22)
+#  define FSQRT_(d,b)			FA_(63,d,0,b,0,22)
+#  define FSQRTS(d,b)			FA(59,d,0,b,0,22)
+#  define FSQRTS_(d,b)			FA_(59,d,0,b,0,22)
+#  define FSUB(d,a,b)			FA(63,d,a,b,0,20)
+#  define FSUB_(d,a,b)			FA(63,d,a,b,0,20)
+#  define FSUBS(d,a,b)			FA(59,d,a,b,0,20)
+#  define FSUBS_(d,a,b)			FA(59,d,a,b,0,20)
+#  define LFD(d,a,s)			FDs(50,d,a,s)
+#  define LFDU(d,a,s)			FDs(51,d,a,s)
+#  define LFDUX(d,a,b)			FX(31,d,a,b,631)
+#  define LFDX(d,a,b)			FX(31,d,a,b,599)
+#  define LFS(d,a,s)			FDs(48,d,a,s)
+#  define LFSU(d,a,s)			FDs(49,d,a,s)
+#  define LFSUX(d,a,b)			FX(31,d,a,b,567)
+#  define LFSX(d,a,b)			FX(31,d,a,b,535)
+#  define MCRFS(d,s)			FXL(63,d<<2,(s)<<2,64)
+#  define MFFS(d)			FX(63,d,0,0,583)
+#  define MFFS_(d)			FX_(63,d,0,0,583)
+#  define MTFSB0(d)			FX(63,d,0,0,70)
+#  define MTFSB0_(d)			FX_(63,d,0,0,70)
+#  define MTFSB1(d)			FX(63,d,0,0,38)
+#  define MTFSB1_(d)			FX_(63,d,0,0,38)
+#  define MTFSF(m,b)			FXFL(63,m,b,711)
+#  define MTFSF_(m,b)			FXFL_(63,m,b,711)
+#  define MTFSFI(d,i)			FX(63,d<<2,0,i<<1,134)
+#  define MTFSFI_(d,i)			FX_(63,d<<2,0,i<<1,134)
+#  define STFD(s,a,d)			FDs(54,s,a,d)
+#  define STFDU(s,a,d)			FDs(55,s,a,d)
+#  define STFDUX(s,a,b)			FX(31,s,a,b,759)
+#  define STFDX(s,a,b)			FX(31,s,a,b,727)
+#  define STFIWX(s,a,b)			FX(31,s,a,b,983)
+#  define STFS(s,a,d)			FDs(52,s,a,d)
+#  define STFSU(s,a,d)			FDs(53,s,a,d)
+#  define STFSUX(s,a,b)			FX(31,s,a,b,695)
+#  define STFSX(s,a,b)			FX(31,s,a,b,663)
+#  define movr_f(r0,r1)			movr_d(r0,r1)
+#  define movr_d(r0,r1)			_movr_d(_jit,r0,r1)
+static void _movr_d(jit_state_t*,int32_t,int32_t);
+#  define movi_f(r0,i0)			_movi_f(_jit,r0,i0)
+static void _movi_f(jit_state_t*,int32_t,jit_float32_t*);
+#  define movi_d(r0,i0)			_movi_d(_jit,r0,i0)
+static void _movi_d(jit_state_t*,int32_t,jit_float64_t*);
+#  define extr_f(r0,r1)			extr_d(r0,r1)
+#  define extr_d(r0,r1)			_extr_d(_jit,r0,r1)
+static void _extr_d(jit_state_t*,int32_t,int32_t);
+#  define truncr_f(r0,r1)		truncr_d(r0,r1)
+#  define truncr_f_i(r0,r1)		truncr_d_i(r0,r1)
+#  define truncr_d_i(r0,r1)		_truncr_d_i(_jit,r0,r1)
+static void _truncr_d_i(jit_state_t*,int32_t,int32_t);
+#  if __WORDSIZE == 32
+#    define truncr_d(r0,r1)		truncr_d_i(r0,r1)
+#  else
+#    define truncr_d(r0,r1)		truncr_d_l(r0,r1)
+#    define truncr_f_l(r0,r1)		truncr_d_l(r0,r1)
+#    define truncr_d_l(r0,r1)		_truncr_d_l(_jit,r0,r1)
+static void _truncr_d_l(jit_state_t*,int32_t,int32_t);
+#  endif
+#  define extr_d_f(r0,r1)		FRSP(r0,r1)
+#  define extr_f_d(r0,r1)		movr_d(r0,r1)
+#  define absr_f(r0,r1)			absr_d(r0,r1)
+#  define absr_d(r0,r1)			FABS(r0,r1)
+#  define negr_f(r0,r1)			negr_d(r0,r1)
+#  define negr_d(r0,r1)			FNEG(r0,r1)
+#  define sqrtr_f(r0,r1)		FSQRTS(r0,r1)
+#  define sqrtr_d(r0,r1)		FSQRT(r0,r1)
+#  define addr_f(r0,r1,r2)		FADDS(r0,r1,r2)
+#  define addr_d(r0,r1,r2)		FADD(r0,r1,r2)
+#  define addi_f(r0,r1,i0)		_addi_f(_jit,r0,r1,i0)
+static void _addi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define addi_d(r0,r1,i0)		_addi_d(_jit,r0,r1,i0)
+static void _addi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define subr_f(r0,r1,r2)		FSUBS(r0,r1,r2)
+#  define subi_f(r0,r1,i0)		_subi_f(_jit,r0,r1,i0)
+static void _subi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define subr_d(r0,r1,r2)		FSUB(r0,r1,r2)
+#  define subi_d(r0,r1,i0)		_subi_d(_jit,r0,r1,i0)
+static void _subi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define rsbr_f(r0,r1,r2)		subr_f(r0,r2,r1)
+#  define rsbi_f(r0,r1,i0)		_rsbi_f(_jit,r0,r1,i0)
+static void _rsbi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define rsbr_d(r0,r1,r2)		subr_d(r0,r2,r1)
+#  define rsbi_d(r0,r1,i0)		_rsbi_d(_jit,r0,r1,i0)
+static void _rsbi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define mulr_f(r0,r1,r2)		FMULS(r0,r1,r2)
+#  define muli_f(r0,r1,i0)		_muli_f(_jit,r0,r1,i0)
+static void _muli_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define mulr_d(r0,r1,r2)		FMUL(r0,r1,r2)
+#  define muli_d(r0,r1,i0)		_muli_d(_jit,r0,r1,i0)
+static void _muli_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define divr_f(r0,r1,r2)		FDIVS(r0,r1,r2)
+#  define divi_f(r0,r1,i0)		_divi_f(_jit,r0,r1,i0)
+static void _divi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define divr_d(r0,r1,r2)		FDIV(r0,r1,r2)
+#  define divi_d(r0,r1,i0)		_divi_d(_jit,r0,r1,i0)
+static void _divi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ltr_f(r0,r1,r2)		ltr_d(r0,r1,r2)
+#  define ltr_d(r0,r1,r2)		_ltr_d(_jit,r0,r1,r2)
+static void _ltr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lti_f(r0,r1,i0)		_lti_f(_jit,r0,r1,i0)
+static void _lti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define lti_d(r0,r1,i0)		_lti_d(_jit,r0,r1,i0)
+static void _lti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ler_f(r0,r1,r2)		ler_d(r0,r1,r2)
+#  define ler_d(r0,r1,r2)		_ler_d(_jit,r0,r1,r2)
+static void _ler_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define lei_f(r0,r1,i0)		_lei_f(_jit,r0,r1,i0)
+static void _lei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define lei_d(r0,r1,i0)		_lei_d(_jit,r0,r1,i0)
+static void _lei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define eqr_f(r0,r1,r2)		eqr_d(r0,r1,r2)
+#  define eqr_d(r0,r1,r2)		_eqr_d(_jit,r0,r1,r2)
+static void _eqr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define eqi_f(r0,r1,i0)		_eqi_f(_jit,r0,r1,i0)
+static void _eqi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define eqi_d(r0,r1,i0)		_eqi_d(_jit,r0,r1,i0)
+static void _eqi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ger_f(r0,r1,r2)		ger_d(r0,r1,r2)
+#  define ger_d(r0,r1,r2)		_ger_d(_jit,r0,r1,r2)
+static void _ger_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gei_f(r0,r1,i0)		_gei_f(_jit,r0,r1,i0)
+static void _gei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define gei_d(r0,r1,i0)		_gei_d(_jit,r0,r1,i0)
+static void _gei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define gtr_f(r0,r1,r2)		gtr_d(r0,r1,r2)
+#  define gtr_d(r0,r1,r2)		_gtr_d(_jit,r0,r1,r2)
+static void _gtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define gti_f(r0,r1,i0)		_gti_f(_jit,r0,r1,i0)
+static void _gti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define gti_d(r0,r1,i0)		_gti_d(_jit,r0,r1,i0)
+static void _gti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ner_f(r0,r1,r2)		ner_d(r0,r1,r2)
+#  define ner_d(r0,r1,r2)		_ner_d(_jit,r0,r1,r2)
+static void _ner_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define nei_f(r0,r1,i0)		_nei_f(_jit,r0,r1,i0)
+static void _nei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define nei_d(r0,r1,i0)		_nei_d(_jit,r0,r1,i0)
+static void _nei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unltr_f(r0,r1,r2)		unltr_d(r0,r1,r2)
+#  define unltr_d(r0,r1,r2)		_unltr_d(_jit,r0,r1,r2)
+static void _unltr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlti_f(r0,r1,i0)		_unlti_f(_jit,r0,r1,i0)
+static void _unlti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unlti_d(r0,r1,i0)		_unlti_d(_jit,r0,r1,i0)
+static void _unlti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unler_f(r0,r1,r2)		unler_d(r0,r1,r2)
+#  define unler_d(r0,r1,r2)		_unler_d(_jit,r0,r1,r2)
+static void _unler_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unlei_f(r0,r1,i0)		_unlei_f(_jit,r0,r1,i0)
+static void _unlei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unlei_d(r0,r1,i0)		_unlei_d(_jit,r0,r1,i0)
+static void _unlei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define uneqr_f(r0,r1,r2)		uneqr_d(r0,r1,r2)
+#  define uneqr_d(r0,r1,r2)		_uneqr_d(_jit,r0,r1,r2)
+static void _uneqr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define uneqi_f(r0,r1,i0)		_uneqi_f(_jit,r0,r1,i0)
+static void _uneqi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define uneqi_d(r0,r1,i0)		_uneqi_d(_jit,r0,r1,i0)
+static void _uneqi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unger_f(r0,r1,r2)		unger_d(r0,r1,r2)
+#  define unger_d(r0,r1,r2)		_unger_d(_jit,r0,r1,r2)
+static void _unger_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungei_f(r0,r1,i0)		_ungei_f(_jit,r0,r1,i0)
+static void _ungei_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ungei_d(r0,r1,i0)		_ungei_d(_jit,r0,r1,i0)
+static void _ungei_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ungtr_f(r0,r1,r2)		ungtr_d(r0,r1,r2)
+#  define ungtr_d(r0,r1,r2)		_ungtr_d(_jit,r0,r1,r2)
+static void _ungtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ungti_f(r0,r1,i0)		_ungti_f(_jit,r0,r1,i0)
+static void _ungti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ungti_d(r0,r1,i0)		_ungti_d(_jit,r0,r1,i0)
+static void _ungti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ltgtr_f(r0,r1,r2)		ltgtr_d(r0,r1,r2)
+#  define ltgtr_d(r0,r1,r2)		_ltgtr_d(_jit,r0,r1,r2)
+static void _ltgtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ltgti_f(r0,r1,i0)		_ltgti_f(_jit,r0,r1,i0)
+static void _ltgti_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ltgti_d(r0,r1,i0)		_ltgti_d(_jit,r0,r1,i0)
+static void _ltgti_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define ordr_f(r0,r1,r2)		ordr_d(r0,r1,r2)
+#  define ordr_d(r0,r1,r2)		_ordr_d(_jit,r0,r1,r2)
+static void _ordr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ordi_f(r0,r1,i0)		_ordi_f(_jit,r0,r1,i0)
+static void _ordi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define ordi_d(r0,r1,i0)		_ordi_d(_jit,r0,r1,i0)
+static void _ordi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define unordr_f(r0,r1,r2)		unordr_d(r0,r1,r2)
+#  define unordr_d(r0,r1,r2)		_unordr_d(_jit,r0,r1,r2)
+static void _unordr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define unordi_f(r0,r1,i0)		_unordi_f(_jit,r0,r1,i0)
+static void _unordi_f(jit_state_t*,int32_t,int32_t,jit_float32_t*);
+#  define unordi_d(r0,r1,i0)		_unordi_d(_jit,r0,r1,i0)
+static void _unordi_d(jit_state_t*,int32_t,int32_t,jit_float64_t*);
+#  define bltr_f(i0,r0,r1)		bltr_d(i0,r0,r1)
+#  define bltr_d(i0,r0,r1)		_bltr_d(_jit,i0,r0,r1)
+static jit_word_t _bltr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blti_f(i0,r0,i1)		_blti_f(_jit,i0,r0,i1)
+static jit_word_t _blti_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define blti_d(i0,r0,i1)		_blti_d(_jit,i0,r0,i1)
+static jit_word_t _blti_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bler_f(i0,r0,r1)		bler_d(i0,r0,r1)
+#  define bler_d(i0,r0,r1)		_bler_d(_jit,i0,r0,r1)
+static jit_word_t _bler_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define blei_f(i0,r0,i1)		_blei_f(_jit,i0,r0,i1)
+static jit_word_t _blei_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define blei_d(i0,r0,i1)		_blei_d(_jit,i0,r0,i1)
+static jit_word_t _blei_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define beqr_f(i0,r0,r1)		beqr_d(i0,r0,r1)
+#  define beqr_d(i0,r0,r1)		_beqr_d(_jit,i0,r0,r1)
+static jit_word_t _beqr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define beqi_f(i0,r0,i1)		_beqi_f(_jit,i0,r0,i1)
+static jit_word_t _beqi_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define beqi_d(i0,r0,i1)		_beqi_d(_jit,i0,r0,i1)
+static jit_word_t _beqi_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bger_f(i0,r0,r1)		bger_d(i0,r0,r1)
+#  define bger_d(i0,r0,r1)		_bger_d(_jit,i0,r0,r1)
+static jit_word_t _bger_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgei_f(i0,r0,i1)		_bgei_f(_jit,i0,r0,i1)
+static jit_word_t _bgei_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bgei_d(i0,r0,i1)		_bgei_d(_jit,i0,r0,i1)
+static jit_word_t _bgei_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bgtr_f(i0,r0,r1)		bgtr_d(i0,r0,r1)
+#  define bgtr_d(i0,r0,r1)		_bgtr_d(_jit,i0,r0,r1)
+static jit_word_t _bgtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bgti_f(i0,r0,i1)		_bgti_f(_jit,i0,r0,i1)
+static jit_word_t _bgti_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bgti_d(i0,r0,i1)		_bgti_d(_jit,i0,r0,i1)
+static jit_word_t _bgti_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bner_f(i0,r0,r1)		bner_d(i0,r0,r1)
+#  define bner_d(i0,r0,r1)		_bner_d(_jit,i0,r0,r1)
+static jit_word_t _bner_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bnei_f(i0,r0,i1)		_bnei_f(_jit,i0,r0,i1)
+static jit_word_t _bnei_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bnei_d(i0,r0,i1)		_bnei_d(_jit,i0,r0,i1)
+static jit_word_t _bnei_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bunltr_f(i0,r0,r1)		bunltr_d(i0,r0,r1)
+#  define bunltr_d(i0,r0,r1)		_bunltr_d(_jit,i0,r0,r1)
+static jit_word_t _bunltr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlti_f(i0,r0,i1)		_bunlti_f(_jit,i0,r0,i1)
+static jit_word_t _bunlti_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bunlti_d(i0,r0,i1)		_bunlti_d(_jit,i0,r0,i1)
+static jit_word_t _bunlti_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bunler_f(i0,r0,r1)		bunler_d(i0,r0,r1)
+#  define bunler_d(i0,r0,r1)		_bunler_d(_jit,i0,r0,r1)
+static jit_word_t _bunler_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunlei_f(i0,r0,i1)		_bunlei_f(_jit,i0,r0,i1)
+static jit_word_t _bunlei_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bunlei_d(i0,r0,i1)		_bunlei_d(_jit,i0,r0,i1)
+static jit_word_t _bunlei_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define buneqr_f(i0,r0,r1)		buneqr_d(i0,r0,r1)
+#  define buneqr_d(i0,r0,r1)		_buneqr_d(_jit,i0,r0,r1)
+static jit_word_t _buneqr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define buneqi_f(i0,r0,i1)		_buneqi_f(_jit,i0,r0,i1)
+static jit_word_t _buneqi_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define buneqi_d(i0,r0,i1)		_buneqi_d(_jit,i0,r0,i1)
+static jit_word_t _buneqi_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bunger_f(i0,r0,r1)		bunger_d(i0,r0,r1)
+#  define bunger_d(i0,r0,r1)		_bunger_d(_jit,i0,r0,r1)
+static jit_word_t _bunger_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungei_f(i0,r0,i1)		_bungei_f(_jit,i0,r0,i1)
+static jit_word_t _bungei_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bungei_d(i0,r0,i1)		_bungei_d(_jit,i0,r0,i1)
+static jit_word_t _bungei_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bungtr_f(i0,r0,r1)		bungtr_d(i0,r0,r1)
+#  define bungtr_d(i0,r0,r1)		_bungtr_d(_jit,i0,r0,r1)
+static jit_word_t _bungtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bungti_f(i0,r0,i1)		_bungti_f(_jit,i0,r0,i1)
+static jit_word_t _bungti_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bungti_d(i0,r0,i1)		_bungti_d(_jit,i0,r0,i1)
+static jit_word_t _bungti_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bltgtr_f(i0,r0,r1)		bltgtr_d(i0,r0,r1)
+#  define bltgtr_d(i0,r0,r1)		_bltgtr_d(_jit,i0,r0,r1)
+static jit_word_t _bltgtr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bltgti_f(i0,r0,i1)		_bltgti_f(_jit,i0,r0,i1)
+static jit_word_t _bltgti_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bltgti_d(i0,r0,i1)		_bltgti_d(_jit,i0,r0,i1)
+static jit_word_t _bltgti_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bordr_f(i0,r0,r1)		bordr_d(i0,r0,r1)
+#  define bordr_d(i0,r0,r1)		_bordr_d(_jit,i0,r0,r1)
+static jit_word_t _bordr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bordi_f(i0,r0,i1)		_bordi_f(_jit,i0,r0,i1)
+static jit_word_t _bordi_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bordi_d(i0,r0,i1)		_bordi_d(_jit,i0,r0,i1)
+static jit_word_t _bordi_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define bunordr_f(i0,r0,r1)		bunordr_d(i0,r0,r1)
+#  define bunordr_d(i0,r0,r1)		_bunordr_d(_jit,i0,r0,r1)
+static jit_word_t _bunordr_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define bunordi_f(i0,r0,i1)		_bunordi_f(_jit,i0,r0,i1)
+static jit_word_t _bunordi_f(jit_state_t*,jit_word_t,int32_t,jit_float32_t*);
+#  define bunordi_d(i0,r0,i1)		_bunordi_d(_jit,i0,r0,i1)
+static jit_word_t _bunordi_d(jit_state_t*,jit_word_t,int32_t,jit_float64_t*);
+#  define ldr_f(r0,r1)			LFSX(r0, _R0_REGNO, r1)
+#  define ldi_f(r0,i0)			_ldi_f(_jit,r0,i0)
+static void _ldi_f(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_f(r0,r1,r2)		_ldxr_f(_jit,r0,r1,r2)
+static void _ldxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_f(r0,r1,i0)		_ldxi_f(_jit,r0,r1,i0)
+static void _ldxi_f(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define str_f(r0,r1)			STFSX(r1, _R0_REGNO, r0)
+#  define sti_f(i0,r0)			_sti_f(_jit,i0,r0)
+static void _sti_f(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_f(r0,r1,r2)		_stxr_f(_jit,r0,r1,r2)
+static void _stxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_f(i0,r0,r1)		_stxi_f(_jit,i0,r0,r1)
+static void _stxi_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define ldr_d(r0,r1)			LFDX(r0, _R0_REGNO, r1)
+#  define ldi_d(r0,i0)			_ldi_d(_jit,r0,i0)
+static void _ldi_d(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_d(r0,r1,r2)		_ldxr_d(_jit,r0,r1,r2)
+static void _ldxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_d(r0,r1,i0)		_ldxi_d(_jit,r0,r1,i0)
+static void _ldxi_d(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define str_d(r0,r1)			STFDX(r1, _R0_REGNO, r0)
+#  define sti_d(i0,r0)			_sti_d(_jit,i0,r0)
+static void _sti_d(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_d(r0,r1,r2)		_stxr_d(_jit,r0,r1,r2)
+static void _stxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_d(i0,r0,r1)		_stxi_d(_jit,i0,r0,r1)
+static void _stxi_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define vaarg_d(r0, r1)		_vaarg_d(_jit, r0, r1)
+static void _vaarg_d(jit_state_t*, int32_t, int32_t);
+#endif
+
+#if CODE
+#  define _u16(v)			((v) & 0xffff)
+static void
+_FA(jit_state_t *_jit, int o, int d, int a, int b, int c, int x, int r)
+{
+    assert(!(o & ~((1 << 6) - 1)));
+    assert(!(d & ~((1 << 5) - 1)));
+    assert(!(a & ~((1 << 5) - 1)));
+    assert(!(b & ~((1 << 5) - 1)));
+    assert(!(c & ~((1 << 5) - 1)));
+    assert(!(x & ~((1 << 5) - 1)));
+    assert(!(r & ~((1 << 1) - 1)));
+    ii((o<<26)|(d<<21)|(a<<16)|(b<<11)|(c<<6)|(x<<1)|r);
+}
+
+static void
+_FXFL(jit_state_t *_jit, int o, int m, int b, int x, int r)
+{
+    assert(!(o & ~((1 <<  6) - 1)));
+    assert(!(m & ~((1 <<  8) - 1)));
+    assert(!(b & ~((1 <<  5) - 1)));
+    assert(!(x & ~((1 << 10) - 1)));
+    assert(!(r & ~((1 <<  1) - 1)));
+    ii((o<<26)|(m<<17)|(b<<11)|(x<<1)|r);
+}
+
+static void
+_movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	FMR(r0,r1);
+}
+
+static void
+_movi_f(jit_state_t *_jit, int32_t r0, jit_float32_t *i0)
+{
+    union {
+	int32_t	 i;
+	jit_float32_t	 f;
+    } data;
+    int32_t		 reg;
+
+    if (_jitc->no_data) {
+	data.f = *i0;
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), data.i & 0xffffffff);
+	stxi_i(alloca_offset - 4, _FP_REGNO, rn(reg));
+	jit_unget_reg(reg);
+	ldxi_f(r0, _FP_REGNO, alloca_offset - 4);
+    }
+    else
+	ldi_f(r0, (jit_word_t)i0);
+}
+
+static void
+_movi_d(jit_state_t *_jit, int32_t r0, jit_float64_t *i0)
+{
+    union {
+	int32_t	 i[2];
+	jit_word_t	 w;
+	jit_float64_t	 d;
+    } data;
+    int32_t		 reg;
+
+    if (_jitc->no_data) {
+	data.d = *i0;
+	reg = jit_get_reg(jit_class_gpr);
+#  if __WORDSIZE == 32
+	movi(rn(reg), data.i[0]);
+	stxi(alloca_offset - 8, _FP_REGNO, rn(reg));
+	movi(rn(reg), data.i[1]);
+	stxi(alloca_offset - 4, _FP_REGNO, rn(reg));
+#  else
+	movi(rn(reg), data.w);
+	stxi(alloca_offset - 8, _FP_REGNO, rn(reg));
+#  endif
+	jit_unget_reg(reg);
+	ldxi_d(r0, _FP_REGNO, alloca_offset - 8);
+    }
+    else
+	ldi_d(r0, (jit_word_t)i0);
+}
+
+/* should only work on newer ppc (fcfid is a ppc64 instruction) */
+static void
+_extr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+#  if __WORDSIZE == 32
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    rshi(rn(reg), r1, 31);
+    /* use reserved 8 bytes area */
+    stxi(alloca_offset - 4, _FP_REGNO, r1);
+    stxi(alloca_offset - 8, _FP_REGNO, rn(reg));
+    jit_unget_reg(reg);
+#  else
+    stxi(alloca_offset - 8, _FP_REGNO, r1);
+#  endif
+    ldxi_d(r0, _FP_REGNO, alloca_offset - 8);
+    FCFID(r0, r0);
+}
+
+static void
+_truncr_d_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr);
+    FCTIWZ(rn(reg), r1);
+    /* use reserved 8 bytes area */
+    stxi_d(alloca_offset - 8, _FP_REGNO, rn(reg));
+    ldxi_i(r0, _FP_REGNO, alloca_offset - 4);
+    jit_unget_reg(reg);
+}
+
+#  if __WORDSIZE == 64
+static void
+_truncr_d_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr);
+    FCTIDZ(rn(reg), r1);
+    /* use reserved 8 bytes area */
+    stxi_d(alloca_offset - 8, _FP_REGNO, rn(reg));
+    ldxi(r0, _FP_REGNO, alloca_offset - 8);
+    jit_unget_reg(reg);
+}
+#  endif
+
+#  define fpr_opi(name, type, size)					\
+static void								\
+_##name##i_##type(jit_state_t *_jit,					\
+		  int32_t r0, int32_t r1,			\
+		  jit_float##size##_t *i0)				\
+{									\
+    int32_t		reg = jit_get_reg(jit_class_fpr);		\
+    movi_##type(rn(reg), i0);						\
+    name##r_##type(r0, r1, rn(reg));					\
+    jit_unget_reg(reg);							\
+}
+#  define fpr_bopi(name, type, size)					\
+static jit_word_t							\
+_b##name##i_##type(jit_state_t *_jit,					\
+		  jit_word_t i0, int32_t r0,			\
+		  jit_float##size##_t *i1)				\
+{									\
+    jit_word_t		word;						\
+    int32_t		reg = jit_get_reg(jit_class_fpr|		\
+					  jit_class_nospill);		\
+    movi_##type(rn(reg), i1);						\
+    word = b##name##r_##type(i0, r0, rn(reg));				\
+    jit_unget_reg(reg);							\
+    return (word);							\
+}
+#  define fopi(name)			fpr_opi(name, f, 32)
+#  define fbopi(name)			fpr_bopi(name, f, 32)
+#  define dopi(name)			fpr_opi(name, d, 64)
+#  define dbopi(name)			fpr_bopi(name, d, 64)
+
+fopi(add)
+dopi(add)
+fopi(sub)
+dopi(sub)
+fopi(rsb)
+dopi(rsb)
+fopi(mul)
+dopi(mul)
+fopi(div)
+dopi(div)
+
+static void
+_ltr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+fopi(lt)
+dopi(lt)
+
+static void
+_ler_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    CREQV(CR_GT, CR_GT, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+fopi(le)
+dopi(le)
+
+static void
+_eqr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+fopi(eq)
+dopi(eq)
+
+static void
+_ger_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    CREQV(CR_LT, CR_LT, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+fopi(ge)
+dopi(ge)
+
+static void
+_gtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+fopi(gt)
+dopi(gt)
+
+static void
+_ner_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPO(CR_0, r1, r2);
+    CRNOT(CR_EQ, CR_EQ);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+fopi(ne)
+dopi(ne)
+
+static void
+_unltr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CROR(CR_LT, CR_LT, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+fopi(unlt)
+dopi(unlt)
+
+static void
+_unler_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CRNOT(CR_GT, CR_GT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+fopi(unle)
+dopi(unle)
+
+static void
+_uneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CROR(CR_EQ, CR_EQ, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_EQ);
+}
+fopi(uneq)
+dopi(uneq)
+
+static void
+_unger_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CRNOT(CR_LT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_LT);
+}
+fopi(unge)
+dopi(unge)
+
+static void
+_ungtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CROR(CR_GT, CR_GT, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+fopi(ungt)
+dopi(ungt)
+
+static void
+_ltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CROR(CR_GT, CR_GT, CR_LT);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_GT);
+}
+fopi(ltgt)
+dopi(ltgt)
+
+static void
+_ordr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    CRNOT(CR_UN, CR_UN);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_UN);
+}
+fopi(ord)
+dopi(ord)
+
+static void
+_unordr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    FCMPU(CR_0, r1, r2);
+    MFCR(r0);
+    EXTRWI(r0, r0, 1, CR_UN);
+}
+fopi(unord)
+dopi(unord)
+
+static jit_word_t
+_bltr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+fbopi(lt)
+dbopi(lt)
+
+static jit_word_t
+_bler_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    CREQV(CR_GT, CR_GT, CR_UN);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+fbopi(le)
+dbopi(le)
+
+static jit_word_t
+_beqr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+fbopi(eq)
+dbopi(eq)
+
+static jit_word_t
+_bger_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    CREQV(CR_LT, CR_LT, CR_UN);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+fbopi(ge)
+dbopi(ge)
+
+static jit_word_t
+_bgtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+fbopi(gt)
+dbopi(gt)
+
+static jit_word_t
+_bner_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPO(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNE(d);
+    return (w);
+}
+fbopi(ne)
+dbopi(ne)
+
+static jit_word_t
+_bunltr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    CROR(CR_LT, CR_LT, CR_UN);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLT(d);
+    return (w);
+}
+fbopi(unlt)
+dbopi(unlt)
+
+static jit_word_t
+_bunler_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BLE(d);
+    return (w);
+}
+fbopi(unle)
+dbopi(unle)
+
+static jit_word_t
+_buneqr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    CROR(CR_EQ, CR_EQ, CR_UN);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+fbopi(uneq)
+dbopi(uneq)
+
+static jit_word_t
+_bunger_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGE(d);
+    return (w);
+}
+fbopi(unge)
+dbopi(unge)
+
+static jit_word_t
+_bungtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    CROR(CR_GT, CR_GT, CR_UN);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BGT(d);
+    return (w);
+}
+fbopi(ungt)
+dbopi(ungt)
+
+static jit_word_t
+_bltgtr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    CROR(CR_EQ, CR_LT, CR_GT);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BEQ(d);
+    return (w);
+}
+fbopi(ltgt)
+dbopi(ltgt)
+
+static jit_word_t
+_bordr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BNU(d);
+    return (w);
+}
+fbopi(ord)
+dbopi(ord)
+
+static jit_word_t
+_bunordr_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    FCMPU(CR_0, r0, r1);
+    w = _jit->pc.w;
+    d = (i0 - w) & ~3;
+    BUN(d);
+    return (w);
+}
+fbopi(unord)
+dbopi(unord)
+
+static void
+_ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LFS(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LFS(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_f(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	LFD(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	LFD(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldr_d(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LFSX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LFSX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LFSX(r0, r1, r2);
+}
+
+static void
+_ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r1 == _R0_REGNO) {
+	if (r2 != _R0_REGNO)
+	    LFDX(r0, r2, r1);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LFDX(r0, rn(reg), r2);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	LFDX(r0, r1, r2);
+}
+
+static void
+_ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_f(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LFS(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LFS(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_f(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	ldr_d(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r1 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    LFD(r0, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    LFD(r0, r1, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	ldxr_d(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STFS(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STFS(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_f(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    jit_bool_t		inv;
+    int32_t		reg;
+    jit_word_t		lo, hi;
+    if (can_sign_extend_short_p(i0))
+	STFD(r0, _R0_REGNO, i0);
+    else if (can_sign_extend_int_p(i0)) {
+	hi = (int16_t)((i0 >> 16) + ((uint16_t)i0 >> 15));
+	lo = (int16_t)(i0 - (hi << 16));
+	reg = jit_get_reg(jit_class_gpr);
+	if ((inv = reg == _R0))		reg = jit_get_reg(jit_class_gpr);
+	LIS(rn(reg), hi);
+	STFD(r0, rn(reg), lo);
+	jit_unget_reg(reg);
+	if (inv)			jit_unget_reg(_R0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	str_d(rn(reg), r0);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STFSX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r1);
+	    STFSX(r2, rn(reg), r0);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STFSX(r2, r0, r1);
+}
+
+static void
+_stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == _R0_REGNO) {
+	if (r1 != _R0_REGNO)
+	    STFDX(r2, r1, r0);
+	else {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), r0);
+	    STFDX(r2, rn(reg), r1);
+	    jit_unget_reg(reg);
+	}
+    }
+    else
+	STFDX(r2, r0, r1);
+}
+
+static void
+_stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_f(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STFS(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STFS(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_f(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (i0 == 0)
+	str_d(r0, r1);
+    else if (can_sign_extend_short_p(i0)) {
+	if (r0 == _R0_REGNO) {
+	    reg = jit_get_reg(jit_class_gpr);
+	    movr(rn(reg), i0);
+	    STFD(r1, rn(reg), i0);
+	    jit_unget_reg(reg);
+	}
+	else
+	    STFD(r1, r0, i0);
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	stxr_d(rn(reg), r0, r1);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_vaarg_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    /* Load argument. */
+    ldr_d(r0, r1);
+
+    /* Update va_list. */
+    addi(r1, r1, sizeof(jit_float64_t));
+}
+#endif
diff --git a/libguile/lightening/lightening/ppc.c b/libguile/lightening/lightening/ppc.c
new file mode 100644
index 000000000..1819acdf6
--- /dev/null
+++ b/libguile/lightening/lightening/ppc.c
@@ -0,0 +1,1751 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+# define JIT_RA0                _R3
+# define JIT_FA0                _F1
+# define JIT_SP         _R1
+# define JIT_RET                _R3
+# define JIT_FRET               _F1
+
+#define jit_arg_reg_p(i)		((i) >= 0 && (i) < 8)
+#define jit_arg_f_reg_p(i)		((i) >= 0 && (i) < 13)
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+#  define C_DISP			0
+#  define S_DISP			0
+#  define I_DISP			0
+#  define F_DISP			0
+#else
+#  define C_DISP			(__WORDSIZE >> 3) - sizeof(int8_t)
+#  define S_DISP			(__WORDSIZE >> 3) - sizeof(int16_t)
+#  define I_DISP			(__WORDSIZE >> 3) - sizeof(int32_t)
+#  define F_DISP			(__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+
+/*
+ * Types
+ */
+typedef jit_pointer_t jit_va_list_t;
+
+/*
+ * Prototypes
+ */
+#define patch(instr, node)		_patch(_jit, instr, node)
+static void _patch(jit_state_t*,jit_word_t,jit_node_t*);
+
+/* libgcc */
+extern void __clear_cache(void *, void *);
+
+#define PROTO				1
+#  include "ppc-cpu.c"
+#  include "ppc-fpu.c"
+#undef PROTO
+
+/*
+ * Initialization
+ */
+static const jit_register_t _rvs[] = {
+    { rc(gpr) | 0,			"r0" },
+#if __ppc__
+    { rc(gpr) | 11,			"r11" },
+    { rc(gpr) | 12,			"r12" },
+    { rc(gpr) | 13,			"r13" },
+    { rc(gpr) | 2,			"r2" },
+#else
+    { rc(sav) | 11,			"r11" },	/* env */
+    { rc(sav) | 12,			"r12" },	/* exception */
+    { rc(sav) | 13,			"r13" },	/* thread */
+    { rc(sav) | 2,			"r2" },		/* toc */
+#endif
+    { rc(sav) | rc(gpr) | 14,		"r14" },
+    { rc(sav) | rc(gpr) | 15,		"r15" },
+    { rc(sav) | rc(gpr) | 16,		"r16" },
+    { rc(sav) | rc(gpr) | 17,		"r17" },
+    { rc(sav) | rc(gpr) | 18,		"r18" },
+    { rc(sav) | rc(gpr) | 19,		"r19" },
+    { rc(sav) | rc(gpr) | 20,		"r20" },
+    { rc(sav) | rc(gpr) | 21,		"r21" },
+    { rc(sav) | rc(gpr) | 22,		"r22" },
+    { rc(sav) | rc(gpr) | 23,		"r23" },
+    { rc(sav) | rc(gpr) | 24,		"r24" },
+    { rc(sav) | rc(gpr) | 25,		"r25" },
+    { rc(sav) | rc(gpr) | 26,		"r26" },
+    { rc(sav) | rc(gpr) | 27,		"r27" },
+    { rc(sav) | rc(gpr) | 28,		"r28" },
+    { rc(sav) | rc(gpr) | 29,		"r29" },
+    { rc(sav) | rc(gpr) | 30,		"r30" },
+    { rc(sav) | 1,			"r1" },
+    { rc(sav) | 31,			"r31" },
+    { rc(arg) | rc(gpr) | 10,		"r10" },
+    { rc(arg) | rc(gpr) | 9,		"r9" },
+    { rc(arg) | rc(gpr) | 8,		"r8" },
+    { rc(arg) | rc(gpr) | 7,		"r7" },
+    { rc(arg) | rc(gpr) | 6,		"r6" },
+    { rc(arg) | rc(gpr) | 5,		"r5" },
+    { rc(arg) | rc(gpr) | 4,		"r4" },
+    { rc(arg) | rc(gpr) | 3,		"r3" },
+    { rc(fpr) | 0,			"f0" },
+    { rc(sav) | rc(fpr) | 14,		"f14" },
+    { rc(sav) | rc(fpr) | 15,		"f15" },
+    { rc(sav) | rc(fpr) | 16,		"f16" },
+    { rc(sav) | rc(fpr) | 17,		"f17" },
+    { rc(sav) | rc(fpr) | 18,		"f18" },
+    { rc(sav) | rc(fpr) | 19,		"f19" },
+    { rc(sav) | rc(fpr) | 20,		"f20" },
+    { rc(sav) | rc(fpr) | 21,		"f21" },
+    { rc(sav) | rc(fpr) | 22,		"f22" },
+    { rc(sav) | rc(fpr) | 23,		"f23" },
+    { rc(sav) | rc(fpr) | 24,		"f24" },
+    { rc(sav) | rc(fpr) | 25,		"f25" },
+    { rc(sav) | rc(fpr) | 26,		"f26" },
+    { rc(sav) | rc(fpr) | 27,		"f27" },
+    { rc(sav) | rc(fpr) | 28,		"f28" },
+    { rc(sav) | rc(fpr) | 29,		"f29" },
+    { rc(sav) | rc(fpr) | 30,		"f30" },
+    { rc(sav) | rc(fpr) | 31,		"f31" },
+    { rc(arg) | rc(fpr) | 13,		"f13" },
+    { rc(arg) | rc(fpr) | 12,		"f12" },
+    { rc(arg) | rc(fpr) | 11,		"f11" },
+    { rc(arg) | rc(fpr) | 10,		"f10" },
+    { rc(arg) | rc(fpr) | 9,		"f9" },
+    { rc(arg) | rc(fpr) | 8,		"f8" },
+    { rc(arg) | rc(fpr) | 7,		"f7" },
+    { rc(arg) | rc(fpr) | 6,		"f6" },
+    { rc(arg) | rc(fpr) | 5,		"f5" },
+    { rc(arg) | rc(fpr) | 4,		"f4" },
+    { rc(arg) | rc(fpr) | 3,		"f3" },
+    { rc(arg) | rc(fpr) | 2,		"f2" },
+    { rc(arg) | rc(fpr) | 1,		"f1" },
+    { _NOREG,				"<none>" },
+};
+
+/*
+ * Implementation
+ */
+void
+jit_get_cpu(void)
+{
+}
+
+void
+_jit_init(jit_state_t *_jit)
+{
+    _jitc->reglen = jit_size(_rvs) - 1;
+}
+
+void
+_jit_prolog(jit_state_t *_jit)
+{
+    int32_t		 offset;
+
+    if (_jitc->function)
+	jit_epilog();
+    assert(jit_regset_cmp_ui(&_jitc->regarg, 0) == 0);
+    jit_regset_set_ui(&_jitc->regsav, 0);
+    offset = _jitc->functions.offset;
+    if (offset >= _jitc->functions.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->functions.ptr,
+		    _jitc->functions.length * sizeof(jit_function_t),
+		    (_jitc->functions.length + 16) * sizeof(jit_function_t));
+	_jitc->functions.length += 16;
+    }
+    _jitc->function = _jitc->functions.ptr + _jitc->functions.offset++;
+    _jitc->function->self.size = params_offset;
+    _jitc->function->self.argi = _jitc->function->self.argf =
+	_jitc->function->self.alen = 0;
+    /* float conversion */
+    _jitc->function->self.aoff = alloca_offset - 8;
+    _jitc->function->self.call = jit_call_default;
+    jit_alloc((jit_pointer_t *)&_jitc->function->regoff,
+	      _jitc->reglen * sizeof(int32_t));
+
+    /* _no_link here does not mean the jit_link() call can be removed
+     * by rewriting as:
+     * _jitc->function->prolog = jit_new_node(jit_code_prolog);
+     */
+    _jitc->function->prolog = jit_new_node_no_link(jit_code_prolog);
+    jit_link(_jitc->function->prolog);
+    _jitc->function->prolog->w.w = offset;
+    _jitc->function->epilog = jit_new_node_no_link(jit_code_epilog);
+    /*	u:	label value
+     *	v:	offset in blocks vector
+     *	w:	offset in functions vector
+     */
+    _jitc->function->epilog->w.w = offset;
+
+    jit_regset_new(&_jitc->function->regset);
+}
+
+int32_t
+_jit_allocai(jit_state_t *_jit, int32_t length)
+{
+    assert(_jitc->function);
+    switch (length) {
+	case 0:	case 1:						break;
+	case 2:		_jitc->function->self.aoff &= -2;	break;
+	case 3:	case 4:	_jitc->function->self.aoff &= -4;	break;
+	default:	_jitc->function->self.aoff &= -8;	break;
+    }
+    _jitc->function->self.aoff -= length;
+    if (!_jitc->realize) {
+	jit_inc_synth_ww(allocai, _jitc->function->self.aoff, length);
+	jit_dec_synth();
+    }
+    return (_jitc->function->self.aoff);
+}
+
+void
+_jit_allocar(jit_state_t *_jit, int32_t u, int32_t v)
+{
+    int32_t		 r0, r1;
+    assert(_jitc->function);
+    jit_inc_synth_ww(allocar, u, v);
+    if (!_jitc->function->allocar) {
+	_jitc->function->aoffoff = jit_allocai(sizeof(int32_t));
+	_jitc->function->allocar = 1;
+    }
+    r0 = jit_get_reg(jit_class_gpr);
+    r1 = jit_get_reg(jit_class_gpr);
+    jit_ldr(r0, JIT_SP);
+    jit_negr(r1, v);
+    jit_andi(r1, r1, -16);
+    jit_ldxi_i(u, JIT_FP, _jitc->function->aoffoff);
+    jit_addr(u, u, r1);
+    jit_addr(JIT_SP, JIT_SP, r1);
+    jit_stxi_i(_jitc->function->aoffoff, JIT_FP, u);
+    jit_str(JIT_SP, r0);
+    jit_unget_reg(r1);
+    jit_unget_reg(r0);
+    jit_dec_synth();
+}
+
+void
+_jit_ret(jit_state_t *_jit)
+{
+    jit_node_t		*instr;
+    assert(_jitc->function);
+    jit_inc_synth(ret);
+    /* jump to epilog */
+    instr = jit_jmpi();
+    jit_patch_at(instr, _jitc->function->epilog);
+    jit_dec_synth();
+}
+
+void
+_jit_retr(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr, u);
+    if (JIT_RET != u)
+	jit_movr(JIT_RET, u);
+    jit_live(JIT_RET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti(jit_state_t *_jit, jit_word_t u)
+{
+    jit_inc_synth_w(reti, u);
+    jit_movi(JIT_RET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_f(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_f, u);
+    if (JIT_RET != u)
+	jit_movr_f(JIT_FRET, u);
+    else
+	jit_live(JIT_FRET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_f(jit_state_t *_jit, jit_float32_t u)
+{
+    jit_inc_synth_f(reti_f, u);
+    jit_movi_f(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_d(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_d, u);
+    if (JIT_FRET != u)
+	jit_movr_d(JIT_FRET, u);
+    else
+	jit_live(JIT_FRET);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_d(jit_state_t *_jit, jit_float64_t u)
+{
+    jit_inc_synth_d(reti_d, u);
+    jit_movi_d(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_epilog(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    assert(_jitc->function->epilog->next == NULL);
+    jit_link(_jitc->function->epilog);
+    _jitc->function = NULL;
+}
+
+jit_bool_t
+_jit_arg_register_p(jit_state_t *_jit, jit_node_t *u)
+{
+    if (u->code == jit_code_arg)
+	return (jit_arg_reg_p(u->u.w));
+    assert(u->code == jit_code_arg_f || u->code == jit_code_arg_d);
+    return (jit_arg_f_reg_p(u->u.w));
+}
+
+void
+_jit_ellipsis(jit_state_t *_jit)
+{
+    jit_inc_synth(ellipsis);
+    if (_jitc->prepare) {
+	jit_link_prepare();
+	assert(!(_jitc->function->call.call & jit_call_varargs));
+	_jitc->function->call.call |= jit_call_varargs;
+    }
+    else {
+	jit_link_prolog();
+	assert(!(_jitc->function->self.call & jit_call_varargs));
+	_jitc->function->self.call |= jit_call_varargs;
+
+	_jitc->function->vagp = _jitc->function->self.argi;
+	_jitc->function->vafp = _jitc->function->self.argf;
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_va_push(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(va_push, u);
+    jit_pushargr(u);
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_arg(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_reg_p(_jitc->function->self.argi))
+	offset = _jitc->function->self.argi++;
+    else
+	offset = _jitc->function->self.size;
+    _jitc->function->self.size += sizeof(jit_word_t);
+    node = jit_new_node_ww(jit_code_arg, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+jit_node_t *
+_jit_arg_f(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_f_reg_p(_jitc->function->self.argf))
+	offset = _jitc->function->self.argf++;
+    else
+	offset = _jitc->function->self.size + F_DISP;
+    if (jit_arg_reg_p(_jitc->function->self.argi)) {
+#if __WORDSIZE == 32
+	_jitc->function->self.argi += 2;
+#else
+	_jitc->function->self.argi++;
+#endif
+    }
+    _jitc->function->self.size += sizeof(jit_word_t);
+    node = jit_new_node_ww(jit_code_arg_f, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+jit_node_t *
+_jit_arg_d(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_f_reg_p(_jitc->function->self.argf))
+	offset = _jitc->function->self.argf++;
+    else
+	offset = _jitc->function->self.size;
+    if (jit_arg_reg_p(_jitc->function->self.argi)) {
+#if __WORDSIZE == 32
+	_jitc->function->self.argi += 2;
+#else
+	_jitc->function->self.argi++;
+#endif
+    }
+    _jitc->function->self.size += sizeof(jit_float64_t);
+    node = jit_new_node_ww(jit_code_arg_d, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+void
+_jit_getarg_c(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_c, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_c(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_c(u, JIT_FP, v->u.w + C_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_uc(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_uc, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_uc(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_uc(u, JIT_FP, v->u.w + C_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_s(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_s, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_s(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_s(u, JIT_FP, v->u.w + S_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_us(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_us, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_us(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_us(u, JIT_FP, v->u.w + S_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_i(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_i, u, v);
+    if (jit_arg_reg_p(v->u.w)) {
+#if __WORDSIZE == 32
+	jit_movr(u, JIT_RA0 - v->u.w);
+#else
+	jit_extr_i(u, JIT_RA0 - v->u.w);
+#endif
+    }
+    else
+	jit_ldxi_i(u, JIT_FP, v->u.w + I_DISP);
+    jit_dec_synth();
+}
+
+#if __WORDSIZE == 64
+void
+_jit_getarg_ui(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_ui, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_ui(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_ui(u, JIT_FP, v->u.w + I_DISP);
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_l(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_l, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(u, JIT_RA0 - v->u.w);
+    else
+	jit_ldxi_l(u, JIT_FP, v->u.w);
+    jit_dec_synth();
+}
+#endif
+
+void
+_jit_putargr(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(putargr, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(JIT_RA0 - v->u.w, u);
+    else
+	jit_stxi(v->u.w, JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi(jit_state_t *_jit, jit_word_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    jit_inc_synth_wp(putargi, u, v);
+    assert(v->code == jit_code_arg);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movi(JIT_RA0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(v->u.w, JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(getarg_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(u, JIT_FA0 - v->u.w);
+    else
+	jit_ldxi_f(u, JIT_FP, v->u.w);
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(putargr_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(JIT_FA0 - v->u.w, u);
+    else
+	jit_stxi_f(v->u.w, JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_f(jit_state_t *_jit, jit_float32_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_fp(putargi_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movi_d(JIT_FA0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_f(v->u.w, JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(getarg_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(u, JIT_FA0 - v->u.w);
+    else
+	jit_ldxi_d(u, JIT_FP, v->u.w);
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(putargr_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(JIT_FA0 - v->u.w, u);
+    else
+	jit_stxi_d(v->u.w, JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_d(jit_state_t *_jit, jit_float64_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_dp(putargi_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movi_d(JIT_FA0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_d(v->u.w, JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr, u);
+    jit_link_prepare();
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movr(JIT_RA0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else
+	jit_stxi(_jitc->function->call.size + params_offset, JIT_SP, u);
+    _jitc->function->call.size += sizeof(jit_word_t);
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi(jit_state_t *_jit, jit_word_t u)
+{
+    int32_t		 regno;
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargi, u);
+    jit_link_prepare();
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movi(JIT_RA0 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(_jitc->function->call.size + params_offset, JIT_SP, regno);
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += sizeof(jit_word_t);
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_f(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_f, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf) &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	jit_movr_d(JIT_FA0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+	/* in case of excess arguments */
+	if (jit_arg_reg_p(_jitc->function->call.argi)) {
+#if __WORDSIZE == 32
+	    _jitc->function->call.argi += 2;
+	    if (!jit_arg_reg_p(_jitc->function->call.argi - 1))
+		--_jitc->function->call.argi;
+#else
+	    _jitc->function->call.argi++;
+#endif
+	}
+    }
+    else if (jit_arg_reg_p(_jitc->function->call.argi
+#if __WORDSIZE == 32
+			  + 1
+#endif
+			   )) {
+	/* use reserved 8 bytes area */
+	jit_stxi_d(alloca_offset - 8, JIT_FP, u);
+	jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		 alloca_offset - 8);
+	_jitc->function->call.argi++;
+#if __WORDSIZE == 32
+	jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		 alloca_offset - 4);
+	_jitc->function->call.argi++;
+#endif
+    }
+    else
+	jit_stxi_f(_jitc->function->call.size + params_offset + F_DISP,
+		   JIT_SP, u);
+    _jitc->function->call.size += sizeof(jit_word_t);
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_f(jit_state_t *_jit, jit_float32_t u)
+{
+    int32_t		 regno;
+    assert(_jitc->function);
+    jit_inc_synth_f(pushargi_f, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf) &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	jit_movi_d(JIT_FA0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+	    /* in case of excess arguments */
+#if __WORDSIZE == 32
+	_jitc->function->call.argi += 2;
+	if (!jit_arg_reg_p(_jitc->function->call.argi - 1))
+	    --_jitc->function->call.argi;
+#else
+	_jitc->function->call.argi++;
+#endif
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	if (jit_arg_reg_p(_jitc->function->call.argi
+#if __WORDSIZE == 32
+			  + 1
+#endif
+			  )) {
+	    /* use reserved 8 bytes area */
+	    jit_stxi_d(alloca_offset - 8, JIT_FP, regno);
+	    jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		     alloca_offset - 8);
+	    _jitc->function->call.argi++;
+#if __WORDSIZE == 32
+	    jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		     alloca_offset - 4);
+	    _jitc->function->call.argi++;
+#endif
+	}
+	else
+	    jit_stxi_f(_jitc->function->call.size + params_offset + F_DISP,
+		       JIT_SP, regno);
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += sizeof(jit_word_t);
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_d(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_d, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf) &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	jit_movr_d(JIT_FA0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+	    /* in case of excess arguments */
+#if __WORDSIZE == 32
+	_jitc->function->call.argi += 2;
+	if (!jit_arg_reg_p(_jitc->function->call.argi - 1))
+	    --_jitc->function->call.argi;
+#else
+	_jitc->function->call.argi++;
+#endif
+    }
+    else if (jit_arg_reg_p(_jitc->function->call.argi
+#if __WORDSIZE == 32
+			  + 1
+#endif
+			   )) {
+	/* use reserved 8 bytes area */
+	jit_stxi_d(alloca_offset - 8, JIT_FP, u);
+	jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		 alloca_offset - 8);
+	_jitc->function->call.argi++;
+#if __WORDSIZE == 32
+	jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		 alloca_offset - 4);
+	_jitc->function->call.argi++;
+#endif
+    }
+    else {
+	jit_stxi_d(_jitc->function->call.size + params_offset, JIT_SP, u);
+#if __WORDSIZE == 32
+	    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+		jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_SP,
+			 _jitc->function->call.size + params_offset);
+		_jitc->function->call.argi++;
+	    }
+#endif
+    }
+    _jitc->function->call.size += sizeof(jit_float64_t);
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_d(jit_state_t *_jit, jit_float64_t u)
+{
+    int32_t		 regno;
+    assert(_jitc->function);
+    jit_inc_synth_d(pushargi_d, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf) &&
+	!(_jitc->function->call.call & jit_call_varargs)) {
+	jit_movi_d(JIT_FA0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+	/* in case of excess arguments */
+	if (jit_arg_reg_p(_jitc->function->call.argi)) {
+#if __WORDSIZE == 32
+	    _jitc->function->call.argi += 2;
+	    if (!jit_arg_reg_p(_jitc->function->call.argi - 1))
+		--_jitc->function->call.argi;
+#else
+	    _jitc->function->call.argi++;
+#endif
+	}
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	if (jit_arg_reg_p(_jitc->function->call.argi
+#if __WORDSIZE == 32
+			  + 1
+#endif
+			  )) {
+	    /* use reserved 8 bytes area */
+	    jit_stxi_d(alloca_offset - 8, JIT_FP, regno);
+	    jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		     alloca_offset - 8);
+	    _jitc->function->call.argi++;
+#if __WORDSIZE == 32
+	    jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_FP,
+		     alloca_offset - 4);
+	    _jitc->function->call.argi++;
+#endif
+	}
+	else {
+	    jit_stxi_d(_jitc->function->call.size + params_offset,
+		       JIT_SP, regno);
+#if __WORDSIZE == 32
+	    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+		jit_ldxi(JIT_RA0 - _jitc->function->call.argi, JIT_SP,
+			 _jitc->function->call.size + params_offset);
+		_jitc->function->call.argi++;
+	    }
+#endif
+	}
+	jit_unget_reg(regno);
+    }
+    _jitc->function->call.size += sizeof(jit_float64_t);
+    jit_dec_synth();
+}
+
+jit_bool_t
+_jit_regarg_p(jit_state_t *_jit, jit_node_t *node, int32_t regno)
+{
+    int32_t		spec;
+    spec = jit_class(_rvs[regno].spec);
+    if (spec & jit_class_arg) {
+	if (spec & jit_class_gpr) {
+	    regno = JIT_RA0 - regno;
+	    if (regno >= 0 && regno < node->v.w)
+		return (1);
+	}
+	else if (spec & jit_class_fpr) {
+	    regno = JIT_FA0 - regno;
+	    if (regno >= 0 && regno < node->w.w)
+		return (1);
+	}
+    }
+    return (0);
+}
+
+void
+_jit_finishr(jit_state_t *_jit, int32_t r0)
+{
+    jit_node_t		*call;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishr, r0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    call = jit_callr(r0);
+    call->v.w = _jitc->function->call.argi;
+    call->w.w = _jitc->function->call.argf;
+    _jitc->function->call.argi = _jitc->function->call.argf = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_finishi(jit_state_t *_jit, jit_pointer_t i0)
+{
+    jit_node_t		*node;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishi, (jit_word_t)i0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    node = jit_calli(i0);
+    node->v.w = _jitc->function->call.argi;
+    node->w.w = _jitc->function->call.argf;
+    _jitc->function->call.argi = _jitc->function->call.argf = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+    return (node);
+}
+
+void
+_jit_retval_c(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_c);
+    jit_extr_c(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_uc(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_uc);
+    jit_extr_uc(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_s(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_s);
+    jit_extr_s(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_us(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_us);
+    jit_extr_us(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_i(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_i);
+#if __WORDSIZE == 32
+    if (r0 != JIT_RET)
+	jit_movr(r0, JIT_RET);
+#else
+    jit_extr_i(r0, JIT_RET);
+#endif
+    jit_dec_synth();
+}
+
+#if __WORDSIZE == 64
+void
+_jit_retval_ui(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_ui);
+    jit_extr_ui(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_l(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_l);
+    if (r0 != JIT_RET)
+	jit_movr(r0, JIT_RET);
+    jit_dec_synth();
+}
+#endif
+
+void
+_jit_retval_f(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_f);
+    jit_retval_d(r0);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_d(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth(retval_d);
+    if (r0 != JIT_FRET)
+	jit_movr_d(r0, JIT_FRET);
+    jit_dec_synth();
+}
+
+jit_pointer_t
+_emit_code(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    jit_node_t		*temp;
+    jit_word_t		 word;
+    int32_t		 value;
+    int32_t		 offset;
+    struct {
+	jit_node_t	*node;
+	jit_word_t	 word;
+#if DEVEL_DISASSEMBLER
+	jit_word_t	 prevw;
+#endif
+	jit_word_t	 patch_offset;
+#if __powerpc__
+	jit_word_t	 prolog_offset;
+#endif
+    } undo;
+#if DEVEL_DISASSEMBLER
+    jit_word_t		 prevw;
+#endif
+
+    _jitc->function = NULL;
+
+    jit_reglive_setup();
+
+    undo.word = 0;
+    undo.node = NULL;
+    undo.patch_offset = 0;
+
+#if DEVEL_DISASSEMBLER
+    prevw = _jit->pc.w;
+#endif
+#if __powerpc__ && !ABI_ELFv2
+    undo.prolog_offset = 0;
+    for (node = _jitc->head; node; node = node->next)
+	if (node->code != jit_code_label &&
+	    node->code != jit_code_note &&
+	    node->code != jit_code_name)
+	    break;
+    if (node && (node->code != jit_code_prolog ||
+		 !(_jitc->functions.ptr + node->w.w)->assume_frame)) {
+	/* code may start with a jump so add an initial function descriptor */
+	word = _jit->pc.w + sizeof(void*) * 3;
+	iw(word);			/* addr */
+	iw(0);				/* toc */
+	iw(0);				/* env */
+    }
+#endif
+
+#define case_rr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w), rn(node->v.w));		\
+		break
+#define case_rw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), node->v.w);		\
+		break
+#define case_wr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w));		\
+		break
+#define case_rrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w),				\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), rn(node->v.w), node->w.w);	\
+		break
+#define case_rrrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), node->w.w);		\
+		break
+#define case_rrf(name, type, size)					\
+	    case jit_code_##name##i##type:				\
+		assert(node->flag & jit_flag_data);			\
+		name##i##type(rn(node->u.w), rn(node->v.w),		\
+			      (jit_float##size##_t *)node->w.n->u.w);	\
+		break
+#define case_wrr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w), rn(node->w.w));	\
+		break
+#define case_brr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##r##type(temp->u.w, rn(node->v.w),		\
+				  rn(node->w.w));			\
+		else {							\
+		    word = name##r##type(_jit->pc.w,			\
+					 rn(node->v.w), rn(node->w.w));	\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i##type(temp->u.w,				\
+				  rn(node->v.w), node->w.w);		\
+		else {							\
+		    word = name##i##type(_jit->pc.w,			\
+					 rn(node->v.w), node->w.w);	\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brf(name, type, size)					\
+	    case jit_code_##name##i##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i##type(temp->u.w, rn(node->v.w),		\
+				(jit_float##size##_t *)node->w.n->u.w);	\
+		else {							\
+		    word = name##i##type(_jit->pc.w, rn(node->v.w),	\
+				(jit_float##size##_t *)node->w.n->u.w);	\
+		    patch(word, node);					\
+		}							\
+		break
+    for (node = _jitc->head; node; node = node->next) {
+	if (_jit->pc.uc >= _jitc->code.end)
+	    return (NULL);
+
+#if DEVEL_DISASSEMBLER
+	node->offset = (jit_uword_t)_jit->pc.w - (jit_uword_t)prevw;
+	prevw = _jit->pc.w;
+#endif
+	value = jit_classify(node->code);
+	jit_regarg_set(node, value);
+	switch (node->code) {
+	    case jit_code_align:
+		assert(!(node->u.w & (node->u.w - 1)) &&
+		       node->u.w <= sizeof(jit_word_t));
+		if (node->u.w == sizeof(jit_word_t) &&
+		    (word = _jit->pc.w & (sizeof(jit_word_t) - 1)))
+		    nop(sizeof(jit_word_t) - word);
+		break;
+	    case jit_code_note:		case jit_code_name:
+		node->u.w = _jit->pc.w;
+		break;
+	    case jit_code_label:
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		break;
+		case_rrr(add,);
+		case_rrw(add,);
+		case_rrr(addc,);
+		case_rrw(addc,);
+		case_rrr(addx,);
+		case_rrw(addx,);
+		case_rrr(sub,);
+		case_rrw(sub,);
+		case_rrr(subc,);
+		case_rrw(subc,);
+		case_rrr(subx,);
+		case_rrw(subx,);
+		case_rrw(rsb,);
+		case_rrr(mul,);
+		case_rrw(mul,);
+		case_rrrr(qmul,);
+		case_rrrw(qmul,);
+		case_rrrr(qmul, _u);
+		case_rrrw(qmul, _u);
+		case_rrr(div,);
+		case_rrw(div,);
+		case_rrr(div, _u);
+		case_rrw(div, _u);
+		case_rrrr(qdiv,);
+		case_rrrw(qdiv,);
+		case_rrrr(qdiv, _u);
+		case_rrrw(qdiv, _u);
+		case_rrr(rem,);
+		case_rrw(rem,);
+		case_rrr(rem, _u);
+		case_rrw(rem, _u);
+		case_rrr(and,);
+		case_rrw(and,);
+		case_rrr(or,);
+		case_rrw(or,);
+		case_rrr(xor,);
+		case_rrw(xor,);
+		case_rrr(lsh,);
+		case_rrw(lsh,);
+		case_rrr(rsh,);
+		case_rrw(rsh,);
+		case_rrr(rsh, _u);
+		case_rrw(rsh, _u);
+		case_rr(ext, _c);
+		case_rr(ext, _uc);
+		case_rr(ext, _s);
+		case_rr(ext, _us);
+#  if __WORDSIZE == 64
+		case_rr(ext, _i);
+		case_rr(ext, _ui);
+#  endif
+		case_rr(hton, _us);
+		case_rr(hton, _ui);
+#  if __WORDSIZE == 64
+		case_rr(hton, _ul);
+#  endif
+		case_rr(neg,);
+		case_rr(com,);
+		case_rr(mov,);
+	    case jit_code_movi:
+		if (node->flag & jit_flag_node) {
+		    temp = node->v.n;
+		    if (temp->code == jit_code_data ||
+			(temp->code == jit_code_label &&
+			 (temp->flag & jit_flag_patch)))
+			movi(rn(node->u.w), temp->u.w);
+		    else {
+			assert(temp->code == jit_code_label ||
+			       temp->code == jit_code_epilog);
+			word = movi_p(rn(node->u.w), node->v.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    movi(rn(node->u.w), node->v.w);
+		break;
+		case_rr(trunc, _f_i);
+		case_rr(trunc, _d_i);
+#  if __WORDSIZE == 64
+		case_rr(trunc, _f_l);
+		case_rr(trunc, _d_l);
+#  endif
+		case_rrr(lt,);
+		case_rrw(lt,);
+		case_rrr(lt, _u);
+		case_rrw(lt, _u);
+		case_rrr(le,);
+		case_rrw(le,);
+		case_rrr(le, _u);
+		case_rrw(le, _u);
+		case_rrr(eq,);
+		case_rrw(eq,);
+		case_rrr(ge,);
+		case_rrw(ge,);
+		case_rrr(ge, _u);
+		case_rrw(ge, _u);
+		case_rrr(gt,);
+		case_rrw(gt,);
+		case_rrr(gt, _u);
+		case_rrw(gt, _u);
+		case_rrr(ne,);
+		case_rrw(ne,);
+		case_rr(ld, _c);
+		case_rw(ld, _c);
+		case_brr(blt,);
+		case_brw(blt,);
+		case_brr(blt, _u);
+		case_brw(blt, _u);
+		case_brr(ble,);
+		case_brw(ble,);
+		case_brr(ble, _u);
+		case_brw(ble, _u);
+		case_brr(beq,);
+		case_brw(beq,);
+		case_brr(bge,);
+		case_brw(bge,);
+		case_brr(bge, _u);
+		case_brw(bge, _u);
+		case_brr(bgt,);
+		case_brw(bgt,);
+		case_brr(bgt, _u);
+		case_brw(bgt, _u);
+		case_brr(bne,);
+		case_brw(bne,);
+		case_brr(bms,);
+		case_brw(bms,);
+		case_brr(bmc,);
+		case_brw(bmc,);
+		case_brr(boadd,);
+		case_brw(boadd,);
+		case_brr(boadd, _u);
+		case_brw(boadd, _u);
+		case_brr(bxadd,);
+		case_brw(bxadd,);
+		case_brr(bxadd, _u);
+		case_brw(bxadd, _u);
+		case_brr(bosub,);
+		case_brw(bosub,);
+		case_brr(bosub, _u);
+		case_brw(bosub, _u);
+		case_brr(bxsub,);
+		case_brw(bxsub,);
+		case_brr(bxsub, _u);
+		case_brw(bxsub, _u);
+		case_rrr(ldx, _c);
+		case_rrw(ldx, _c);
+		case_rr(ld, _uc);
+		case_rw(ld, _uc);
+		case_rrr(ldx, _uc);
+		case_rrw(ldx, _uc);
+		case_rr(ld, _s);
+		case_rw(ld, _s);
+		case_rrr(ldx, _s);
+		case_rrw(ldx, _s);
+		case_rr(ld, _us);
+		case_rw(ld, _us);
+		case_rrr(ldx, _us);
+		case_rrw(ldx, _us);
+		case_rr(ld, _i);
+		case_rw(ld, _i);
+		case_rrr(ldx, _i);
+		case_rrw(ldx, _i);
+#if __WORDSIZE == 64
+		case_rr(ld, _ui);
+		case_rw(ld, _ui);
+		case_rrr(ldx, _ui);
+		case_rrw(ldx, _ui);
+		case_rr(ld, _l);
+		case_rw(ld, _l);
+		case_rrr(ldx, _l);
+		case_rrw(ldx, _l);
+#endif
+		case_rr(st, _c);
+		case_wr(st, _c);
+		case_rrr(stx, _c);
+		case_wrr(stx, _c);
+		case_rr(st, _s);
+		case_wr(st, _s);
+		case_rrr(stx, _s);
+		case_wrr(stx, _s);
+		case_rr(st, _i);
+		case_wr(st, _i);
+		case_rrr(stx, _i);
+		case_wrr(stx, _i);
+#if __WORDSIZE == 64
+		case_rr(st, _l);
+		case_wr(st, _l);
+		case_rrr(stx, _l);
+		case_wrr(stx, _l);
+#endif
+		case_rr(mov, _f);
+	    case jit_code_movi_f:
+		assert(node->flag & jit_flag_data);
+		movi_f(rn(node->u.w), (jit_float32_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _f);
+		case_rr(ext, _d_f);
+		case_rr(abs, _f);
+		case_rr(neg, _f);
+		case_rr(sqrt, _f);
+		case_rrr(add, _f);
+		case_rrf(add, _f, 32);
+		case_rrr(sub, _f);
+		case_rrf(sub, _f, 32);
+		case_rrf(rsb, _f, 32);
+		case_rrr(mul, _f);
+		case_rrf(mul, _f, 32);
+		case_rrr(div, _f);
+		case_rrf(div, _f, 32);
+		case_rrr(lt, _f);
+		case_rrf(lt, _f, 32);
+		case_rrr(le, _f);
+		case_rrf(le, _f, 32);
+		case_rrr(eq, _f);
+		case_rrf(eq, _f, 32);
+		case_rrr(ge, _f);
+		case_rrf(ge, _f, 32);
+		case_rrr(gt, _f);
+		case_rrf(gt, _f, 32);
+		case_rrr(ne, _f);
+		case_rrf(ne, _f, 32);
+		case_rrr(unlt, _f);
+		case_rrf(unlt, _f, 32);
+		case_rrr(unle, _f);
+		case_rrf(unle, _f, 32);
+		case_rrr(uneq, _f);
+		case_rrf(uneq, _f, 32);
+		case_rrr(unge, _f);
+		case_rrf(unge, _f, 32);
+		case_rrr(ungt, _f);
+		case_rrf(ungt, _f, 32);
+		case_rrr(ltgt, _f);
+		case_rrf(ltgt, _f, 32);
+		case_rrr(ord, _f);
+		case_rrf(ord, _f, 32);
+		case_rrr(unord, _f);
+		case_rrf(unord, _f, 32);
+		case_brr(blt, _f);
+		case_brf(blt, _f, 32);
+		case_brr(ble, _f);
+		case_brf(ble, _f, 32);
+		case_brr(beq, _f);
+		case_brf(beq, _f, 32);
+		case_brr(bge, _f);
+		case_brf(bge, _f, 32);
+		case_brr(bgt, _f);
+		case_brf(bgt, _f, 32);
+		case_brr(bne, _f);
+		case_brf(bne, _f, 32);
+		case_brr(bunlt, _f);
+		case_brf(bunlt, _f, 32);
+		case_brr(bunle, _f);
+		case_brf(bunle, _f, 32);
+		case_brr(buneq, _f);
+		case_brf(buneq, _f, 32);
+		case_brr(bunge, _f);
+		case_brf(bunge, _f, 32);
+		case_brr(bungt, _f);
+		case_brf(bungt, _f, 32);
+		case_brr(bltgt, _f);
+		case_brf(bltgt, _f, 32);
+		case_brr(bord, _f);
+		case_brf(bord, _f, 32);
+		case_brr(bunord, _f);
+		case_brf(bunord, _f, 32);
+		case_rr(ld, _f);
+		case_rw(ld, _f);
+		case_rrr(ldx, _f);
+		case_rrw(ldx, _f);
+		case_rr(st, _f);
+		case_wr(st, _f);
+		case_rrr(stx, _f);
+		case_wrr(stx, _f);
+		case_rr(mov, _d);
+	    case jit_code_movi_d:
+		assert(node->flag & jit_flag_data);
+		movi_d(rn(node->u.w), (jit_float64_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _d);
+		case_rr(ext, _f_d);
+		case_rr(abs, _d);
+		case_rr(neg, _d);
+		case_rr(sqrt, _d);
+		case_rrr(add, _d);
+		case_rrf(add, _d, 64);
+		case_rrr(sub, _d);
+		case_rrf(sub, _d, 64);
+		case_rrf(rsb, _d, 64);
+		case_rrr(mul, _d);
+		case_rrf(mul, _d, 64);
+		case_rrr(div, _d);
+		case_rrf(div, _d, 64);
+		case_rrr(lt, _d);
+		case_rrf(lt, _d, 64);
+		case_rrr(le, _d);
+		case_rrf(le, _d, 64);
+		case_rrr(eq, _d);
+		case_rrf(eq, _d, 64);
+		case_rrr(ge, _d);
+		case_rrf(ge, _d, 64);
+		case_rrr(gt, _d);
+		case_rrf(gt, _d, 64);
+		case_rrr(ne, _d);
+		case_rrf(ne, _d, 64);
+		case_rrr(unlt, _d);
+		case_rrf(unlt, _d, 64);
+		case_rrr(unle, _d);
+		case_rrf(unle, _d, 64);
+		case_rrr(uneq, _d);
+		case_rrf(uneq, _d, 64);
+		case_rrr(unge, _d);
+		case_rrf(unge, _d, 64);
+		case_rrr(ungt, _d);
+		case_rrf(ungt, _d, 64);
+		case_rrr(ltgt, _d);
+		case_rrf(ltgt, _d, 64);
+		case_rrr(ord, _d);
+		case_rrf(ord, _d, 64);
+		case_rrr(unord, _d);
+		case_rrf(unord, _d, 64);
+		case_brr(blt, _d);
+		case_brf(blt, _d, 64);
+		case_brr(ble, _d);
+		case_brf(ble, _d, 64);
+		case_brr(beq, _d);
+		case_brf(beq, _d, 64);
+		case_brr(bge, _d);
+		case_brf(bge, _d, 64);
+		case_brr(bgt, _d);
+		case_brf(bgt, _d, 64);
+		case_brr(bne, _d);
+		case_brf(bne, _d, 64);
+		case_brr(bunlt, _d);
+		case_brf(bunlt, _d, 64);
+		case_brr(bunle, _d);
+		case_brf(bunle, _d, 64);
+		case_brr(buneq, _d);
+		case_brf(buneq, _d, 64);
+		case_brr(bunge, _d);
+		case_brf(bunge, _d, 64);
+		case_brr(bungt, _d);
+		case_brf(bungt, _d, 64);
+		case_brr(bltgt, _d);
+		case_brf(bltgt, _d, 64);
+		case_brr(bord, _d);
+		case_brf(bord, _d, 64);
+		case_brr(bunord, _d);
+		case_brf(bunord, _d, 64);
+		case_rr(ld, _d);
+		case_rw(ld, _d);
+		case_rrr(ldx, _d);
+		case_rrw(ldx, _d);
+		case_rr(st, _d);
+		case_wr(st, _d);
+		case_rrr(stx, _d);
+		case_wrr(stx, _d);
+	    case jit_code_jmpr:
+		jmpr(rn(node->u.w));
+		break;
+	    case jit_code_jmpi:
+		if (node->flag & jit_flag_node) {
+#if __powerpc__ && !ABI_ELFv2
+		    if (_jit->pc.uc == _jit->code.ptr + sizeof(void*) * 3)
+			_jitc->jump = 1;
+#endif
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    if (temp->flag & jit_flag_patch)
+			jmpi(temp->u.w);
+		    else {
+			word = jmpi(_jit->pc.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    (void)jmpi_p(node->u.w);
+		break;
+	    case jit_code_callr:
+		callr(rn(node->u.w));
+		break;
+	    case jit_code_calli:
+		if (node->flag & jit_flag_node) {
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    word = calli_p(temp->u.w);
+		    if (!(temp->flag & jit_flag_patch))
+			patch(word, node);
+		}
+		else
+		    calli(node->u.w);
+		break;
+	    case jit_code_prolog:
+		_jitc->function = _jitc->functions.ptr + node->w.w;
+		undo.node = node;
+		undo.word = _jit->pc.w;
+#if DEVEL_DISASSEMBLER
+		undo.prevw = prevw;
+#endif
+		undo.patch_offset = _jitc->patches.offset;
+#if __powerpc__ && !ABI_ELFv2
+		undo.prolog_offset = _jitc->prolog.offset;
+#endif
+	    restart_function:
+		_jitc->again = 0;
+#if __powerpc__ && !ABI_ELFv2
+		if (_jitc->jump && !_jitc->function->assume_frame) {
+		    /* remember prolog to hide offset adjustment for a jump
+		     * to the start of a function, what is expected to be
+		     * a common practice as first jit instruction */
+		    if (_jitc->prolog.offset >= _jitc->prolog.length) {
+			_jitc->prolog.length += 16;
+			jit_realloc((jit_pointer_t *)&_jitc->prolog.ptr,
+				    (_jitc->prolog.length - 16) *
+				    sizeof(jit_word_t),
+				    _jitc->prolog.length * sizeof(jit_word_t));
+		    }
+		    _jitc->prolog.ptr[_jitc->prolog.offset++] = _jit->pc.w;
+		    /* function descriptor */
+		    word = _jit->pc.w + sizeof(void*) * 3;
+		    iw(word);				/* addr */
+		    iw(0);				/* toc */
+		    iw(0);				/* env */
+		}
+#endif
+		prolog(node);
+		break;
+	    case jit_code_epilog:
+		assert(_jitc->function == _jitc->functions.ptr + node->w.w);
+		if (_jitc->again) {
+		    for (temp = undo.node->next;
+			 temp != node; temp = temp->next) {
+			if (temp->code == jit_code_label ||
+			    temp->code == jit_code_epilog)
+			    temp->flag &= ~jit_flag_patch;
+		    }
+		    temp->flag &= ~jit_flag_patch;
+		    node = undo.node;
+		    _jit->pc.w = undo.word;
+#if DEVEL_DISASSEMBLER
+		    prevw = undo.prevw;
+#endif
+		    _jitc->patches.offset = undo.patch_offset;
+#if __powerpc__ && !ABI_ELFv2
+		    _jitc->prolog.offset = undo.prolog_offset;
+#endif
+		    goto restart_function;
+		}
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		epilog(node);
+		_jitc->function = NULL;
+		break;
+	    case jit_code_va_start:
+		vastart(rn(node->u.w));
+		break;
+	    case jit_code_va_arg:
+		vaarg(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_va_arg_d:
+		vaarg_d(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_live:
+	    case jit_code_arg:			case jit_code_ellipsis:
+	    case jit_code_va_push:
+	    case jit_code_allocai:		case jit_code_allocar:
+	    case jit_code_arg_f:		case jit_code_arg_d:
+	    case jit_code_va_end:
+	    case jit_code_ret:
+	    case jit_code_retr:			case jit_code_reti:
+	    case jit_code_retr_f:		case jit_code_reti_f:
+	    case jit_code_retr_d:		case jit_code_reti_d:
+	    case jit_code_getarg_c:		case jit_code_getarg_uc:
+	    case jit_code_getarg_s:		case jit_code_getarg_us:
+	    case jit_code_getarg_i:
+#if __WORDSIZE == 64
+	    case jit_code_getarg_ui:		case jit_code_getarg_l:
+#endif
+	    case jit_code_getarg_f:		case jit_code_getarg_d:
+	    case jit_code_putargr:		case jit_code_putargi:
+	    case jit_code_putargr_f:		case jit_code_putargi_f:
+	    case jit_code_putargr_d:		case jit_code_putargi_d:
+	    case jit_code_pushargr:		case jit_code_pushargi:
+	    case jit_code_pushargr_f:		case jit_code_pushargi_f:
+	    case jit_code_pushargr_d:		case jit_code_pushargi_d:
+	    case jit_code_retval_c:		case jit_code_retval_uc:
+	    case jit_code_retval_s:		case jit_code_retval_us:
+	    case jit_code_retval_i:
+#if __WORDSIZE == 64
+	    case jit_code_retval_ui:		case jit_code_retval_l:
+#endif
+	    case jit_code_retval_f:		case jit_code_retval_d:
+	    case jit_code_prepare:
+	    case jit_code_finishr:		case jit_code_finishi:
+		break;
+	    default:
+		abort();
+	}
+	jit_regarg_clr(node, value);
+	assert(_jitc->regarg == 0 && _jitc->synth == 0);
+	/* update register live state */
+	jit_reglive(node);
+    }
+#undef case_brf
+#undef case_brw
+#undef case_brr
+#undef case_wrr
+#undef case_rrf
+#undef case_rrw
+#undef case_rrr
+#undef case_wr
+#undef case_rw
+#undef case_rr
+
+    for (offset = 0; offset < _jitc->patches.offset; offset++) {
+	node = _jitc->patches.ptr[offset].node;
+	word = node->code == jit_code_movi ? node->v.n->u.w : node->u.n->u.w;
+	patch_at(_jitc->patches.ptr[offset].inst, word);
+    }
+
+    jit_flush(_jit->code.ptr, _jit->pc.uc);
+
+    return (_jit->code.ptr);
+}
+
+#define CODE				1
+#  include "ppc-cpu.c"
+#  include ", 2018ppc-fpu.c"
+#undef CODE
+
+void
+jit_flush(void *fptr, void *tptr)
+{
+#if defined(__GNUC__)
+    jit_word_t		f, t, s;
+
+    s = sysconf(_SC_PAGE_SIZE);
+    f = (jit_word_t)fptr & -s;
+    t = (((jit_word_t)tptr) + s - 1) & -s;
+    __clear_cache((void *)f, (void *)t);
+#endif
+}
+
+void
+_emit_ldxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+#if __WORDSIZE == 32
+    ldxi_i(rn(r0), rn(r1), i0);
+#else
+    ldxi_l(rn(r0), rn(r1), i0);
+#endif
+}
+
+void
+_emit_stxi(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+#if __WORDSIZE == 32
+    stxi_i(i0, rn(r0), rn(r1));
+#else
+    stxi_l(i0, rn(r0), rn(r1));
+#endif
+}
+
+void
+_emit_ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    ldxi_d(rn(r0), rn(r1), i0);
+}
+
+void
+_emit_stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    stxi_d(i0, rn(r0), rn(r1));
+}
+
+static void
+_patch(jit_state_t *_jit, jit_word_t instr, jit_node_t *node)
+{
+    int32_t		 flag;
+
+    assert(node->flag & jit_flag_node);
+    if (node->code == jit_code_movi)
+	flag = node->v.n->flag;
+    else
+	flag = node->u.n->flag;
+    assert(!(flag & jit_flag_patch));
+    if (_jitc->patches.offset >= _jitc->patches.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->patches.ptr,
+		    _jitc->patches.length * sizeof(jit_patch_t),
+		    (_jitc->patches.length + 1024) * sizeof(jit_patch_t));
+	_jitc->patches.length += 1024;
+    }
+    _jitc->patches.ptr[_jitc->patches.offset].inst = instr;
+    _jitc->patches.ptr[_jitc->patches.offset].node = node;
+    ++_jitc->patches.offset;
+}
diff --git a/libguile/lightening/lightening/ppc.h b/libguile/lightening/lightening/ppc.h
new file mode 100644
index 000000000..72b33bdd8
--- /dev/null
+++ b/libguile/lightening/lightening/ppc.h
@@ -0,0 +1,109 @@
+/*
+ * Copyright (C) 2012-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_ppc_h
+#define _jit_ppc_h
+
+#define JIT_HASH_CONSTS		1
+#define JIT_NUM_OPERANDS	3
+
+#if __powerpc__
+#  if _CALL_ELF == 2
+/* __BYTE_ORDER == __LITTLE_ENDIAN */
+#    define ABI_ELFv2		1
+#  endif
+#endif
+
+/*
+ * Types
+ */
+typedef enum {
+#if __ppc__
+#  define jit_r(i)		(_R11 + (i))
+#else
+#  define jit_r(i)		(_R28 + (i))
+#endif
+#define jit_r_num()		3
+#if __ppc__
+#  define jit_v(i)		(_R30 - (i))
+#  define jit_v_num()		17
+#else
+#  define jit_v(i)		(_R27 - (i))
+#  define jit_v_num()		14
+#endif
+#define jit_f(i)		(_F14 + (i))
+#define jit_f_num()		8
+    _R0,
+#if __ppc__
+#  define JIT_R0		_R11
+#  define JIT_R1		_R12
+#  define JIT_R2		_R13
+#else
+#  define JIT_R0		_R28
+#  define JIT_R1		_R29
+#  define JIT_R2		_R30
+#endif
+    _R11,	_R12,	_R13,	_R2,
+#define JIT_V0			jit_v(0)
+#define JIT_V1			jit_v(1)
+#define JIT_V2			jit_v(2)
+#define JIT_V3			jit_v(3)
+#define JIT_V4			jit_v(4)
+#define JIT_V5			jit_v(5)
+#define JIT_V6			jit_v(6)
+#define JIT_V7			jit_v(7)
+#define JIT_V8			jit_v(8)
+#define JIT_V9			jit_v(9)
+#define JIT_V10			jit_v(10)
+#define JIT_V11			jit_v(11)
+#define JIT_V12			jit_v(12)
+#define JIT_V13			jit_v(13)
+#if __ppc__
+#  define JIT_V14		jit_v(14)
+#  define JIT_V15		jit_v(15)
+#  define JIT_V16		jit_v(16)
+#endif
+    _R14,	_R15,	_R16,	_R17,	_R18,	_R19,	_R20,	_R21,
+    _R22,	_R23,	_R24,	_R25,	_R26,	_R27,	_R28,	_R29,
+    _R30,
+    _R1,
+#define JIT_FP			_R31
+    _R31,
+    _R10,	_R9,	_R8,	_R7,	_R6,	_R5,	_R4,	_R3,
+    _F0,
+    _F14,	_F15,	_F16,	_F17,	_F18,	_F19,	_F20,	_F21,
+#define JIT_F0			_F14
+#define JIT_F1			_F15
+#define JIT_F2			_F16
+#define JIT_F3			_F17
+#define JIT_F4			_F18
+#define JIT_F5			_F19
+#define JIT_F6			_F20
+#define JIT_F7			_F21
+    /* FIXME _F20-_F31 not (easily) accessible and only _F14-_F21
+     * saved/restored (if used) */
+    _F22,	_F23,	_F24,	_F25,	_F26,	_F27,	_F28,	_F29,
+    _F30,	_F31,
+    _F13,	_F12,	_F11,	_F10,	_F9,	_F8,	_F7,	_F6,
+    _F5,	_F4,	_F3,	_F2,	_F1,
+    _NOREG,
+#define JIT_NOREG		_NOREG
+} jit_reg_t;
+
+#endif /* _jit_ppc_h */
diff --git a/libguile/lightening/lightening/s390-cpu.c b/libguile/lightening/lightening/s390-cpu.c
new file mode 100644
index 000000000..02f2675ec
--- /dev/null
+++ b/libguile/lightening/lightening/s390-cpu.c
@@ -0,0 +1,3848 @@
+/*
+ * Copyright (C) 2013-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+#  if __WORDSIZE == 32
+#    define ldr(r0,r1)			ldr_i(r0,r1)
+#    define ldxr(r0,r1,r2)		ldxr_i(r0,r1,r2)
+#    define ldxi(r0,r1,i0)		ldxi_i(r0,r1,i0)
+#    define stxi(i0,r0,r1)		stxi_i(i0,r0,r1)
+#  else
+#    define ldr(r0,r1)			ldr_l(r0,r1)
+#    define ldxr(r0,r1,r2)		ldxr_l(r0,r1,r2)
+#    define ldxi(r0,r1,i0)		ldxi_l(r0,r1,i0)
+#    define stxi(i0,r0,r1)		stxi_l(i0,r0,r1)
+#  endif
+#  define is(i)				*_jit->pc.us++ = i
+#  if __WORDSIZE == 32
+#    define stack_framesize		96
+#  else
+#    define stack_framesize		160
+#  endif
+#  define _R0_REGNO			0
+#  define _R1_REGNO			1
+#  define _R7_REGNO			7
+#  define _R13_REGNO			13
+#  define _FP_REGNO			_R13_REGNO
+#  define _R14_REGNO			14
+#  define _R15_REGNO			15
+#  define u12_p(i0)			((i0) >= 0 && (i0) <= 4095)
+#  define s16_p(i0)			((i0) >= -32768 && (i0) <= 32767)
+#  define x16(i0)			((i0) & 0xffff)
+#  define s20_p(i0)			((i0) >= -524288 && (i0) <= 524287)
+#  define x20(i0)			((i0) & 0xfffff)
+#  if __WORDSIZE == 32
+#    define s32_p(i0)			1
+#  else
+#    define s32_p(i0)							\
+    ((i0) >= -2147483648L && (i0) < 2147483647L)
+#  endif
+
+/*
+	Condition Code		Instruction	(Mask) Bit Mask Value
+	0			8		8
+	1			9		4
+	2			10		2
+	3			11		1
+
+AGR:
+	0	Zero
+	1	< zero
+	2	> zero
+	3	Overflow
+--
+1	->	overflow		CC_O
+14	->	no overflow		CC_NO
+
+ALGR:
+ 	0	Zero, no carry
+ 	1	Not zero, no carry
+ 	2	Zero, carry
+ 	3	Not zero, carry
+--
+2|1	->	carry			CC_NLE
+8|4	->	no carry		CC_LE
+
+SGR:
+	0	Zero
+	1	< zero
+	2	> zero
+	3	Overflow
+--
+1	->	overflow		CC_O
+14	->	no overflow		CC_NO
+
+SLGR:
+	0	--
+	1	Not zero, borrow
+	2	Zero, no borrow
+	3	Not zero, no borrow
+--
+4	->	borrow			CC_L
+11	->	no borrow		CC_NL
+  */
+
+#  define CC_NV				0x0
+#  define CC_O				0x1
+#  define CC_H				0x2
+#  define CC_NLE			0x3
+#  define CC_L				0x4
+#  define CC_NHE			0x5
+#  define CC_LH				0x6
+#  define CC_NE				0x7
+#  define CC_E				0x8
+#  define CC_NLH			0x9
+#  define CC_HE				0xA
+#  define CC_NL				0xB
+#  define CC_LE				0xC
+#  define CC_NH				0xD
+#  define CC_NO				0xE
+#  define CC_AL				0xF
+#  define _us				uint16_t
+#  define _ui				uint32_t
+#  define E_(Op)			_E(_jit,Op)
+static void _E(jit_state_t*,_ui);
+#  define I_(Op,I)			_I(_jit,Op,I)
+static void _I(jit_state_t*,_ui,_ui);
+#  define RR_(Op,R1,R2)			_RR(_jit,Op,R1,R2)
+static void _RR(jit_state_t*,_ui,_ui,_ui);
+#  define RRE_(Op,R1,R2)		_RRE(_jit,Op,R1,R2)
+static void _RRE(jit_state_t*,_ui,_ui,_ui);
+#  define RRF_(Op,R3,M4,R1,R2)		_RRF(_jit,Op,R3,M4,R1,R2)
+static void _RRF(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define RX_(Op,R1,X2,B2,D2)		_RX(_jit,Op,R1,X2,B2,D2)
+static void _RX(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define RXE_(Op,R1,X2,B2,D2,Op2)	_RXE(_jit,Op,R1,X2,B2,D2,Op2)
+static void _RXE(jit_state_t*,_ui,_ui,_ui,_ui,_ui,_ui);
+#  define RXF_(Op,R3,X2,B2,D2,R1,Op2)	_RXF(_jit,Op,R3,X2,B2,D2,R1,Op2)
+static void _RXF(jit_state_t*,_ui,_ui,_ui,_ui,_ui,_ui,_ui);
+#  define RXY_(Op,R1,X2,B2,D2,Op2)	_RXY(_jit,Op,R1,X2,B2,D2,Op2)
+static void _RXY(jit_state_t*,_ui,_ui,_ui,_ui,_ui,_ui);
+#  define RS_(Op,R1,R3,B2,D2)		_RS(_jit,Op,R1,R3,B2,D2)
+static void _RS(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define RSY_(Op,R1,R3,B2,D2,Op2)	RXY_(Op,R1,R3,B2,D2,Op2)
+#  define RSL_(Op,L1,B1,D1,Op2)		_RSL(_jit,Op,L1,B1,D1,Op2)
+static void _RSL(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define RSI_(Op,R1,R3,I2)		_RSI(_jit,Op,R1,R3,I2)
+static void _RSI(jit_state_t*,_ui,_ui,_ui,_ui);
+#  define RI_(Op,R1,Op2,I2)		RSI_(Op,R1,Op2,I2)
+#  define RIE_(Op,R1,R3,I2,Op2)		_RIE(_jit,Op,R1,R3,I2,Op2)
+static void _RIE(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define RIL_(Op,R1,Op2,I2)		_RIL(_jit,Op,R1,Op2,I2)
+static void _RIL(jit_state_t*,_ui,_ui,_ui,_ui);
+#  define SI_(Op,I2,B1,D1)		_SI(_jit,Op,I2,B1,D1)
+static void _SI(jit_state_t*,_ui,_ui,_ui,_ui);
+#  define SIY_(Op,I2,B1,D1,Op2)		_SIY(_jit,Op,I2,B1,D1,Op2)
+static void _SIY(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  define S_(Op,B2,D2)			_S(_jit,Op,B2,D2)
+static void _S(jit_state_t*,_ui,_ui,_ui);
+#  define SSL_(Op,L,B1,D1,B2,D2)	SS_(Op,(L)>>4,(L)&0xF,B1,D1,B2,D2)
+#  define SS_(Op,LL,LH,B1,D1,B2,D2)	_SS(_jit,Op,LL,LH,B1,D1,B2,D2)
+static void _SS(jit_state_t*,_ui,_ui,_ui,_ui,_ui,_ui,_ui);
+#  define SSE_(Op,B1,D1,B2,D2)		_SSE(_jit,Op,B1,D1,B2,D2)
+static void _SSE(jit_state_t*,_ui,_ui,_ui,_ui,_ui);
+#  undef _us
+#  undef _ui
+#  define nop(c)			_nop(_jit,c)
+static void _nop(jit_state_t*,int32_t);
+#  if __WORDSIZE == 32
+#    define ADD_(r0,r1)			AR(r0,r1)
+#    define ADDI_(r0,i0)		AHI(r0,i0)
+#    define ADDC_(r0,r1)		ALR(r0,r1)
+#    define ADDX_(r0,r1)		ALCR(r0,r1)
+#    define AND_(r0,r1)			NR(r0,r1)
+#    define CMP_(r0,r1)			CR(r0,r1)
+#    define CMPU_(r0,r1)		CLR(r0,r1)
+#    define DIVREM_(r0,r1)		DR(r0,r1)
+#    define DIVREMU_(r0,r1)		DLR(r0,r1)
+#    define OR_(r0,r1)			OR(r0,r1)
+#    define MUL_(r0,r1)			MSR(r0,r1)
+#    define MULI_(r0,i0)		MHI(r0,i0)
+#    define MULU_(r0,r1)		MLR(r0,r1)
+#    define SUB_(r0,r1)			SR(r0,r1)
+#    define SUBC_(r0,r1)		SLR(r0,r1)
+#    define SUBX_(r0,r1)		SLBR(r0,r1)
+#    define TEST_(r0,r1)		LTR(r0,r1)
+#    define XOR_(r0,r1)			XR(r0,r1)
+#  else
+#    define ADD_(r0,r1)			AGR(r0,r1)
+#    define ADDI_(r0,i0)		AGHI(r0,i0)
+#    define ADDC_(r0,r1)		ALGR(r0,r1)
+#    define ADDX_(r0,r1)		ALCGR(r0,r1)
+#    define AND_(r0,r1)			NGR(r0,r1)
+#    define CMP_(r0,r1)			CGR(r0,r1)
+#    define CMPU_(r0,r1)		CLGR(r0,r1)
+#    define DIVREM_(r0,r1)		DSGR(r0,r1)
+#    define DIVREMU_(r0,r1)		DLGR(r0,r1)
+#    define MUL_(r0,r1)			MSGR(r0,r1)
+#    define MULI_(r0,i0)		MGHI(r0,i0)
+#    define MULU_(r0,r1)		MLGR(r0,r1)
+#    define OR_(r0,r1)			OGR(r0,r1)
+#    define SUB_(r0,r1)			SGR(r0,r1)
+#    define SUBC_(r0,r1)		SLGR(r0,r1)
+#    define SUBX_(r0,r1)		SLBGR(r0,r1)
+#    define TEST_(r0,r1)		LTGR(r0,r1)
+#    define XOR_(r0,r1)			XGR(r0,r1)
+#  endif
+/****************************************************************
+ * General Instructions						*
+ ****************************************************************/
+/* ADD */
+#  define AR(R1,R2)			RR_(0x1A,R1,R2)
+#  define AGR(R1,R2)			RRE_(0xB908,R1,R2)
+#  define AGFR(R1,R2)			RRE_(0xB918,R1,R2)
+#  define A(R1,D2,X2,B2)		RX_(0x5A,R1,X2,B2,D2)
+#  define AY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x5A)
+#  define AG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x08)
+#  define AGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x18)
+/* ADD HALFWORD */
+#  define AH(R1,D2,X2,B2)		RX_(0x4A,R1,X2,B2,D2)
+#  define AHY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x7A)
+/* ADD HALFWORD IMMEDIATE */
+#  define AHI(R1,I2)			RI_(0xA7,R1,0xA,I2)
+#  define AGHI(R1,I2)			RI_(0xA7,R1,0xB,I2)
+/* ADD LOGICAL */
+#  define ALR(R1,R2)			RR_(0x1E,R1,R2)
+#  define ALGR(R1,R2)			RRE_(0xB90A,R1,R2)
+#  define ALGFR(R1,R2)			RRE_(0xB91A,R1,R2)
+#  define AL(R1,D2,X2,B2)		RX_(0x5E,R1,X2,B2,D2)
+#  define ALY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x5E)
+#  define ALG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0A)
+#  define ALGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1A)
+/* ADD LOGICAL WITH CARRY */
+#  define ALCR(R1,R2)			RRE_(0xB998,R1,R2)
+#  define ALCGR(R1,R2)			RRE_(0xB988,R1,R2)
+#  define ALC(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x98)
+#  define ALCG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x88)
+/* AND */
+#  define NR(R1,R2)			RR_(0x14,R1,R2)
+#  define NGR(R1,R2)			RRE_(0xB980,R1,R2)
+#  define N(R1,D2,X2,B2)		RX_(0x54,R1,X2,B2,D2)
+#  define NY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x54)
+#  define NG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x80)
+#  define NI(D1,B1,I2)			SI_(0x94,I2,B1,D1)
+#  define NIY(D1,B1,I2)			SIY_(0xEB,I2,B1,D1,0x54)
+#  define NC(D1,L,B1,D2,B2)		SSL_(0xD4,L,B1,D1,B2,D2)
+/* AND IMMEDIATE */
+#  define NIHH(R1,I2)			RI_(0xA5,R1,0x4,I2)
+#  define NIHL(R1,I2)			RI_(0xA5,R1,0x5,I2)
+#  define NILH(R1,I2)			RI_(0xA5,R1,0x6,I2)
+#  define NILL(R1,I2)			RI_(0xA5,R1,0x7,I2)
+/* BRANCH AND LINK */
+#  define BALR(R1,R2)			RR_(0x05,R1,R2)
+#  define BAL(R1,D2,X2,B2)		RX_(0x45,R1,X2,B2,D2)
+/* BRANCH AND SAVE */
+#  define BASR(R1,R2)			RR_(0x0D,R1,R2)
+#  define BAS(R1,D2,X2,B2)		RX_(0x4D,R1,X2,B2,D2)
+/* BRANCH AND SAVE AND SET MODE */
+#  define BASSM(R1,R2)			RR_(0x0C,R1,R2)
+/* BRANCH AND SET MODE */
+#  define BSM(R1,R2)			RR_(0x0B,R1,R2)
+/* BRANCH ON CONDITION */
+#  define BCR(M1,R2)			RR_(0x07,M1,R2)
+#  define BR(R2)			BCR(CC_AL,R2)
+#  define NOPR(R2)			BCR(CC_NV,R2)
+#  define BC(M1,D2,X2,B2)		RX_(0x47,M1,X2,B2,D2)
+/* BRANCH ON COUNT */
+#  define BCTR(R1,R2)			RR_(0x06,R1,R2)
+#  define BCTGR(R1,R2)			RRE_(0xB946,R1,R2)
+#  define BCT(R1,D2,X2,B2)		RX_(0x46,R1,X2,B2,D2)
+#  define BCTG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x46)
+/* BRANCH ON INDEX HIGH */
+#  define BXH(R1,R3,D2,B2)		RS_(0x86,R1,R3,B2,D2)
+#  define BXHG(R1,R3,B2,D2)		RSY_(0xEB,R1,R3,B2,D2,0x44)
+/* BRANCH ON INDEX LOW OR EQUAL */
+#  define BXLE(R1,R3,D2,B2)		RS_(0x87,R1,R3,B2,D2)
+#  define BXLEG(R1,R3,B2,D2)		RSY_(0xEB,R1,R3,B2,D2,0x45)
+/* BRANCH RELATIVE AND SAVE */
+#  define BRAS(R1,I2)			RI_(0xA7,R1,0x5,I2)
+/* BRANCH RELATIVE AND SAVE LONG */
+#  define BRASL(R1,I2)			RIL_(0xC0,R1,0x5,I2)
+/* BRANCH RELATIVE ON CONDITION */
+#  define BRC(M1,I2)			RI_(0xA7,M1,0x4,I2)
+#  define J(I2)				BRC(CC_AL,I2)
+/* BRANCH RELATIVE ON CONDITION LONG */
+#  define BRCL(M1,I2)			RIL_(0xC0,M1,0x4,I2)
+#  define BRL(I2)			BRCL(CC_AL,I2)
+/* BRANCH RELATIVE ON COUNT */
+#  define BRCT(M1,I2)			RI_(0xA7,M1,0x6,I2)
+#  define BRCTG(M1,I2)			RI_(0xA7,M1,0x7,I2)
+/* BRANCH RELATIVE ON INDEX HIGH */
+#  define BRXH(R1,R3,I2)		RSI_(0x84,R1,R3,I2)
+#  define BRXHG(R1,R3,I2)		RIE_(0xEC,R1,R3,I2,0x44)
+/* BRANCH RELATIVE ON INDEX LOW OR EQUAL */
+#  define BRXLE(R1,R3,I2)		RSI_(0x85,R1,R3,I2)
+#  define BRXLEG(R1,R3,I2)		RIE_(0xEC,R1,R3,I2,0x45)
+/* CHECKSUM */
+#  define CKSUM(R1,R2)			RRE_(0xB241,R1,R2)
+/* CIPHER MESAGE (KM) */
+#  define KM(R1,R2)			RRE_(0xB92E,R1,R2)
+/* CIPHER MESAGE WITH CHAINING (KMC) */
+#  define KMC(R1,R2)			RRE_(0xB92F,R1,R2)
+/* COMPARE */
+#  define CR(R1,R2)			RR_(0x19,R1,R2)
+#  define CGR(R1,R2)			RRE_(0xB920,R1,R2)
+#  define CGFR(R1,R2)			RRE_(0xB930,R1,R2)
+#  define C(R1,D2,X2,B2)		RX_(0x59,R1,X2,B2,D2)
+#  define CY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x59)
+#  define CG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x20)
+#  define CGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x30)
+/* COMPARE AND FORM CODEWORD */
+#  define CFC(D2,B2)			S_(0xB21A,B2,D2)
+/* COMPARE AND SWAP */
+#  define CS(R1,R3,D2,B2)		RS_(0xBA,R1,R3,B2,D2)
+#  define CSY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x14)
+#  define CSG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x30)
+/* COMPARE DOUBLE AND SWAP */
+#  define CDS(R1,R3,D2,B2)		RS_(0xBB,R1,R3,B2,D2)
+#  define CSDY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x31)
+#  define CSDG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x3E)
+/* COMPARE HALFWORD */
+#  define CH(R1,D2,X2,B2)		RX_(0x49,R1,X2,B2,D2)
+#  define CHY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x79)
+/* COMPARE HALFWORD IMMEDIATE */
+#  define CHI(R1,I2)			RI_(0xA7,R1,0xE,I2)
+#  define CGHI(R1,I2)			RI_(0xA7,R1,0xF,I2)
+/* COMPARE LOGICAL */
+#  define CLR(R1,R2)			RR_(0x15,R1,R2)
+#  define CLGR(R1,R2)			RRE_(0xB921,R1,R2)
+#  define CLGFR(R1,R2)			RRE_(0xB931,R1,R2)
+#  define CL(R1,D2,X2,B2)		RX_(0x55,R1,X2,B2,D2)
+#  define CLY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x55)
+#  define CLG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x21)
+#  define CLGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x31)
+#  define CLI(D1,B1,I2)			SI_(0x95,I2,B1,D1)
+#  define CLIY(D1,B1,I2)		SIY_(0xEB,I2,B1,D1,0x55)
+#  define CLC(D1,L,B1,D2,B2)		SSL_(0xD5,L,B1,D1,B2,D2)
+/* COMPARE LOGICAL CHARACTERS UNDER MASK */
+#  define CLM(R1,M3,D2,B2)		RS_(0xBD,R1,M3,B2,D2)
+#  define CLMY(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x21)
+#  define CLMH(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x20)
+/* COMPARE LOGICAL LONG */
+#  define CLCL(R1,R2)			RR_(0x0F,R1,R2)
+/* COMPARE LOGICAL LONG EXTENDED */
+#  define CLCLE(R1,R3,D2,B2)		RS_(0xA9,R1,R3,B2,D2)
+/* COMPARE LOGICAL LONG UNICODE */
+#  define CLCLU(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x8F)
+/* COMPARE LOGICAL STRING */
+#  define CLST(R1,R2)			RRE_(0xB25D,R1,R2)
+/* COMPARE UNTIL SUBSTRING EQUAL */
+#  define CUSE(R1,R2)			RRE_(0xB257,R1,R2)
+/* COMPRESSION CALL */
+#  define CMPSC(R1,R2)			RRE_(0xB263,R1,R2)
+/* COMPUTE INTERMEDIATE MESSAGE DIGEST (KIMD) */
+#  define KIMD(R1,R2)			RRE_(0xB93E,R1,R2)
+/* COMPUTE LAST MESSAGE DIGEST (KIMD) */
+#  define KLMD(R1,R2)			RRE_(0xB93F,R1,R2)
+/* COMPUTE MESSAGE AUTHENTICATION CODE (KMAC) */
+#  define KMAC(R1,R2)			RRE_(0xB91E,R1,R2)
+/* CONVERT TO BINARY */
+#  define CVB(R1,D2,X2,B2)		RX_(0x4F,R1,X2,B2,D2)
+#  define CVBY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x06)
+#  define CVBG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0e)
+/* CONVERT TO DECIMAL */
+#  define CVD(R1,D2,X2,B2)		RX_(0x4E,R1,X2,B2,D2)
+#  define CVDY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x26)
+#  define CVDG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x2E)
+/* CONVERT UNICODE TO UTF-8 */
+#  define CUUTF(R1,R2)			RRE_(0xB2A6,R1,R2)
+/* CONVERT UTF-8 TO UNICODE */
+#  define CUTFU(R1,R2)			RRE_(0xB2A7,R1,R2)
+/* COPY ACCESS */
+#  define CPYA(R1,R2)			RRE_(0xB24D,R1,R2)
+/* DIVIDE */
+#  define DR(R1,R2)			RR_(0x1D,R1,R2)
+#  define D(R1,D2,X2,B2)		RX_(0x5D,R1,X2,B2,D2)
+/* DIVIDE LOGICAL */
+#  define DLR(R1,R2)			RRE_(0xB997,R1,R2)
+#  define DLGR(R1,R2)			RRE_(0xB987,R1,R2)
+#  define DL(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x97)
+#  define DLG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x87)
+/* DIVIDE SINGLE */
+#  define DSGR(R1,R2)			RRE_(0xB90D,R1,R2)
+#  define DSGFR(R1,R2)			RRE_(0xB91D,R1,R2)
+#  define DSG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0D)
+#  define DSGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1D)
+/* EXCLUSIVE OR */
+#  define XR(R1,R2)			RR_(0x17,R1,R2)
+#  define XGR(R1,R2)			RRE_(0xB982,R1,R2)
+#  define X(R1,D2,X2,B2)		RX_(0x57,R1,X2,B2,D2)
+#  define XY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x57)
+#  define XG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x82)
+#  define XI(D1,B1,I2)			SI_(0x97,I2,B1,D1)
+#  define XIY(D1,B1,I2)			SIY_(0xEB,I2,B1,D1,0x57)
+#  define XC(D1,L,B1,D2,B2)		SSL_(0xD7,L,B1,D1,B2,D2)
+/* EXECUTE */
+#  define EX(R1,D2,X2,B2)		RX_(0x44,R1,X2,B2,D2)
+/* EXTRACT ACCESS */
+#  define EAR(R1,R2)			RRE_(0xB24F,R1,R2)
+/* EXTRACT PSW */
+#  define EPSW(R1,R2)			RRE_(0xB98D,R1,R2)
+/* INSERT CHARACTER */
+#  define IC(R1,D2,X2,B2)		RX_(0x43,R1,X2,B2,D2)
+#  define ICY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x73)
+/* INSERT CHARACTERS UNDER MASK */
+#  define ICM(R1,M3,D2,B2)		RS_(0xBF,R1,M3,B2,D2)
+#  define ICMY(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x81)
+#  define ICMH(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x80)
+/* INSERT IMMEDIATE */
+#  define IIHH(R1,I2)			RI_(0xA5,R1,0x0,I2)
+#  define IIHL(R1,I2)			RI_(0xA5,R1,0x1,I2)
+#  define IILH(R1,I2)			RI_(0xA5,R1,0x2,I2)
+#  define IILL(R1,I2)			RI_(0xA5,R1,0x3,I2)
+/* INSERT PROGRAM MASK */
+#  define IPM(R1)			RRE_(0xB222,R1,0)
+/* LOAD */
+#  define LR(R1,R2)			RR_(0x18,R1,R2)
+#  define LGR(R1,R2)			RRE_(0xB904,R1,R2)
+#  define LGFR(R1,R2)			RRE_(0xB914,R1,R2)
+#  define L(R1,D2,X2,B2)		RX_(0x58,R1,X2,B2,D2)
+#  define LY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x58)
+#  define LG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x04)
+#  define LGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x14)
+/* LOAD ACCESS MULTIPLE */
+#  define LAM(R1,R3,D2,B2)		RS_(0x9A,R1,R3,B2,D2)
+#  define LAMY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x9A)
+/* LOAD ADDRESS */
+#  define LA(R1,D2,X2,B2)		RX_(0x41,R1,X2,B2,D2)
+#  define LAY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x71)
+/* LOAD ADDRESS EXTENDED */
+#  define LAE(R1,D2,X2,B2)		RX_(0x51,R1,X2,B2,D2)
+/* LOAD ADDRESS RELATIVE LONG */
+#  define LARL(R1,I2)			RIL_(0xC0,R1,0x0,I2)
+/* LOAD AND TEST */
+#  define LTR(R1,R2)			RR_(0x12,R1,R2)
+#  define LTGR(R1,R2)			RRE_(0xB902,R1,R2)
+#  define LTGFR(R1,R2)			RRE_(0xB912,R1,R2)
+/* LOAD BYTE */
+#  define LGBR(R1,R2)			RRE_(0xB906,R1,R2)	/* disasm */
+#  define LB(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x76)
+#  define LGB(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x77)
+/* LOAD COMPLEMENT */
+#  define LCR(R1,R2)			RR_(0x13,R1,R2)
+#  define LCGR(R1,R2)			RRE_(0xB903,R1,R2)
+#  define LCGFR(R1,R2)			RRE_(0xB913,R1,R2)
+/* LOAD HALFWORD */
+#  define LH(R1,D2,X2,B2)		RX_(0x48,R1,X2,B2,D2)
+#  define LHY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x78)
+#  define LGHR(R1,R2)			RRE_(0xB907,R1,R2)	/* disasm */
+#  define LGH(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x15)
+/* LOAD HALFWORD IMMEDIATE */
+#  define LHI(R1,I2)			RI_(0xA7,R1,0x8,I2)
+#  define LGHI(R1,I2)			RI_(0xA7,R1,0x9,I2)
+/* LOAD LOGICAL */
+#  define LLGFR(R1,R2)			RRE_(0xB916,R1,R2)
+#  define LLGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x16)
+/* LOAD LOGICAL CHARACTER */
+#  define LLGCR(R1,R2)			RRE_(0xB984,R1,R2)	/* disasm */
+#  define LLGC(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x90)
+/* LOAD LOGICAL HALFWORD */
+#  define LLGHR(R1,R2)			RRE_(0xB985,R1,R2)	/* disasm */
+#  define LLGH(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x91)
+/* LOAD LOGICAL IMMEDIATE */
+#  define LLIHH(R1,I2)			RI_(0xA5,R1,0xC,I2)
+#  define LLIHL(R1,I2)			RI_(0xA5,R1,0xD,I2)
+#  define LLILH(R1,I2)			RI_(0xA5,R1,0xE,I2)
+#  define LLILL(R1,I2)			RI_(0xA5,R1,0xF,I2)
+/* LOAD LOGICAL THIRTY ONE BITS */
+#  define LLGTR(R1,R2)			RRE_(0xB917,R1,R2)
+#  define LLGT(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x17)
+/* LOAD MULTIPLE */
+#  define LM(R1,R3,D2,B2)		RS_(0x98,R1,R3,B2,D2)
+#  define LMY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x98)
+#  define LMG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x04)
+/* LOAD MULTIPLE DISJOINT */
+#  define LMD(R1,R3,D2,B2,D4,B4)	SS_(0xEF,R1,R3,B2,D2,B4,D4)
+/* LOAD MULTIPLE HIGH */
+#  define LMH(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x96)
+/* LOAD NEGATIVE */
+#  define LNR(R1,R2)			RR_(0x11,R1,R2)
+#  define LNGR(R1,R2)			RRE_(0xB901,R1,R2)
+#  define LNGFR(R1,R2)			RRE_(0xB911,R1,R2)
+/* LOAD PAIR FROM QUADWORD */
+#  define LPQ(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x8F)
+/* LOAD POSITIVE */
+#  define LPR(R1,R2)			RR_(0x10,R1,R2)
+#  define LPGR(R1,R2)			RRE_(0xB900,R1,R2)
+#  define LPGFR(R1,R2)			RRE_(0xB910,R1,R2)
+/* LOAD REVERSED */
+#  define LRVR(R1,R2)			RRE_(0xB91F,R1,R2)
+#  define LRVGR(R1,R2)			RRE_(0xB90F,R1,R2)
+#  define LRVH(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1F)
+#  define LRV(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1E)
+#  define LRVG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0F)
+/* MONITOR CALL */
+#  define MC(D1,B1,I2)			SI_(0xAF,I2,B1,D1)
+/* MOVE */
+#  define MVI(D1,B1,I2)			SI_(0x92,I2,B1,D1)
+#  define MVIY(D1,B1,I2)		SIY_(0xEB,I2,B1,D1,0x52)
+#  define MVC(D1,L,B1,D2,B2)		SSL_(0xD2,L,B1,D1,B2,D2)
+/* MOVE INVERSE */
+#  define MVCIN(D1,L,B1,D2,B2)		SSL_(0xE8,L,B1,D1,B2,D2)
+/* MOVE LONG */
+#  define MVCL(R1,R2)			RR_(0x0E,R1,R2)
+/* MOVE LONG EXTENDED */
+#  define MVCLE(R1,R3,D2,B2)		RS_(0xA8,R1,R3,B2,D2)
+/* MOVE LONG UNICODE */
+#  define MVCLU(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x8E)
+/* MOVE NUMERICS */
+#  define MVN(D1,L,B1,D2,B2)		SSL_(0xD1,L,B1,D1,B2,D2)
+/* MOVE STRING */
+#  define MVST(R1,R2)			RRE_(0xB255,R1,R2)
+/* MOVE WITH OFFSET */
+#  define MVO(D1,L1,B1,D2,L2,B2)	SS_(0xF1,L1,L2,B1,D1,B2,D2)
+/* MOVE ZONES */
+#  define MVZ(D1,L,B1,D2,B2)		SSL_(0xD3,L,B1,D1,B2,D2)
+/* MULTIPLY */
+#  define MR(R1,R2)			RR_(0x1C,R1,R2)
+#  define M(R1,D2,X2,B2)		RX_(0x5C,R1,X2,B2,D2)
+/* MULTIPLY HALFWORD */
+#  define MH(R1,D2,X2,B2)		RX_(0x4C,R1,X2,B2,D2)
+/* MULTIPLY HALFWORD IMMEDIATE */
+#  define MHI(R1,I2)			RI_(0xA7,R1,0xC,I2)
+#  define MGHI(R1,I2)			RI_(0xA7,R1,0xD,I2)
+/* MULTIPLY LOGICAL */
+#  define MLR(R1,R2)			RRE_(0xB996,R1,R2)
+#  define MLGR(R1,R2)			RRE_(0xB986,R1,R2)
+#  define ML(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x96)
+#  define MLG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x86)
+/* MULTIPLY SINGLE */
+#  define MSR(R1,R2)			RRE_(0xB252,R1,R2)
+#  define MSGR(R1,R2)			RRE_(0xB90C,R1,R2)
+#  define MSGFR(R1,R2)			RRE_(0xB91C,R1,R2)
+#  define MS(R1,D2,X2,B2)		RX_(0x71,R1,X2,B2,D2)
+#  define MSY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x51)
+#  define MSG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0C)
+#  define MSGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1C)
+/* OR */
+#  define OR(R1,R2)			RR_(0x16,R1,R2)
+#  define OGR(R1,R2)			RRE_(0xB981,R1,R2)
+#  define O(R1,D2,X2,B2)		RX_(0x56,R1,X2,B2,D2)
+#  define OY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x56)
+#  define OG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x81)
+#  define OI(D1,B1,I2)			SI_(0x96,I2,B1,D1)
+#  define OIY(D1,B1,I2)			SIY_(0xEB,I2,B1,D1,0x56)
+#  define OC(D1,L,B1,D2,B2)		SSL_(0xD6,L,B1,D1,B2,D2)
+/* OR IMMEDIATE */
+#  define OIHH(R1,I2)			RI_(0xA5,R1,0x8,I2)
+#  define OIHL(R1,I2)			RI_(0xA5,R1,0x9,I2)
+#  define OILH(R1,I2)			RI_(0xA5,R1,0xA,I2)
+#  define OILL(R1,I2)			RI_(0xA5,R1,0xB,I2)
+/* PACK */
+#  define PACK(D1,L1,B1,D2,L2,B2)	SS_(0xF2,L1,L2,B1,D1,B2,D2)
+/* PACK ASCII */
+#  define PKA(D1,B1,D2,L2,B2)		SSL_(0xE9,L2,B1,D1,B2,D2)
+/* PACK UNICODE */
+#  define PKU(D1,B1,D2,L2,B2)		SSL_(0xE1,L2,B1,D1,B2,D2)
+/* PERFORM LOCKED OPERATION */
+#  define PLO(R1,D2,B2,R3,D4,B4)	SS_(0xEE,R1,R3,B2,D2,B4,D4)
+/* ROTATE LEFT SINGLE LOGICAL */
+#  define RLL(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x1D)
+#  define RLLG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x1C)
+/* SEARCH STRING */
+#  define SRST(R1,R2)			RRE_(0xB25E,R1,R2)
+/* SET ACCESS */
+#  define SAR(R1,R2)			RRE_(0xB24E,R1,R2)
+/* SET ADDRESSING MODE */
+#  define SAM24()			E_(0x10C)
+#  define SAM31()			E_(0x10D)
+#  define SAM64()			E_(0x10E)
+/* SET PROGRAM MASK */
+#  define SPM(R1)			RR_(0x04,R1,0)
+/* SHIFT LEFT DOUBLE */
+#  define SLDA(R1,D2,B2)		RS_(0x8F,R1,0,B2,D2)
+/* SHIFT LEFT DOUBLE LOGICAL */
+#  define SLDL(R1,D2,B2)		RS_(0x8D,R1,0,B2,D2)
+/* SHIFT LEFT SINGLE */
+#  define SLA(R1,D2,B2)			RS_(0x8B,R1,0,B2,D2)
+#  define SLAG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x0B)
+/* SHIFT LEFT SINGLE LOGICAL */
+#  define SLL(R1,D2,B2)			RS_(0x89,R1,0,B2,D2)
+#  define SLLG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x0D)
+/* SHIFT RIGHT DOUBLE */
+#  define SRDA(R1,D2,B2)		RS_(0x8E,R1,0,B2,D2)
+/* SHIFT RIGHT DOUBLE LOGICAL */
+#  define SRDL(R1,D2,B2)		RS_(0x8C,R1,0,B2,D2)
+/* SHIFT RIGHT SINGLE */
+#  define SRA(R1,D2,B2)			RS_(0x8A,R1,0,B2,D2)
+#  define SRAG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x0A)
+/* SHIFT RIGHT SINGLE LOGICAL */
+#  define SRL(R1,D2,B2)			RS_(0x88,R1,0,B2,D2)
+#  define SRLG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x0C)
+/* STORE */
+#  define ST(R1,D2,X2,B2)		RX_(0x50,R1,X2,B2,D2)
+#  define STY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x50)
+#  define STG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x24)
+/* STORE ACCESS MULTIPLE */
+#  define STAM(R1,R3,D2,B2)		RS_(0x9B,R1,R3,B2,D2)
+#  define STAMY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x9B)
+/* STORE CHARACTER */
+#  define STC(R1,D2,X2,B2)		RX_(0x42,R1,X2,B2,D2)
+#  define STCY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x72)
+/* STORE CHARACTERS UNDER MASK */
+#  define STCM(R1,M3,D2,B2)		RS_(0xBE,R1,M3,B2,D2)
+#  define STCMY(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x2D)
+#  define STCMH(R1,M3,D2,B2)		RSY_(0xEB,R1,M3,B2,D2,0x2C)
+/* STORE CLOCK */
+#  define STCK(D2,B2)			S_(0xB205,B2,D2)
+/* STORE CLOCK EXTENDED */
+#  define STCKE(D2,B2)			S_(0xB278,B2,D2)
+/* STORE HALFWORD */
+#  define STH(R1,D2,X2,B2)		RX_(0x40,R1,X2,B2,D2)
+#  define STHY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x70)
+/* STORE MULTIPLE */
+#  define STM(R1,R3,D2,B2)		RS_(0x90,R1,R3,B2,D2)
+#  define STMY(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x90)
+#  define STMG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x24)
+/* STORE MULTIPLE HIGH */
+#  define STMH(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x26)
+/* STORE PAIR TO QUADWORD */
+#  define STPQ(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x8E)
+/* STORE REVERSED */
+#  define STRVH(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x3F)
+#  define STRV(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x3E)
+#  define STRVG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x2F)
+/* SUBTRACT */
+#  define SR(R1,R2)			RR_(0x1B,R1,R2)
+#  define SGR(R1,R2)			RRE_(0xB909,R1,R2)
+#  define SGFR(R1,R2)			RRE_(0xB919,R1,R2)
+#  define S(R1,D2,X2,B2)		RX_(0x5B,R1,X2,B2,D2)
+#  define SY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x5B)
+#  define SG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x09)
+#  define SGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x19)
+/* SUBTRACT HALFWORD */
+#  define SH(R1,D2,X2,B2)		RX_(0x4B,R1,X2,B2,D2)
+#  define SHY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x7B)
+/* SUBTRACT LOGICAL */
+#  define SLR(R1,R2)			RR_(0x1F,R1,R2)
+#  define SLGR(R1,R2)			RRE_(0xB90B,R1,R2)
+#  define SLGFR(R1,R2)			RRE_(0xB91B,R1,R2)
+#  define SL(R1,D2,X2,B2)		RX_(0x5F,R1,X2,B2,D2)
+#  define SLY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x5F)
+#  define SLG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x0B)
+#  define SLGF(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x1B)
+/* SUBTRACT LOGICAL WITH BORROW */
+#  define SLBR(R1,R2)			RRE_(0xB999,R1,R2)
+#  define SLBGR(R1,R2)			RRE_(0xB989,R1,R2)
+#  define SLB(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x99)
+#  define SLBG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x89)
+/* SUPERVISOR CALL */
+#  define SVC(I)			I_(0xA,I)
+/* TEST ADDRESSING MODE */
+#  define TAM()				E_(0x10B)
+/* TEST AND SET */
+#  define TS(D2,B2)			RS_(0x93,0,0,B2,D2)
+/* TEST UNDER MASK (TEST UNDER MASK HIGH, TEST UNDER MASK LOW) */
+#  define TM(D1,B1,I2)			SI_(0x91,I2,B1,D1)
+#  define TMY(D1,B1,I2)			SIY_(0xEB,I2,B1,D1,0x51)
+#  define TMHH(R1,I2)			RI_(0xA7,R1,0x2,I2)
+#  define TMHL(R1,I2)			RI_(0xA7,R1,0x3,I2)
+#  define TMLH(R1,I2)			RI_(0xA7,R1,0x0,I2)
+#  define TMH(R1,I2)			TMLH(R1,I2)
+#  define TMLL(R1,I2)			RI_(0xA7,R1,0x1,I2)
+#  define TML(R1,I2)			TMLL(R1,I2)
+/* TRANSLATE */
+#  define TR(D1,L,B1,D2,B2)		SSL_(0xDC,L,B1,D1,B2,D2)
+/* TRANSLATE AND TEST */
+#  define TRT(D1,L,B1,D2,B2)		SSL_(0xDD,L,B1,D1,B2,D2)
+/* TRANSLATE EXTENDED */
+#  define TRE(R1,R2)			RRE_(0xB2A5,R1,R2)
+/* TRANSLATE ONE TO ONE */
+#  define TROO(R1,R2)			RRE_(0xB993,R1,R2)
+/* TRANSLATE ONE TO TWO */
+#  define TROT(R1,R2)			RRE_(0xB992,R1,R2)
+/* TRANSLATE TWO TO ONE */
+#  define TRTO(R1,R2)			RRE_(0xB991,R1,R2)
+/* TRANSLATE TWO TO TWO */
+#  define TRTT(R1,R2)			RRE_(0xB990,R1,R2)
+/* UNPACK */
+#  define UNPK(D1,L1,B1,D2,L2,B2)	SS_(0xF3,L1,L2,B1,D1,B2,D2)
+/* UNPACK ASCII */
+#  define UNPKA(D1,L1,B1,D2,L2,B2)	SS_(0xEA,L1,L2,B1,D1,B2,D2)
+/* UNPACK UNICODE */
+#  define UNPKU(D1,L1,B1,D2,L2,B2)	SS_(0xE2,L1,L2,B1,D1,B2,D2)
+/* UPDATE TREE */
+#  define UPT()				E_(0x0102)
+/****************************************************************
+ * Decimal Instructions						*
+ ****************************************************************/
+/* ADD DECIMAL */
+#  define AP(D1,L1,B1,D2,L2,B2)		SS_(0xFA,L1,L2,B1,D1,B2,D2)
+/* COMPARE DECIMAL */
+#  define CP(D1,L1,B1,D2,L2,B2)		SS_(0xF9,L1,L2,B1,D1,B2,D2)
+/* DIVIDE DECIMAL */
+#  define DP(D1,L1,B1,D2,L2,B2)		SS_(0xFD,L1,L2,B1,D1,B2,D2)
+/* EDIT */
+#  define ED(D1,L,B1,D2,B2)		SSL_(0xDE,L,B1,D1,B2,D2)
+/* EDIT AND MARK */
+#  define EDMK(D1,L,B1,D2,B2)		SSL_(0xDE,L,B1,D1,B2,D2)
+/* MULTIPLY DECIMAL */
+#  define MP(D1,L1,B1,D2,L2,B2)		SS_(0xFC,L1,L2,B1,D1,B2,D2)
+/* SHIFT AND ROUND DECIMAL */
+#  define SRP(D1,L1,B1,D2,L2,B2)	SS_(0xF0,L1,L2,B1,D1,B2,D2)
+/* SUBTRACE DECIMAL */
+#  define SP(D1,L1,B1,D2,L2,B2)		SS_(0xFB,L1,L2,B1,D1,B2,D2)
+/* TEST DECIMAL */
+#  define TP(D1,L1,B1)			RSL_(0xEB,L1,B1,D1,0xC0)
+/* ZERO AND ADD */
+#  define ZAP(D1,L1,B1,D2,L2,B2)	SS_(0xF8,L1,L2,B1,D1,B2,D2)
+/****************************************************************
+ * Control Instructions						*
+ ****************************************************************/
+/* BRANCH AND SET AUTHORITY */
+#  define BSA(R1,R2)			RRE_(0xB25A,R1,R2)
+/* BRANCH AND STACK */
+#  define BAKR(R1,R2)			RRE_(0xB240,R1,R2)
+/* BRANCH IN SUBSPACE GROUP */
+#  define BSG(R1,R2)			RRE_(0xB258,R1,R2)
+/* COMPARE AND SWAP AND PURGE */
+#  define CSP(R1,R2)			RRE_(0xB250,R1,R2)
+#  define CSPG(R1,R2)			RRE_(0xB98A,R1,R2)
+/* DIAGNOSE */
+#  define DIAG()			SI_(0x83,0,0,0)
+/* EXTRACT AND SET EXTENDED AUTHORITY */
+#  define ESEA(R1)			RRE_(0xB99D,R1,0)
+/* EXTRACT PRIMARY ASN */
+#  define EPAR(R1)			RRE_(0xB226,R1,0)
+/* EXTRACT SECONDARY ASN */
+#  define ESAR(R1)			RRE_(0xB227,R1,0)
+/* EXTRACT STACKED REGISTERS */
+#  define EREG(R1,R2)			RRE_(0xB249,R1,R2)
+#  define EREGG(R1,R2)			RRE_(0xB90E,R1,R2)
+/* EXTRACT STACKED STATE */
+#  define ESTA(R1,R2)			RRE_(0xB24A,R1,R2)
+/* INSERT ADDRESS SPACE CONTROL */
+#  define IAC(R1)			RRE_(0xB224,R1,0)
+/* INSERT PSW KEY */
+#  define IPK()				S_(0xB20B,0,0)
+/* INSERT STORAGE KEY EXTENDED */
+#  define ISKE(R1,R2)			RRE_(0xB229,R1,R2)
+/* INSERT VIRTUAL STORAGE KEY */
+#  define IVSK(R1,R2)			RRE_(0xB223,R1,R2)
+/* INVALIDATE DAT TABLE ENTRY */
+#  define IDTE(R1,R2,R3)		RRF_(0xB98E,R3,0,R1,R2)
+/* INVALIDATE PAGE TABLE ENTRY */
+#  define IPTE(R1,R2)			RRE_(0xB221,R1,R2)
+/* LOAD ADDRESS SPACE PARAMETER */
+#  define LASP(D1,B1,D2,B2)		SSE_(0xE500,B1,D1,B2,D2)
+/* LOAD CONTROL */
+#  define LCTL(R1,R3,D2,B2)		RS_(0xB7,R1,R3,B2,D2)
+#  define LCTLG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x2F)
+/* LOAD PSW */
+#  define LPSW(D2,B2)			SI_(0x82,0,B2,D2)
+/* LOAD PSW EXTENDED */
+#  define LPSWE(D2,B2)			S_(0xB2B2,B2,D2)
+/* LOAD REAL ADDRESS */
+#  define LRA(R1,D2,X2,B2)		RX_(0xB1,R1,X2,B2,D2)
+#  define LRAY(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x13)
+#  define LRAG(R1,D2,X2,B2)		RXY_(0xE3,R1,X2,B2,D2,0x03)
+/* LOAD USING REAL ADDRESS */
+#  define LURA(R1,R2)			RRE_(0xB24B,R1,R2)
+#  define LURAG(R1,R2)			RRE_(0xB905,R1,R2)
+/* MODIFY STACKED STATE */
+#  define MSTA(R1)			RRE_(0xB247,R1,0)
+/* MOVE PAGE */
+#  define MVPG(R1,R2)			RRE_(0xB254,R1,R2)
+/* MOVE TO PRIMARY */
+#  define MVCP(D1,R1,B1,D2,B2,R3)	SS_(0xDA,R1,R3,B1,D1,B2,D2)
+/* MOVE TO SECONDARY */
+#  define MVCS(D1,R1,B1,D2,B2,R3)	SS_(0xDB,R1,R3,B1,D1,B2,D2)
+/* MOVE WITH DESTINATION KEY */
+#  define MVCDK(D1,B1,D2,B2)		SSE_(0xE50F,B1,D1,B2,D2)
+/* MOVE WITH KEY */
+#  define MVCK(D1,R1,B1,D2,B2,R3)	SS_(0xD9,R1,R3,B1,D1,B2,D2)
+/* MOVE WITH SOURCE KEY */
+#  define MVCSK(D1,B1,D2,B2)		SSE_(0xE50E,B1,D1,B2,D2)
+/* PAGE IN */
+#  define PGIN(R1,R2)			RRE_(0xB22E,R1,R2)
+/* PAGE OUT */
+#  define PGOUT(R1,R2)			RRE_(0xB22F,R1,R2)
+/* PROGRAM CALL */
+#  define PC(D2,B2)			S_(0xB218,B2,D2)
+/* PROGRAM RETURN */
+#  define PR()				E_(0x0101)
+/* PROGRAM TRANSFER */
+#  define PT(R1,R2)			RRE_(0xB228,R1,R2)
+/* PURGE ALB */
+#  define PALB()			RRE_(0xB248,0,0)
+/* PURGE TLB */
+#  define PTLB()			S_(0xB20D,0,0)
+/* RESET REFERENCE BIT EXTENDED */
+#  define RRBE(R1,R2)			RRE_(0xB22A,R1,R2)
+/* RESUME PROGRAM */
+#  define RP(D2,B2)			S_(0xB277,B2,D2)
+/* SET ADDRESS SPACE CONTROL */
+#  define SAC(D2,B2)			S_(0xB219,B2,D2)
+/* SET ADDRESS SPACE CONTROL FAST */
+#  define SACF(D2,B2)			S_(0xB279,B2,D2)
+/* SET CLOCK */
+#  define SCK(D2,B2)			S_(0xB204,B2,D2)
+/* SET CLOCK COMPARATOR */
+#  define SCKC(D2,B2)			S_(0xB206,B2,D2)
+/* SET CLOCK PROGRAMMABLE FIELD */
+#  define SCKPF()			E_(0x0107)
+/* SET CPU TIMER */
+#  define SPT(D2,B2)			S_(0xB208,B2,D2)
+/* SET PREFIX */
+#  define SPX(D2,B2)			S_(0xB210,B2,D2)
+/* SET PSW FROM ADDRESS */
+#  define SPKA(D2,B2)			S_(0xB20A,B2,D2)
+/* SET SECONDARY ASN */
+#  define SSAR(R1)			RRE_(0xB225,R1,0)
+/* SET STORAGE KEY EXTENDED */
+#  define SSKE(R1,R2)			RRE_(0xB22B,R1,R2)
+/* SET SYSTEM MASK */
+#  define SSM(D2,B2)			SI_(0x80,0,B2,D2)
+/* SIGNAL PROCESSOR */
+#  define SIGP(R1,R3,D2,B2)		RS_(0xAE,R1,R3,B2,D2)
+/* STORE CLOCK COMPARATOR */
+#  define STCKC(D2,B2)			S_(0xB207,B2,D2)
+/* STORE CONTROL */
+#  define STCTL(R1,R3,D2,B2)		RS_(0xB6,R1,R3,B2,D2)
+#  define STCTG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x25)
+/* STORE CPU ADDRESS */
+#  define STAP(D2,B2)			S_(0xB212,B2,D2)
+/* STORE CPU ID */
+#  define STIDP(D2,B2)			S_(0xB202,B2,D2)
+/* STORE CPU TIMER */
+#  define STPT(D2,B2)			S_(0xB209,B2,D2)
+/* STORE FACILITY LIST */
+#  define STFL(D2,B2)			S_(0xB2B1,B2,D2)
+/* STORE PREFIX */
+#  define STPX(D2,B2)			S_(0xB211,B2,D2)
+/* STORE REAL ADDRES */
+#  define STRAG(D1,B1,D2,B2)		SSE_(0xE502,B1,D1,B2,D2)
+/* STORE SYSTEM INFORMATION */
+#  define STSI(D2,B2)			S_(0xB27D,B2,D2)
+/* STORE THEN AND SYSTEM MASK */
+#  define STNSM(D1,B1,I2)		SI_(0xAC,I2,B1,D1)
+/* STORE THEN OR SYSTEM MASK */
+#  define STOSM(D1,B1,I2)		SI_(0xAD,I2,B1,D1)
+/* STORE USING REAL ADDRESS */
+#  define STURA(R1,R2)			RRE_(0xB246,R1,R2)
+#  define STURG(R1,R2)			RRE_(0xB925,R1,R2)
+/* TEST ACCESS */
+#  define TAR(R1,R2)			RRE_(0xB24C,R1,R2)
+/* TEST BLOCK */
+#  define TB(R1,R2)			RRE_(0xB22C,R1,R2)
+/* TEST PROTECTION */
+#  define TPROT(D1,B1,D2,B2)		SSE_(0xE501,B1,D1,B2,D2)
+/* TRACE */
+#  define TRACE(R1,R3,D2,B2)		RS_(0x99,R1,R3,B2,D2)
+#  define TRACG(R1,R3,D2,B2)		RSY_(0xEB,R1,R3,B2,D2,0x0F)
+/* TRAP */
+#  define TRAP2()			E_(0x01FF)
+#  define TRAP4(D2,B2)			S_(0xB2FF,B2,D2)
+/****************************************************************
+ * I/O Instructions						*
+ ****************************************************************/
+/* CANCEL SUBCHANNEL */
+#  define XSCH()			S_(0xB276,0,0)
+/* CLEAR SUBCHANNEL */
+#  define CSCH()			S_(0xB230,0,0)
+/* HALT SUBCHANNEL */
+#  define HSCH()			S_(0xB231,0,0)
+/* MODIFY SUBCHANNEL */
+#  define MSCH(D2,B2)			S_(0xB232,B2,D2)
+/* RESET CHANNEL PATH */
+#  define RCHP()			S_(0xB23B,0,0)
+/* RESUME SUBCHANNEL */
+#  define RSCH()			S_(0xB238,0,0)
+/* SET ADDRESS LIMIT */
+#  define SAL()				S_(0xB237,0,0)
+/* SET CHANNEL MONITOR */
+#  define SCHM()			S_(0xB23C,0,0)
+/* START SUBCHANNEL */
+#  define SSCH(D2,B2)			S_(0xB233,B2,D2)
+/* STORE CHANNEL PATH STATUS */
+#  define STCPS(D2,B2)			S_(0xB23A,B2,D2)
+/* STORE CHANNEL REPORT WORD */
+#  define STCRW(D2,B2)			S_(0xB239,B2,D2)
+/* STORE SUBCHANNEL */
+#  define STSCH(D2,B2)			S_(0xB234,B2,D2)
+/* TEST PENDING INTERRUPTION */
+#  define TPI(D2,B2)			S_(0xB236,B2,D2)
+/* TEST SUBCHANNEL */
+#  define TSCH(D2,B2)			S_(0xB235,B2,D2)
+#  define xdivr(r0,r1)			_xdivr(_jit,r0,r1)
+static int32_t _xdivr(jit_state_t*,int32_t,int32_t);
+#  define xdivr_u(r0,r1)		_xdivr_u(_jit,r0,r1)
+static int32_t _xdivr_u(jit_state_t*,int32_t,int32_t);
+#  define xdivi(r0,i0)			_xdivi(_jit,r0,i0)
+static int32_t _xdivi(jit_state_t*,int32_t,jit_word_t);
+#  define xdivi_u(r0,i0)		_xdivi_u(_jit,r0,i0)
+static int32_t _xdivi_u(jit_state_t*,int32_t,jit_word_t);
+#  define crr(cc,r0,r1,r2)		_crr(_jit,cc,r0,r1,r2)
+static void _crr(jit_state_t*,
+		 int32_t,int32_t,int32_t,int32_t);
+#  define cri(cc,r0,r1,i0)		_cri(_jit,cc,r0,r1,i0)
+static void _cri(jit_state_t*,
+		 int32_t,int32_t,int32_t,jit_word_t);
+#  define crr_u(cc,r0,r1,r2)		_crr_u(_jit,cc,r0,r1,r2)
+static void _crr_u(jit_state_t*,
+		   int32_t,int32_t,int32_t,int32_t);
+#  define cri_u(cc,r0,r1,i0)		_cri_u(_jit,cc,r0,r1,i0)
+static void _cri_u(jit_state_t*,
+		   int32_t,int32_t,int32_t,jit_word_t);
+#  define brr(cc,i0,r0,r1)		_brr(_jit,cc,i0,r0,r1)
+static void _brr(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,int32_t);
+#  define brr_p(cc,i0,r0,r1)		_brr_p(_jit,cc,i0,r0,r1)
+static jit_word_t _brr_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,int32_t);
+#  define bri(cc,i0,r0,i1)		_bri(_jit,cc,i0,r0,i1)
+static void _bri(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,jit_word_t);
+#  define bri_p(cc,i0,r0,i1)		_bri_p(_jit,cc,i0,r0,i1)
+static jit_word_t _bri_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,jit_word_t);
+#  define brr_u(cc,i0,r0,r1)		_brr_u(_jit,cc,i0,r0,r1)
+static void _brr_u(jit_state_t*,int32_t,
+		   jit_word_t,int32_t,int32_t);
+#  define brr_u_p(cc,i0,r0,r1)		_brr_u_p(_jit,cc,i0,r0,r1)
+static jit_word_t _brr_u_p(jit_state_t*,int32_t,
+			   jit_word_t,int32_t,int32_t);
+#  define bri_u(cc,i0,r0,i1)		_bri_u(_jit,cc,i0,r0,i1)
+static void _bri_u(jit_state_t*,int32_t,
+		   jit_word_t,int32_t,jit_word_t);
+#  define bri_u_p(cc,i0,r0,i1)		_bri_u_p(_jit,cc,i0,r0,i1)
+static jit_word_t _bri_u_p(jit_state_t*,int32_t,
+			   jit_word_t,int32_t,jit_word_t);
+#  define baddr(c,s,i0,r0,r1)		_baddr(_jit,c,s,i0,r0,r1)
+static void _baddr(jit_state_t*,int32_t,jit_bool_t,
+		   jit_word_t,int32_t,int32_t);
+#  define baddr_p(c,s,i0,r0,r1)		_baddr_p(_jit,c,s,i0,r0,r1)
+static jit_word_t _baddr_p(jit_state_t*,int32_t,jit_bool_t,
+			   jit_word_t,int32_t,int32_t);
+#  define baddi(c,s,i0,r0,i1)		_baddi(_jit,c,s,i0,r0,i1)
+static void _baddi(jit_state_t*,int32_t,jit_bool_t,
+		   jit_word_t,int32_t,jit_word_t);
+#  define baddi_p(c,s,i0,r0,i1)		_baddi_p(_jit,c,s,i0,r0,i1)
+static jit_word_t _baddi_p(jit_state_t*,int32_t,jit_bool_t,
+			   jit_word_t,int32_t,jit_word_t);
+#  define bsubr(c,s,i0,r0,r1)		_bsubr(_jit,c,s,i0,r0,r1)
+static void _bsubr(jit_state_t*,int32_t,jit_bool_t,
+		   jit_word_t,int32_t,int32_t);
+#  define bsubr_p(c,s,i0,r0,r1)		_bsubr_p(_jit,c,s,i0,r0,r1)
+static jit_word_t _bsubr_p(jit_state_t*,int32_t,jit_bool_t,
+			   jit_word_t,int32_t,int32_t);
+#  define bsubi(c,s,i0,r0,i1)		_bsubi(_jit,c,s,i0,r0,i1)
+static void _bsubi(jit_state_t*,int32_t,jit_bool_t,
+		   jit_word_t,int32_t,jit_word_t);
+#  define bsubi_p(c,s,i0,r0,i1)		_bsubi_p(_jit,c,s,i0,r0,i1)
+static jit_word_t _bsubi_p(jit_state_t*,int32_t,jit_bool_t,
+			   jit_word_t,int32_t,jit_word_t);
+#  define bmxr(cc,i0,r0,r1)		_bmxr(_jit,cc,i0,r0,r1)
+static void _bmxr(jit_state_t*,int32_t,
+		  jit_word_t,int32_t,int32_t);
+#  define bmxr_p(cc,i0,r0,r1)		_bmxr_p(_jit,cc,i0,r0,r1)
+static jit_word_t _bmxr_p(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,int32_t);
+#  define bmxi(cc,i0,r0,i1)		_bmxi(_jit,cc,i0,r0,i1)
+static void _bmxi(jit_state_t*,int32_t,
+		  jit_word_t,int32_t,jit_word_t);
+#  define bmxi_p(cc,i0,r0,i1)		_bmxi_p(_jit,cc,i0,r0,i1)
+static jit_word_t _bmxi_p(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,jit_word_t);
+#  define movr(r0,r1)			_movr(_jit,r0,r1)
+static void _movr(jit_state_t*,int32_t,int32_t);
+#  define movi(r0,i0)			_movi(_jit,r0,i0)
+static void _movi(jit_state_t*,int32_t,jit_word_t);
+#  define movi_p(r0,i0)			_movi_p(_jit,r0,i0)
+static jit_word_t _movi_p(jit_state_t*,int32_t,jit_word_t);
+#  define addr(r0,r1,r2)		_addr(_jit,r0,r1,r2)
+static void _addr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addi(r0,r1,i0)		_addi(_jit,r0,r1,i0)
+static void _addi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define addcr(r0,r1,r2)		_addcr(_jit,r0,r1,r2)
+static void _addcr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addci(r0,r1,i0)		_addci(_jit,r0,r1,i0)
+static void _addci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define addxr(r0,r1,r2)		_addxr(_jit,r0,r1,r2)
+static void _addxr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addxi(r0,r1,i0)		_addxi(_jit,r0,r1,i0)
+static void _addxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subr(r0,r1,r2)		_subr(_jit,r0,r1,r2)
+static void _subr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subi(r0,r1,i0)		_subi(_jit,r0,r1,i0)
+static void _subi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subcr(r0,r1,r2)		_subcr(_jit,r0,r1,r2)
+static void _subcr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subci(r0,r1,i0)		_subci(_jit,r0,r1,i0)
+static void _subci(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define subxr(r0,r1,r2)		_subxr(_jit,r0,r1,r2)
+static void _subxr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subxi(r0,r1,i0)		_subxi(_jit,r0,r1,i0)
+static void _subxi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define rsbi(r0, r1, i0)		_rsbi(_jit, r0, r1, i0)
+static void _rsbi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define mulr(r0,r1,r2)		_mulr(_jit,r0,r1,r2)
+static void _mulr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define muli(r0,r1,i0)		_muli(_jit,r0,r1,i0)
+static void _muli(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qmulr(r0,r1,r2,r3)		_qmulr(_jit,r0,r1,r2,r3)
+static void _qmulr(jit_state_t*,int32_t,
+		   int32_t,int32_t,int32_t);
+#  define qmuli(r0,r1,r2,i0)		_qmuli(_jit,r0,r1,r2,i0)
+static void _qmuli(jit_state_t*,int32_t,
+		   int32_t,int32_t,jit_word_t);
+#  define qmulr_u(r0,r1,r2,r3)		_qmulr_u(_jit,r0,r1,r2,r3)
+static void _qmulr_u(jit_state_t*,int32_t,
+		     int32_t,int32_t,int32_t);
+#  define qmuli_u(r0,r1,r2,i0)		_qmuli_u(_jit,r0,r1,r2,i0)
+static void _qmuli_u(jit_state_t*,int32_t,
+		     int32_t,int32_t,jit_word_t);
+#  define divr(r0,r1,r2)		_divr(_jit,r0,r1,r2)
+static void _divr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi(r0,r1,i0)		_divi(_jit,r0,r1,i0)
+static void _divi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define divr_u(r0,r1,r2)		_divr_u(_jit,r0,r1,r2)
+static void _divr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi_u(r0,r1,i0)		_divi_u(_jit,r0,r1,i0)
+static void _divi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define remr(r0,r1,r2)		_remr(_jit,r0,r1,r2)
+static void _remr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi(r0,r1,i0)		_remi(_jit,r0,r1,i0)
+static void _remi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define remr_u(r0,r1,r2)		_remr_u(_jit,r0,r1,r2)
+static void _remr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  define remi_u(r0,r1,i0)		_remi_u(_jit,r0,r1,i0)
+static void _remi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define qdivr(r0,r1,r2,r3)		_qdivr(_jit,r0,r1,r2,r3)
+static void _qdivr(jit_state_t*,int32_t,
+		   int32_t,int32_t,int32_t);
+#  define qdivi(r0,r1,r2,i0)		_qdivi(_jit,r0,r1,r2,i0)
+static void _qdivi(jit_state_t*,int32_t,
+		   int32_t,int32_t,jit_word_t);
+#  define qdivr_u(r0,r1,r2,r3)		_qdivr_u(_jit,r0,r1,r2,r3)
+static void _qdivr_u(jit_state_t*,int32_t,
+		     int32_t,int32_t,int32_t);
+#  define qdivi_u(r0,r1,r2,i0)		_qdivi_u(_jit,r0,r1,r2,i0)
+static void _qdivi_u(jit_state_t*,int32_t,
+		     int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define lshr(r0,r1,r2)		_lshr(_jit,r0,r1,r2)
+static void _lshr(jit_state_t*,int32_t,int32_t,int32_t);
+#  else
+#    define lshr(r0,r1,r2)		SLLG(r0,r1,0,r2)
+#  endif
+#  define lshi(r0,r1,i0)		_lshi(_jit,r0,r1,i0)
+static void _lshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define rshr(r0,r1,r2)		_rshr(_jit,r0,r1,r2)
+static void _rshr(jit_state_t*,int32_t,int32_t,int32_t);
+#  else
+#    define rshr(r0,r1,r2)		SRAG(r0,r1,0,r2)
+#  endif
+#  define rshi(r0,r1,i0)		_rshi(_jit,r0,r1,i0)
+static void _rshi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define rshr_u(r0,r1,r2)		_rshr_u(_jit,r0,r1,r2)
+static void _rshr_u(jit_state_t*,int32_t,int32_t,int32_t);
+#  else
+#    define rshr_u(r0,r1,r2)		SRLG(r0,r1,0,r2)
+#  endif
+#  define rshi_u(r0,r1,i0)		_rshi_u(_jit,r0,r1,i0)
+static void _rshi_u(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define negr(r0,r1)			LCR(r0,r1)
+#  else
+#    define negr(r0,r1)			LCGR(r0,r1)
+#  endif
+#  define comr(r0,r1)			_comr(_jit,r0,r1)
+static void _comr(jit_state_t*,int32_t,int32_t);
+#  define andr(r0,r1,r2)		_andr(_jit,r0,r1,r2)
+static void _andr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define andi(r0,r1,i0)		_andi(_jit,r0,r1,i0)
+static void _andi(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define orr(r0,r1,r2)			_orr(_jit,r0,r1,r2)
+static void _orr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ori(r0,r1,i0)			_ori(_jit,r0,r1,i0)
+static void _ori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define xorr(r0,r1,r2)		_xorr(_jit,r0,r1,r2)
+static void _xorr(jit_state_t*,int32_t,int32_t,int32_t);
+#  define xori(r0,r1,i0)		_xori(_jit,r0,r1,i0)
+static void _xori(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define bswapr_us(r0,r1)		extr_us(r0,r1)
+#  if __WORDSIZE == 32
+#    define bswapr_ui(r0,r1)		movr(r0,r1)
+#  else
+#    define bswapr_ui(r0,r1)		extr_ui(r0,r1)
+#    define bswapr, 2019_ul(r0,r1)		movr(r0,r1)
+#  endif
+#  define extr_c(r0,r1)			LGBR(r0,r1)
+#  define extr_uc(r0,r1)		LLGCR(r0,r1)
+#  define extr_s(r0,r1)			LGHR(r0,r1)
+#  define extr_us(r0,r1)		LLGHR(r0,r1)
+#  if __WORDSIZE == 64
+#    define extr_i(r0,r1)		LGFR(r0,r1)
+#    define extr_ui(r0,r1)		LLGFR(r0,r1)
+#  endif
+#  define ldr_c(r0,r1)			LGB(r0,0,0,r1)
+#  define ldi_c(r0,i0)			_ldi_c(_jit,r0,i0)
+static void _ldi_c(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_c(r0,r1,r2)		_ldxr_c(_jit,r0,r1,r2)
+static void _ldxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_c(r0,r1,i0)		_ldxi_c(_jit,r0,r1,i0)
+static void _ldxi_c(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldr_uc(r0,r1)			LLGC(r0,0,0,r1)
+#  define ldi_uc(r0,i0)			_ldi_uc(_jit,r0,i0)
+static void _ldi_uc(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_uc(r0,r1,r2)		_ldxr_uc(_jit,r0,r1,r2)
+static void _ldxr_uc(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_uc(r0,r1,i0)		_ldxi_uc(_jit,r0,r1,i0)
+static void _ldxi_uc(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define ldr_s(r0,r1)		LH(r0,0,0,r1)
+#  else
+#    define ldr_s(r0,r1)		LGH(r0,0,0,r1)
+#  endif
+#  define ldi_s(r0,i0)			_ldi_s(_jit,r0,i0)
+static void _ldi_s(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_s(r0,r1,r2)		_ldxr_s(_jit,r0,r1,r2)
+static void _ldxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_s(r0,r1,i0)		_ldxi_s(_jit,r0,r1,i0)
+static void _ldxi_s(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldr_us(r0,r1)			LLGH(r0,0,0,r1)
+#  define ldi_us(r0,i0)			_ldi_us(_jit,r0,i0)
+static void _ldi_us(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_us(r0,r1,r2)		_ldxr_us(_jit,r0,r1,r2)
+static void _ldxr_us(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_us(r0,r1,i0)		_ldxi_us(_jit,r0,r1,i0)
+static void _ldxi_us(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 32
+#    define ldr_i(r0,r1)		LLGF(r0,0,0,r1)
+#  else
+#    define ldr_i(r0,r1)		LGF(r0,0,0,r1)
+#  endif
+#  define ldi_i(r0,i0)			_ldi_i(_jit,r0,i0)
+static void _ldi_i(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_i(r0,r1,r2)		_ldxr_i(_jit,r0,r1,r2)
+static void _ldxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_i(r0,r1,i0)		_ldxi_i(_jit,r0,r1,i0)
+static void _ldxi_i(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  if __WORDSIZE == 64
+#    define ldr_ui(r0,r1)		LLGF(r0,0,0,r1)
+#    define ldi_ui(r0,i0)		_ldi_ui(_jit,r0,i0)
+static void _ldi_ui(jit_state_t*,int32_t,jit_word_t);
+#    define ldxr_ui(r0,r1,r2)		_ldxr_ui(_jit,r0,r1,r2)
+static void _ldxr_ui(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_ui(r0,r1,i0)		_ldxi_ui(_jit,r0,r1,i0)
+static void _ldxi_ui(jit_state_t*,int32_t,int32_t,jit_word_t);
+#    define ldr_l(r0,r1)		LG(r0,0,0,r1)
+#    define ldi_l(r0,i0)		_ldi_l(_jit,r0,i0)
+static void _ldi_l(jit_state_t*,int32_t,jit_word_t);
+#    define ldxr_l(r0,r1,r2)		_ldxr_l(_jit,r0,r1,r2)
+static void _ldxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#    define ldxi_l(r0,r1,i0)		_ldxi_l(_jit,r0,r1,i0)
+static void _ldxi_l(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  endif
+#  define str_c(r0,r1)			STC(r1,0,0,r0)
+#  define sti_c(i0,r0)			_sti_c(_jit,i0,r0)
+static void _sti_c(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_c(r0,r1,r2)		_stxr_c(_jit,r0,r1,r2)
+static void _stxr_c(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_c(i0,r0,r1)		_stxi_c(_jit,i0,r0,r1)
+static void _stxi_c(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define str_s(r0,r1)			STH(r1,0,0,r0)
+#  define sti_s(i0,r0)			_sti_s(_jit,i0,r0)
+static void _sti_s(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_s(r0,r1,r2)		_stxr_s(_jit,r0,r1,r2)
+static void _stxr_s(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_s(i0,r0,r1)		_stxi_s(_jit,i0,r0,r1)
+static void _stxi_s(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define str_i(r0,r1)			ST(r1,0,0,r0)
+#  define sti_i(i0,r0)			_sti_i(_jit,i0,r0)
+static void _sti_i(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_i(r0,r1,r2)		_stxr_i(_jit,r0,r1,r2)
+static void _stxr_i(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_i(i0,r0,r1)		_stxi_i(_jit,i0,r0,r1)
+static void _stxi_i(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  if __WORDSIZE == 64
+#    define str_l(r0,r1)		STG(r1,0,0,r0)
+#    define sti_l(i0,r0)		_sti_l(_jit,i0,r0)
+static void _sti_l(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_l(r0,r1,r2)		_stxr_l(_jit,r0,r1,r2)
+static void _stxr_l(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_l(i0,r0,r1)		_stxi_l(_jit,i0,r0,r1)
+static void _stxi_l(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  endif
+#  define ltr(r0,r1,r2)			crr(CC_L,r0,r1,r2)
+#  define lti(r0,r1,i0)			cri(CC_L,r0,r1,i0)
+#  define ltr_u(r0,r1,r2)		crr_u(CC_L,r0,r1,r2)
+#  define lti_u(r0,r1,i0)		cri_u(CC_L,r0,r1,i0)
+#  define ler(r0,r1,r2)			crr(CC_LE,r0,r1,r2)
+#  define lei(r0,r1,i0)			cri(CC_LE,r0,r1,i0)
+#  define ler_u(r0,r1,r2)		crr_u(CC_LE,r0,r1,r2)
+#  define lei_u(r0,r1,i0)		cri_u(CC_LE,r0,r1,i0)
+#  define eqr(r0,r1,r2)			crr(CC_E,r0,r1,r2)
+#  define eqi(r0,r1,i0)			cri(CC_E,r0,r1,i0)
+#  define ger(r0,r1,r2)			crr(CC_HE,r0,r1,r2)
+#  define gei(r0,r1,i0)			cri(CC_HE,r0,r1,i0)
+#  define ger_u(r0,r1,r2)		crr_u(CC_HE,r0,r1,r2)
+#  define gei_u(r0,r1,i0)		cri_u(CC_HE,r0,r1,i0)
+#  define gtr(r0,r1,r2)			crr(CC_H,r0,r1,r2)
+#  define gti(r0,r1,i0)			cri(CC_H,r0,r1,i0)
+#  define gtr_u(r0,r1,r2)		crr_u(CC_H,r0,r1,r2)
+#  define gti_u(r0,r1,i0)		cri_u(CC_H,r0,r1,i0)
+#  define ner(r0,r1,r2)			crr(CC_NE,r0,r1,r2)
+#  define nei(r0,r1,i0)			cri(CC_NE,r0,r1,i0)
+#  define bltr(i0,r0,r1)		brr(CC_L,i0,r0,r1)
+#  define bltr_p(i0,r0,r1)		brr_p(CC_L,i0,r0,r1)
+#  define blti(i0,r0,i1)		bri(CC_L,i0,r0,i1)
+#  define blti_p(i0,r0,i1)		bri_p(CC_L,i0,r0,i1)
+#  define bltr_u(i0,r0,r1)		brr_u(CC_L,i0,r0,r1)
+#  define bltr_u_p(i0,r0,r1)		brr_u_p(CC_L,i0,r0,r1)
+#  define blti_u(i0,r0,i1)		bri_u(CC_L,i0,r0,i1)
+#  define blti_u_p(i0,r0,i1)		bri_u_p(CC_L,i0,r0,i1)
+#  define bler(i0,r0,r1)		brr(CC_LE,i0,r0,r1)
+#  define bler_p(i0,r0,r1)		brr_p(CC_LE,i0,r0,r1)
+#  define blei(i0,r0,i1)		bri(CC_LE,i0,r0,i1)
+#  define blei_p(i0,r0,i1)		bri_p(CC_LE,i0,r0,i1)
+#  define bler_u(i0,r0,r1)		brr_u(CC_LE,i0,r0,r1)
+#  define bler_u_p(i0,r0,r1)		brr_u_p(CC_LE,i0,r0,r1)
+#  define blei_u(i0,r0,i1)		bri_u(CC_LE,i0,r0,i1)
+#  define blei_u_p(i0,r0,i1)		bri_u_p(CC_LE,i0,r0,i1)
+#  define beqr(i0,r0,r1)		brr(CC_E,i0,r0,r1)
+#  define beqr_p(i0,r0,r1)		brr_p(CC_E,i0,r0,r1)
+#  define beqi(i0,r0,i1)		bri(CC_E,i0,r0,i1)
+#  define beqi_p(i0,r0,i1)		bri_p(CC_E,i0,r0,i1)
+#  define bger(i0,r0,r1)		brr(CC_HE,i0,r0,r1)
+#  define bger_p(i0,r0,r1)		brr_p(CC_HE,i0,r0,r1)
+#  define bgei(i0,r0,i1)		bri(CC_HE,i0,r0,i1)
+#  define bgei_p(i0,r0,i1)		bri_p(CC_HE,i0,r0,i1)
+#  define bger_u(i0,r0,r1)		brr_u(CC_HE,i0,r0,r1)
+#  define bger_u_p(i0,r0,r1)		brr_u_p(CC_HE,i0,r0,r1)
+#  define bgei_u(i0,r0,i1)		bri_u(CC_HE,i0,r0,i1)
+#  define bgei_u_p(i0,r0,i1)		bri_u_p(CC_HE,i0,r0,i1)
+#  define bgtr(i0,r0,r1)		brr(CC_H,i0,r0,r1)
+#  define bgtr_p(i0,r0,r1)		brr_p(CC_H,i0,r0,r1)
+#  define bgti(i0,r0,i1)		bri(CC_H,i0,r0,i1)
+#  define bgti_p(i0,r0,i1)		bri_p(CC_H,i0,r0,i1)
+#  define bgtr_u(i0,r0,r1)		brr_u(CC_H,i0,r0,r1)
+#  define bgtr_u_p(i0,r0,r1)		brr_u_p(CC_H,i0,r0,r1)
+#  define bgti_u(i0,r0,i1)		bri_u(CC_H,i0,r0,i1)
+#  define bgti_u_p(i0,r0,i1)		bri_u_p(CC_H,i0,r0,i1)
+#  define bner(i0,r0,r1)		brr(CC_NE,i0,r0,r1)
+#  define bner_p(i0,r0,r1)		brr_p(CC_NE,i0,r0,r1)
+#  define bnei(i0,r0,i1)		bri(CC_NE,i0,r0,i1)
+#  define bnei_p(i0,r0,i1)		bri_p(CC_NE,i0,r0,i1)
+#  define boaddr(i0,r0,r1)		baddr(CC_O,1,i0,r0,r1)
+#  define boaddr_p(i0,r0,r1)		baddr_p(CC_O,1,i0,r0,r1)
+#  define boaddi(i0,r0,i1)		baddi(CC_O,1,i0,r0,i1)
+#  define boaddi_p(i0,r0,i1)		baddi_p(CC_O,1,i0,r0,i1)
+#  define boaddr_u(i0,r0,r1)		baddr(CC_NLE,0,i0,r0,r1)
+#  define boaddr_u_p(i0,r0,r1)		baddr_p(CC_NLE,0,i0,r0,r1)
+#  define boaddi_u(i0,r0,i1)		baddi(CC_NLE,0,i0,r0,i1)
+#  define boaddi_u_p(i0,r0,i1)		baddi_p(CC_NLE,0,i0,r0,i1)
+#  define bxaddr(i0,r0,r1)		baddr(CC_NO,1,i0,r0,r1)
+#  define bxaddr_p(i0,r0,r1)		baddr_p(CC_NO,1,i0,r0,r1)
+#  define bxaddi(i0,r0,i1)		baddi(CC_NO,1,i0,r0,i1)
+#  define bxaddi_p(i0,r0,i1)		baddi_p(CC_NO,1,i0,r0,i1)
+#  define bxaddr_u(i0,r0,r1)		baddr(CC_LE,0,i0,r0,r1)
+#  define bxaddr_u_p(i0,r0,r1)		baddr_p(CC_LE,0,i0,r0,r1)
+#  define bxaddi_u(i0,r0,i1)		baddi(CC_LE,0,i0,r0,i1)
+#  define bxaddi_u_p(i0,r0,i1)		baddi_p(CC_LE,0,i0,r0,i1)
+#  define bosubr(i0,r0,r1)		bsubr(CC_O,1,i0,r0,r1)
+#  define bosubr_p(i0,r0,r1)		bsubr_p(CC_O,1,i0,r0,r1)
+#  define bosubi(i0,r0,i1)		bsubi(CC_O,1,i0,r0,i1)
+#  define bosubi_p(i0,r0,i1)		bsubi_p(CC_O,1,i0,r0,i1)
+#  define bosubr_u(i0,r0,r1)		bsubr(CC_L,0,i0,r0,r1)
+#  define bosubr_u_p(i0,r0,r1)		bsubr_p(CC_L,0,i0,r0,r1)
+#  define bosubi_u(i0,r0,i1)		bsubi(CC_L,0,i0,r0,i1)
+#  define bosubi_u_p(i0,r0,i1)		bsubi_p(CC_L,0,i0,r0,i1)
+#  define bxsubr(i0,r0,r1)		bsubr(CC_NO,1,i0,r0,r1)
+#  define bxsubr_p(i0,r0,r1)		bsubr_p(CC_NO,1,i0,r0,r1)
+#  define bxsubi(i0,r0,i1)		bsubi(CC_NO,1,i0,r0,i1)
+#  define bxsubi_p(i0,r0,i1)		bsubi_p(CC_NO,1,i0,r0,i1)
+#  define bxsubr_u(i0,r0,r1)		bsubr(CC_NL,0,i0,r0,r1)
+#  define bxsubr_u_p(i0,r0,r1)		bsubr_p(CC_NL,0,i0,r0,r1)
+#  define bxsubi_u(i0,r0,i1)		bsubi(CC_NL,0,i0,r0,i1)
+#  define bxsubi_u_p(i0,r0,i1)		bsubi_p(CC_NL,0,i0,r0,i1)
+#  define bmsr(i0,r0,r1)		bmxr(CC_NE,i0,r0,r1)
+#  define bmsr_p(i0,r0,r1)		bmxr_p(CC_NE,i0,r0,r1)
+#  define bmsi(i0,r0,i1)		bmxi(CC_NE,i0,r0,i1)
+#  define bmsi_p(i0,r0,i1)		bmxi_p(CC_NE,i0,r0,i1)
+#  define bmcr(i0,r0,r1)		bmxr(CC_E,i0,r0,r1)
+#  define bmcr_p(i0,r0,r1)		bmxr_p(CC_E,i0,r0,r1)
+#  define bmci(i0,r0,i1)		bmxi(CC_E,i0,r0,i1)
+#  define bmci_p(i0,r0,i1)		bmxi_p(CC_E,i0,r0,i1)
+#  define jmpr(r0)			BR(r0)
+#  define jmpi(i0)			_jmpi(_jit,i0)
+static void _jmpi(jit_state_t*,jit_word_t);
+#  define jmpi_p(i0)			_jmpi_p(_jit,i0)
+static jit_word_t _jmpi_p(jit_state_t*,jit_word_t);
+#  define callr(r0)			BALR(_R14_REGNO,r0)
+#  define calli(i0)			_calli(_jit,i0)
+static void _calli(jit_state_t*,jit_word_t);
+#  define calli_p(i0)			_calli_p(_jit,i0)
+static jit_word_t _calli_p(jit_state_t*,jit_word_t);
+#  define prolog(i0)			_prolog(_jit,i0)
+static void _prolog(jit_state_t*,jit_node_t*);
+#  define epilog(i0)			_epilog(_jit,i0)
+static void _epilog(jit_state_t*,jit_node_t*);
+#  define vastart(r0)			_vastart(_jit, r0)
+static void _vastart(jit_state_t*, int32_t);
+#  define vaarg(r0, r1)			_vaarg(_jit, r0, r1)
+static void _vaarg(jit_state_t*, int32_t, int32_t);
+#  define patch_at(instr,label)		_patch_at(_jit,instr,label)
+static void _patch_at(jit_state_t*,jit_word_t,jit_word_t);
+#endif
+
+#if CODE
+#  define _us				uint16_t
+#  define _ui				uint32_t
+static void
+_E(jit_state_t *_jit, _ui Op)
+{
+    union {
+	struct {
+	    _us	op;
+	} b;
+	_us	s;
+    } i0;
+    i0.b.op = Op;
+    assert(i0.b.op == Op);
+    is(i0.s);
+}
+
+static void
+_I(jit_state_t *_jit, _ui Op, _ui I)
+{
+    union {
+	struct {
+	    _us	op : 8;
+	    _us	i  : 8;
+	} b;
+	_us	s;
+    } i0;
+    i0.b.op = Op;
+    i0.b.i  = I;
+    assert(i0.b.op == Op);
+    assert(i0.b.i  == I);
+    is(i0.s);
+}
+
+static void
+_RR(jit_state_t *_jit, _ui Op, _ui R1, _ui R2)
+{
+    union {
+	struct {
+	    _us	op : 8;
+	    _us	r1 : 4;
+	    _us	r2 : 4;
+	} b;
+	_us	s;
+    } i0;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.r2 = R2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.r2 == R2);
+    is(i0.s);
+}
+
+static void
+_RRE(jit_state_t *_jit, _ui Op, _ui R1, _ui R2)
+{
+    union {
+	struct {
+	    _us	op;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	_  : 8;
+	    _us	r1 : 4;
+	    _us	r2 : 4;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i1.b._ = 0;
+    i1.b.r1 = R1;
+    i1.b.r2 = R2;
+    assert(i0.b.op == Op);
+    assert(i1.b.r1 == R1);
+    assert(i1.b.r2 == R2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_RRF(jit_state_t *_jit, _ui Op, _ui R3, _ui M4, _ui R1, _ui R2)
+{
+    union {
+	struct {
+	    _us	op;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	r3 : 4;
+	    _us	m4 : 4;
+	    _us	r1 : 4;
+	    _us	r2 : 4;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i1.b.r3 = R3;
+    i1.b.m4 = M4;
+    i1.b.r1 = R1;
+    i1.b.r2 = R2;
+    assert(i0.b.op == Op);
+    assert(i1.b.r3 == R3);
+    assert(i1.b.m4 == M4);
+    assert(i1.b.r1 == R1);
+    assert(i1.b.r2 == R2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_RX(jit_state_t *_jit, _ui Op, _ui R1, _ui X2, _ui B2, _ui D2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	x2 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.x2 = X2;
+    i1.b.b2 = B2;
+    i1.b.d2 = D2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.x2 == X2);
+    assert(i1.b.b2 == B2);
+    assert(i1.b.d2 == D2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_RXE(jit_state_t *_jit, _ui Op, _ui R1, _ui X2, _ui B2, _ui D2, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	x2 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_ui	s;
+    } i1;
+    union {
+	struct {
+	    _us	_  :  8;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i2.b._ = 0;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.x2 = X2;
+    i1.b.b2 = B2;
+    i1.b.d2 = D2;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.x2 == X2);
+    assert(i1.b.b2 == B2);
+    assert(i1.b.d2 == D2);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_RXF(jit_state_t *_jit, _ui Op, _ui R3, _ui X2, _ui B2, _ui D2, _ui R1, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r3 :  4;
+	    _us	x2 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	r1 :  4;
+	    _us	_  :  4;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i2.b._ = 0;
+    i0.b.op = Op;
+    i0.b.r3 = R3;
+    i0.b.x2 = X2;
+    i1.b.b2 = B2;
+    i1.b.d2 = D2;
+    i2.b.r1 = R1;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r3 == R3);
+    assert(i0.b.x2 == X2);
+    assert(i1.b.b2 == B2);
+    assert(i1.b.d2 == D2);
+    assert(i2.b.r1 == R1);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_RXY(jit_state_t *_jit, _ui Op, _ui R1, _ui X2, _ui B2, _ui D2, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	x2 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	dl : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	dh :  8;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i0.s = i1.s = i2.s = 0;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.x2 = X2;
+    i1.b.b2 = B2;
+    i1.b.dl = D2 & 0xfff;
+    i2.b.dh = D2 >> 12;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.x2 == X2);
+    assert(i1.b.b2 == B2);
+    assert(i2.b.dh == D2 >> 12);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_RS(jit_state_t *_jit, _ui Op, _ui R1, _ui R3, _ui B2, _ui D2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	r3 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i1;
+    i0.s = i1.s = 0;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.r3 = R3;
+    i1.b.b2 = B2;
+    i1.b.d2 = D2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.r3 == R3);
+    assert(i1.b.b2 == B2);
+    assert(i1.b.d2 == D2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_RSL(jit_state_t *_jit, _ui Op, _ui L1, _ui B1, _ui D1, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	l1 :  4;
+	    _us _  :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b1 :  4;
+	    _us	d1 : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	_  :  8;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i0.b._ = 0;
+    i2.b._ = 0;
+    i0.b.op = Op;
+    i0.b.l1 = L1;
+    i1.b.b1 = B1;
+    i1.b.d1 = D1;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.l1 == L1);
+    assert(i1.b.b1 == B1);
+    assert(i1.b.d1 == D1);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_RSI(jit_state_t *_jit, _ui Op, _ui R1, _ui R3, _ui I2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	r3 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	i2;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.r3 = R3;
+    i1.b.i2 = I2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.r3 == R3);
+    assert(i1.b.i2 == I2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_RIE(jit_state_t *_jit, _ui Op, _ui R1, _ui R3, _ui I2, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	r1 :  4;
+	    _us	r3 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	i2;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	_  :  8;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i2.b._ = 0;
+    i0.b.op = Op;
+    i0.b.r1 = R1;
+    i0.b.r3 = R3;
+    i1.b.i2 = I2;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.r3 == R3);
+    assert(i1.b.i2 == I2);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_RIL(jit_state_t *_jit, _ui Op, _ui R1, _ui Op2, _ui I2)
+{
+    union {
+	struct {
+	    _us	o1 :  8;
+	    _us	r1 :  4;
+	    _us	o2 :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _ui	ih : 16;
+	    _ui	il : 16;
+	} b;
+	_ui	i;
+    } i12;
+    i0.b.o1 = Op;
+    i0.b.r1 = R1;
+    i0.b.o2 = Op2;
+    i12.i   = I2;
+    assert(i0.b.o1 == Op);
+    assert(i0.b.r1 == R1);
+    assert(i0.b.o2 == Op2);
+    is(i0.s);
+    is(i12.b.ih);
+    is(i12.b.il);
+}
+
+static void
+_SI(jit_state_t *_jit, _ui Op, _ui I2, _ui B1, _ui D1)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	i2 :  8;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b1 :  4;
+	    _us	d1 : 12;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i0.b.i2 = I2;
+    i1.b.b1 = B1;
+    i1.b.d1 = D1;
+    assert(i0.b.op == Op);
+    assert(i0.b.i2 == I2);
+    assert(i1.b.b1 == B1);
+    assert(i1.b.d1 == D1);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_SIY(jit_state_t *_jit, _ui Op, _ui I2, _ui B1, _ui D1, _ui Op2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	i2 :  8;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b1 :  4;
+	    _us	dl : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	dh :  8;
+	    _us	op :  8;
+	} b;
+	_us	s;
+    } i2;
+    i0.b.op = Op;
+    i0.b.i2 = I2;
+    i1.b.b1 = B1;
+    i1.b.dl = D1 & 0xfff;
+    i2.b.dh = D1 >> 8;
+    i2.b.op = Op2;
+    assert(i0.b.op == Op);
+    assert(i0.b.i2 == I2);
+    assert(i1.b.b1 == B1);
+    assert(i2.b.dh == D1 >> 8);
+    assert(i2.b.op == Op2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_S(jit_state_t *_jit, _ui Op, _ui B2, _ui D2)
+{
+    union {
+	struct {
+	    _us	op;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i1;
+    i0.b.op = Op;
+    i1.b.b2 = B2;
+    i1.b.d2 = D2;
+    assert(i0.b.op == Op);
+    assert(i1.b.b2 == B2);
+    assert(i1.b.d2 == D2);
+    is(i0.s);
+    is(i1.s);
+}
+
+static void
+_SS(jit_state_t *_jit, _ui Op, _ui LL, _ui LH, _ui B1, _ui D1, _ui B2, _ui D2)
+{
+    union {
+	struct {
+	    _us	op :  8;
+	    _us	ll :  4;
+	    _us	lh :  4;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b1 :  4;
+	    _us	d1 : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i2;
+    i0.b.op = Op;
+    i0.b.ll = LL;
+    i0.b.lh = LH;
+    i1.b.b1 = B1;
+    i1.b.d1 = D1;
+    i2.b.b2 = B2;
+    i2.b.d2 = D2;
+    assert(i0.b.op == Op);
+    assert(i0.b.ll == LL);
+    assert(i0.b.lh == LH);
+    assert(i1.b.b1 == B1);
+    assert(i1.b.d1 == D1);
+    assert(i2.b.b2 == B2);
+    assert(i2.b.d2 == D2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+
+static void
+_SSE(jit_state_t *_jit, _ui Op, _ui B1, _ui D1, _ui B2, _ui D2)
+{
+    union {
+	struct {
+	    _us	op;
+	} b;
+	_us	s;
+    } i0;
+    union {
+	struct {
+	    _us	b1 :  4;
+	    _us	d1 : 12;
+	} b;
+	_us	s;
+    } i1;
+    union {
+	struct {
+	    _us	b2 :  4;
+	    _us	d2 : 12;
+	} b;
+	_us	s;
+    } i2;
+    i0.b.op = Op;
+    i1.b.b1 = B1;
+    i1.b.d1 = D1;
+    i2.b.b2 = B2;
+    i2.b.d2 = D2;
+    assert(i0.b.op == Op);
+    assert(i1.b.b1 == B1);
+    assert(i1.b.d1 == D1);
+    assert(i2.b.b2 == B2);
+    assert(i2.b.d2 == D2);
+    is(i0.s);
+    is(i1.s);
+    is(i2.s);
+}
+#  undef _us
+#  undef _ui
+
+static void
+_nop(jit_state_t *_jit, int32_t c)
+{
+    assert(c >= 0 && !(c & 1));
+    while (c) {
+	NOPR(_R7_REGNO);
+	c -= 2;
+    }
+}
+
+static int32_t
+_xdivr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		regno;
+    regno = jit_get_reg_pair();
+#if __WORDSIZE == 32
+    movr(rn(regno), r0);
+    SRDA(rn(regno), 32, 0);
+#else
+    movr(rn(regno) + 1, r0);
+#endif
+    DIVREM_(rn(regno), r1);
+    jit_unget_reg_pair(regno);
+    return (regno);
+}
+
+static int32_t
+_xdivr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		regno;
+    regno = jit_get_reg_pair();
+#if __WORDSIZE == 32
+    movr(rn(regno), r0);
+    SRDL(rn(regno), 32, 0);
+#else
+    movr(rn(regno) + 1, r0);
+#endif
+    movi(rn(regno), 0);
+    DIVREMU_(rn(regno), r1);
+    jit_unget_reg_pair(regno);
+    return (regno);
+}
+
+static int32_t
+_xdivi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		imm, regno;
+    regno = jit_get_reg_pair();
+    imm = jit_get_reg(jit_class_gpr);
+#if __WORDSIZE == 32
+    movr(rn(regno), r0);
+    SRDA(rn(regno), 32, 0);
+#else
+    movr(rn(regno) + 1, r0);
+#endif
+    movi(rn(imm), i0);
+    DIVREM_(rn(regno), rn(imm));
+    jit_unget_reg(imm);
+    jit_unget_reg_pair(regno);
+    return (regno);
+}
+
+static int32_t
+_xdivi_u(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    /* cannot overlap because operand is 128-bit */
+    int32_t		imm, regno;
+    regno = jit_get_reg_pair();
+    imm = jit_get_reg(jit_class_gpr);
+#if __WORDSIZE == 32
+    movr(rn(regno), r0);
+    SRDL(rn(regno), 32, 0);
+#else
+    movr(rn(regno) + 1, r0);
+#endif
+    movi(rn(regno), 0);
+    movi(rn(imm), i0);
+    DIVREMU_(rn(regno), rn(imm));
+    jit_unget_reg(imm);
+    jit_unget_reg_pair(regno);
+    return (regno);
+}
+
+static void
+_crr(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    int32_t		reg, rg;
+    if (r0 == r1 || r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	rg = rn(reg);
+    }
+    else
+	rg = r0;
+    movi(rg, 1);
+    CMP_(r1, r2);
+    w = _jit->pc.w;
+    BRC(cc, 0);
+    movi(rg, 0);
+    patch_at(w, _jit->pc.w);
+    if (r0 == r1 || r0 == r2) {
+	movr(r0, rg);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_cri(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    crr(cc, r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_crr_u(jit_state_t *_jit, int32_t cc,
+       int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    int32_t		reg, rg;
+    if (r0 == r1 || r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	rg = rn(reg);
+    }
+    else
+	rg = r0;
+    movi(rg, 1);
+    CMPU_(r1, r2);
+    w = _jit->pc.w;
+    BRC(cc, 0);
+    movi(rg, 0);
+    patch_at(w, _jit->pc.w);
+    if (r0 == r1 || r0 == r2) {
+	movr(r0, rg);
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_cri_u(jit_state_t *_jit, int32_t cc,
+       int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    crr_u(cc, r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_brr(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    CMP_(r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static jit_word_t
+_brr_p(jit_state_t *_jit, int32_t cc,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    CMP_(r0, r1);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static void
+_bri(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    brr(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static jit_word_t
+_bri_p(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = brr_p(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_brr_u(jit_state_t *_jit, int32_t cc,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    CMPU_(r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static jit_word_t
+_brr_u_p(jit_state_t *_jit, int32_t cc,
+	 jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    CMPU_(r0, r1);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static void
+_bri_u(jit_state_t *_jit, int32_t cc,
+       jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    brr_u(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static jit_word_t
+_bri_u_p(jit_state_t *_jit, int32_t cc,
+	 jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = brr_u_p(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_baddr(jit_state_t *_jit, int32_t c, jit_bool_t s,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    if (s)		addr(r0, r0, r1);
+    else		addcr(r0, r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(c, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(c, d);
+    }
+}
+
+static void
+_baddi(jit_state_t *_jit, int32_t c, jit_bool_t s,
+       jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    baddr(c, s, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static jit_word_t
+_baddr_p(jit_state_t *_jit, int32_t c, jit_bool_t s,
+	 jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    if (s)		addr(r0, r0, r1);
+    else		addcr(r0, r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    w = _jit->pc.w;
+    BRCL(c, d);
+    return (w);
+}
+
+static jit_word_t
+_baddi_p(jit_state_t *_jit, int32_t c, jit_bool_t s,
+	 jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = baddr_p(c, s, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_bsubr(jit_state_t *_jit, int32_t c, jit_bool_t s,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    if (s)		subr(r0, r0, r1);
+    else		subcr(r0, r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(c, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(c, d);
+    }
+}
+
+static void
+_bsubi(jit_state_t *_jit, int32_t c, jit_bool_t s,
+       jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    bsubr(c, s, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static jit_word_t
+_bsubr_p(jit_state_t *_jit, int32_t c, jit_bool_t s,
+	 jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d, w;
+    if (s)		subr(r0, r0, r1);
+    else		subcr(r0, r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    w = _jit->pc.w;
+    BRCL(c, d);
+    return (w);
+}
+
+static jit_word_t
+_bsubi_p(jit_state_t *_jit, int32_t c, jit_bool_t s,
+	 jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi(rn(reg), i1);
+    w = bsubr_p(c, s, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_bmxr(jit_state_t *_jit, int32_t cc,
+      jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movr(rn(reg), r0);
+    andr(rn(reg), rn(reg), r1);
+    TEST_(rn(reg), rn(reg));
+    jit_unget_reg(reg);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static jit_word_t
+_bmxr_p(jit_state_t *_jit, int32_t cc,
+	jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movr(rn(reg), r0);
+    andr(rn(reg), rn(reg), r1);
+    TEST_(rn(reg), rn(reg));
+    jit_unget_reg(reg);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static void
+_bmxi(jit_state_t *_jit, int32_t cc,
+      jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		d;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i1);
+    andr(rn(reg), rn(reg), r0);
+    TEST_(rn(reg), rn(reg));
+    jit_unget_reg(reg);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static jit_word_t
+_bmxi_p(jit_state_t *_jit, int32_t cc,
+	jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i1);
+    andr(rn(reg), rn(reg), r0);
+    TEST_(rn(reg), rn(reg));
+    jit_unget_reg(reg);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static void
+_movr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+#if __WORDSIZE == 32
+    if (r0 != r1)
+	LR(r0, r1);
+#else
+    if (r0 != r1)
+	LGR(r0, r1);
+#endif
+}
+
+static void
+_movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_word_t		d;
+#if __WORDSIZE == 64
+    int32_t		bits;
+#endif
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(i0)) {
+#if __WORDSIZE == 32
+	LHI(r0, x16(i0));
+#else
+	LGHI(r0, x16(i0));
+#endif
+    }
+    /* easy way of loading a large amount of 32 bit values and
+     * usually address of constants */
+    else if (!(i0 & 1) &&
+#if __WORDSIZE == 32
+	     i0 > 0
+#else
+	     s32_p(d)
+#endif
+	     )
+	LARL(r0, d);
+    else {
+#if __WORDSIZE == 32
+	LHI(r0, x16(i0));
+	IILH(r0, x16((jit_uword_t)i0 >> 16));
+#else
+	bits = 0;
+	if (i0 &             0xffffL)	bits |= 1;
+	if (i0 &         0xffff0000L)	bits |= 2;
+	if (i0 &     0xffff00000000L)	bits |= 4;
+	if (i0 & 0xffff000000000000L)	bits |= 8;
+	if (bits != 15)			LGHI(r0, 0);
+	if (bits & 1)			IILL(r0, x16(i0));
+	if (bits & 2)			IILH(r0, x16((jit_uword_t)i0 >> 16));
+	if (bits & 4)			IIHL(r0, x16((jit_uword_t)i0 >> 32));
+	if (bits & 8)			IIHH(r0, x16((jit_uword_t)i0 >> 48));
+#endif
+    }
+}
+
+static jit_word_t
+_movi_p(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    jit_word_t		w;
+    w = _jit->pc.w;
+#if __WORDSIZE == 32
+    LHI(r0, x16(i0));
+#else
+    IILL(r0, x16(i0));
+#endif
+    IILH(r0, x16((jit_uword_t)i0 >> 16));
+#if __WORDSIZE == 64
+    IIHL(r0, x16((jit_uword_t)i0 >> 32));
+    IIHH(r0, x16((jit_uword_t)i0 >> 48));
+#endif
+    return (w);
+}
+
+static void
+_addr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	ADD_(r0, r1);
+    else {
+	movr(r0, r1);
+	ADD_(r0, r2);
+    }
+}
+
+static void
+_addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (r0 == r1 && s16_p(i0))
+	ADDI_(r0, x16(i0));
+#if __WORDSIZE == 64
+    else if (s20_p(i0))
+	LAY(r0, x20(i0), 0, r1);
+#endif
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	addr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_addcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	ADDC_(r0, r1);
+    else {
+	movr(r0, r1);
+	ADDC_(r0, r2);
+    }
+}
+
+static void
+_addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    addcr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_addxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	ADDX_(r0, r1);
+    else {
+	movr(r0, r1);
+	ADDX_(r0, r2);
+    }
+}
+
+static void
+_addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    addxr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_subr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SUB_(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr(r0, r1);
+	SUB_(r0, r2);
+    }
+}
+
+static void
+_subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (r0 == r1 && s16_p(-i0))
+	ADDI_(r0, x16(-i0));
+#if __WORDSIZE == 64
+    else if (s20_p(-i0))
+	LAY(r0, x20(-i0), 0, r1);
+#endif
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	subr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_subcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SUBC_(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr(r0, r1);
+	SUBC_(r0, r2);
+    }
+}
+
+static void
+_subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    subcr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_subxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_gpr);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SUBX_(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr(r0, r1);
+	SUBX_(r0, r2);
+    }
+}
+
+static void
+_subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    subxr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_rsbi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    subi(r0, r1, i0);
+    negr(r0, r0);
+}
+
+static void
+_mulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	MUL_(r0, r1);
+    else {
+	movr(r0, r1);
+	MUL_(r0, r2);
+    }
+}
+
+static void
+_muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s16_p(i0)) {
+	movr(r0, r1);
+	MULI_(r0, x16(i0));
+    }
+    else {
+	reg = jit_get_reg(jit_class_gpr);
+	movi(rn(reg), i0);
+	mulr(r0, r1, rn(reg));
+	jit_unget_reg(reg);
+    }
+}
+
+static void
+_qmulr(jit_state_t *_jit,
+       int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+    int32_t		reg;
+    /* The only invalid condition is r0 == r1 */
+    int32_t		t2, t3, s2, s3;
+    if (r2 == r0 || r2 == r1) {
+	s2 = jit_get_reg(jit_class_gpr);
+	t2 = rn(s2);
+	movr(t2, r2);
+    }
+    else
+	t2 = r2;
+    if (r3 == r0 || r3 == r1) {
+	s3 = jit_get_reg(jit_class_gpr);
+	t3 = rn(s3);
+	movr(t3, r3);
+    }
+    else
+	t3 = r3;
+    qmulr_u(r0, r1, r2, r3);
+    reg = jit_get_reg(jit_class_gpr);
+    /**/
+    rshi(rn(reg), t2, 63);
+    mulr(rn(reg), rn(reg), t3);
+    addr(r1, r1, rn(reg));
+    /**/
+    rshi(rn(reg), t3, 63);
+    mulr(rn(reg), rn(reg), t2);
+    addr(r1, r1, rn(reg));
+    jit_unget_reg(reg);
+    if (t2 != r2)
+	jit_unget_reg(s2);
+    if (t3 != r3)
+	jit_unget_reg(s3);
+}
+
+static void
+_qmuli(jit_state_t *_jit,
+       int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    qmulr(r0, r1, r2, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_qmulr_u(jit_state_t *_jit,
+	 int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+    int32_t		regno;
+    regno = jit_get_reg_pair();
+    movr(rn(regno) + 1, r2);
+    MULU_(rn(regno), r3);
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+    jit_unget_reg_pair(regno);
+}
+
+static void
+_qmuli_u(jit_state_t *_jit,
+	 int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = jit_get_reg_pair();
+    movr(rn(regno) + 1, r2);
+    movi(rn(regno), i0);
+    MULU_(rn(regno), rn(regno));
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+    jit_unget_reg_pair(regno);
+}
+
+static void
+_divr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		regno;
+    regno = xdivr(r1, r2);
+    movr(r0, rn(regno) + 1);
+}
+
+static void
+_divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi(r1, i0);
+    movr(r0, rn(regno) + 1);
+}
+
+static void
+_divr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		regno;
+    regno = xdivr_u(r1, r2);
+    movr(r0, rn(regno) + 1);
+}
+
+static void
+_divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi_u(r1, i0);
+    movr(r0, rn(regno) + 1);
+}
+
+static void
+_remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		regno;
+    regno = xdivr(r1, r2);
+    movr(r0, rn(regno));
+}
+
+static void
+_remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi(r1, i0);
+    movr(r0, rn(regno));
+}
+
+static void
+_remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		regno;
+    regno = xdivr_u(r1, r2);
+    movr(r0, rn(regno));
+}
+
+static void
+_remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi_u(r1, i0);
+    movr(r0, rn(regno));
+}
+
+static void
+_qdivr(jit_state_t *_jit,
+       int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+    int32_t		regno;
+    regno = xdivr(r2, r3);
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+}
+
+static void
+_qdivi(jit_state_t *_jit,
+       int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi(r2, i0);
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+}
+
+static void
+_qdivr_u(jit_state_t *_jit,
+	 int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+    int32_t		regno;
+    regno = xdivr_u(r2, r3);
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+}
+
+static void
+_qdivi_u(jit_state_t *_jit,
+	 int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+    int32_t		regno;
+    regno = xdivi_u(r2, i0);
+    movr(r0, rn(regno) + 1);
+    movr(r1, rn(regno));
+}
+
+#  if __WORDSIZE == 32
+static void
+_lshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg_but_zero(0);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SLL(r0, 0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+    else {
+	movr(r0, r1);
+	SLL(r0, 0, r2);
+    }
+}
+#endif
+
+static void
+_lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    lshr(r0, r1, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+#  if __WORDSIZE == 32
+static void
+_rshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg_but_zero(0);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SRA(r0, 0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+    else {
+	movr(r0, r1);
+	SRA(r0, 0, r2);
+    }
+}
+#endif
+
+static void
+_rshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    rshr(r0, r1, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+#  if __WORDSIZE == 32
+static void
+_rshr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg_but_zero(0);
+	movr(rn(reg), r2);
+	movr(r0, r1);
+	SRL(r0, 0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+    else {
+	movr(r0, r1);
+	SRL(r0, 0, r2);
+    }
+}
+#endif
+
+static void
+_rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    rshr_u(r0, r1, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_comr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), -1);
+    movr(r0, r1);
+    XOR_(r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_andr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	AND_(r0, r1);
+    else {
+	movr(r0, r1);
+	AND_(r0, r2);
+    }
+}
+
+static void
+_andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    movr(r0, r1);
+    NILL(r0, x16(i0));
+    NILH(r0, x16((jit_uword_t)i0 >> 16));
+#if __WORDSIZE == 64
+    NIHL(r0, x16((jit_uword_t)i0 >> 32));
+    NIHH(r0, x16((jit_uword_t)i0 >> 48));
+#endif
+}
+
+static void
+_orr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	OR_(r0, r1);
+    else {
+	movr(r0, r1);
+	OR_(r0, r2);
+    }
+}
+
+static void
+_ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    movr(r0, r1);
+    OILL(r0, x16(i0));
+    OILH(r0, x16((jit_uword_t)i0 >> 16));
+#if __WORDSIZE == 64
+    OIHL(r0, x16((jit_uword_t)i0 >> 32));
+    OIHH(r0, x16((jit_uword_t)i0 >> 48));
+#endif
+}
+
+static void
+_xorr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	XOR_(r0, r1);
+    else {
+	movr(r0, r1);
+	XOR_(r0, r2);
+    }
+}
+
+static void
+_xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    movi(rn(reg), i0);
+    xorr(r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_c(r0, r0);
+}
+
+static void
+_ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_c(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_c(r0, r0);
+    }
+}
+
+static void
+_ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0)) {
+#if __WORDSIZE == 32
+	LB(r0, x20(i0), 0, r1);
+#else
+	LGB(r0, x20(i0), 0, r1);
+#endif
+    }
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_c(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_c(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_uc(r0, r0);
+}
+
+static void
+_ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_uc(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_uc(r0, r0);
+    }
+}
+
+static void
+_ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	LLGC(r0, x20(i0), 0, r1);
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_uc(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_uc(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_s(r0, r0);
+}
+
+static void
+_ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_s(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_s(r0, r0);
+    }
+}
+
+static void
+_ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+#if __WORDSIZE == 32
+    if (u12_p(i0))
+	LH(r0, i0, 0, r1);
+    else
+#endif
+    if (s20_p(i0)) {
+#if __WORDSIZE == 32
+	LHY(r0, x20(i0), 0, r1);
+#else
+	LGH(r0, x20(i0), 0, r1);
+#endif
+    }
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_s(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_s(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_us(r0, r0);
+}
+
+static void
+_ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_us(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_us(r0, r0);
+    }
+}
+
+static void
+_ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	LLGH(r0, x20(i0), 0, r1);
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_us(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_us(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_i(r0, r0);
+}
+
+static void
+_ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_i(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_i(r0, r0);
+    }
+}
+
+static void
+_ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	LGF(r0, x20(i0), 0, r1);
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_i(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_i(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_ldi_ui(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_ui(r0, r0);
+}
+
+static void
+_ldxr_ui(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_ui(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_ui(r0, r0);
+    }
+}
+
+static void
+_ldxi_ui(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	LLGF(r0, x20(i0), 0, r1);
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_ui(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_ui(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldi_l(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    movi(r0, i0);
+    ldr_l(r0, r0);
+}
+
+static void
+_ldxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2) {
+	addr(r0, r0, r1);
+	ldr_l(r0, r0);
+    }
+    else {
+	movr(r0, r1);
+	addr(r0, r0, r2);
+	ldr_l(r0, r0);
+    }
+}
+
+static void
+_ldxi_l(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	LG(r0, x20(i0), 0, r1);
+    else if (r0 != r1) {
+	movi(r0, i0);
+	addr(r0, r0, r1);
+	ldr_l(r0, r0);
+    }
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_l(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+#endif
+
+static void
+_sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_c(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_c(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	STC(r1, i0, 0, r0);
+    else if (s20_p(i0))
+	STCY(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	addi(rn(reg), r0, i0);
+	str_c(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_s(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_s(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	STH(r1, i0, 0, r0);
+    else if (s20_p(i0))
+	STHY(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	addi(rn(reg), r0, i0);
+	str_s(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_i(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_i(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	ST(r1, i0, 0, r0);
+    else if (s20_p(i0))
+	STY(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	addi(rn(reg), r0, i0);
+	str_i(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+#if __WORDSIZE == 64
+static void
+_sti_l(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_l(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_l(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxi_l(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (s20_p(i0))
+	STG(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	addi(rn(reg), r0, i0);
+	str_l(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+#endif
+
+static void
+_jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		d;
+    int32_t		reg;
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	J(x16(d));
+    else if (s32_p(d))
+	BRL(d);
+    else {
+	reg = jit_get_reg_but_zero(jit_class_nospill);
+	movi(rn(reg), i0);
+	jmpr(rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static jit_word_t
+_jmpi_p(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(jit_class_nospill);
+    w = movi_p(rn(reg), i0);
+    jmpr(rn(reg));
+    jit_unget_reg_but_zero(reg);
+    return (w);
+}
+
+static void
+_calli(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		d;
+    int32_t		reg;
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s32_p(d))
+	BRASL(_R14_REGNO, d);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	callr(rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static jit_word_t
+_calli_p(jit_state_t *_jit, jit_word_t i0)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    w = movi_p(rn(reg), i0);
+    callr(rn(reg));
+    jit_unget_reg_but_zero(reg);
+    return (w);
+}
+
+static int32_t	gprs[] = {
+    _R2, _R3, _R4, _R5,
+    _R6, _R7, _R8, _R9, _R10, _R11, _R12, _R13
+};
+
+static void
+_prolog(jit_state_t *_jit, jit_node_t *i0)
+{
+    int32_t		regno, offset;
+    if (_jitc->function->define_frame || _jitc->function->assume_frame) {
+	int32_t	frame = -_jitc->function->frame;
+	assert(_jitc->function->self.aoff >= frame);
+	if (_jitc->function->assume_frame)
+	    return;
+	_jitc->function->self.aoff = frame;
+    }
+    if (_jitc->function->allocar)
+	_jitc->function->self.aoff &= -8;
+    _jitc->function->stack = ((_jitc->function->self.alen -
+			      /* align stack at 8 bytes */
+			      _jitc->function->self.aoff) + 7) & -8;
+    /* *IFF* a non variadic function,
+     * Lightning does not reserve stack space for spilling arguments
+     * in registers.
+     * S390x, as per gcc, has 8 stack slots for spilling arguments,
+     * (%r6 is callee save) and uses an alloca like approach to save
+     * callee save fpr registers.
+     * Since argument registers are not saved in any lightning port,
+     * use the 8 slots to spill any modified fpr register, and still
+     * use the same stack frame logic as gcc.
+     * Save at least %r13 to %r15, as %r13 is used as frame pointer.
+     * *IFF* a variadic function, a "standard" stack frame, with
+     * fpr registers saved in an alloca'ed area, is used.
+     */
+    if ((_jitc->function->self.call & jit_call_varargs) &&
+	jit_arg_reg_p(_jitc->function->vagp))
+	regno = _jitc->function->vagp;
+    else {
+	for (regno = 4; regno < jit_size(gprs) - 1; regno++) {
+	    if (jit_regset_tstbit(&_jitc->function->regset, gprs[regno]))
+		break;
+	}
+    }
+#if __WORDSIZE == 32
+#  define FP_OFFSET		64
+    if (_jitc->function->self.call & jit_call_varargs)
+	offset = regno * 4 + 8;
+    else
+	offset = (regno - 4) * 4 + 32;
+    STM(rn(gprs[regno]), _R15_REGNO, x20(offset), _R15_REGNO);
+#else
+#  define FP_OFFSET		128
+    if (_jitc->function->self.call & jit_call_varargs)
+	offset = regno * 8 + 16;
+    else
+	offset = (regno - 4) * 8 + 48;
+    STMG(rn(gprs[regno]), _R15_REGNO, x20(offset), _R15_REGNO);
+#endif
+
+#define SPILL(R, O)							\
+    do {								\
+	if (jit_regset_tstbit(&_jitc->function->regset, R))		\
+	    stxi_d(O, _R15_REGNO, rn(R));				\
+    } while (0)
+    if (_jitc->function->self.call & jit_call_varargs) {
+	for (regno = _jitc->function->vafp; jit_arg_f_reg_p(regno); ++regno)
+	    stxi_d(FP_OFFSET + regno * 8, _R15_REGNO, rn(_F0 - regno));
+	SPILL(_F8, _jitc->function->vaoff + offsetof(jit_va_list_t, f8));
+	SPILL(_F9, _jitc->function->vaoff + offsetof(jit_va_list_t, f9));
+	SPILL(_F10, _jitc->function->vaoff + offsetof(jit_va_list_t, f10));
+	SPILL(_F11, _jitc->function->vaoff + offsetof(jit_va_list_t, f11));
+	SPILL(_F12, _jitc->function->vaoff + offsetof(jit_va_list_t, f12));
+	SPILL(_F13, _jitc->function->vaoff + offsetof(jit_va_list_t, f13));
+	SPILL(_F14, _jitc->function->vaoff + offsetof(jit_va_list_t, f14));
+    }
+    else {
+	/* First 4 in low address */
+#if __WORDSIZE == 32
+	SPILL(_F10, 0);
+	SPILL(_F11, 8);
+	SPILL(_F12, 16);
+	SPILL(_F13, 24);
+	/* gpr registers here */
+	SPILL(_F14, 72);
+	SPILL(_F8, 80);
+	SPILL(_F9, 88);
+#else
+	SPILL(_F10, 16);
+	SPILL(_F11, 24);
+	SPILL(_F12, 32);
+	SPILL(_F13, 48);
+	/* Last 3 in high address */
+	SPILL(_F14, 136);
+	SPILL(_F8, 144);
+	SPILL(_F9, 152);
+#endif
+    }
+#undef SPILL
+    movr(_R13_REGNO, _R15_REGNO);
+    subi(_R15_REGNO, _R15_REGNO, stack_framesize + _jitc->function->stack);
+    if (_jitc->function->allocar) {
+	regno = jit_get_reg(jit_class_gpr);
+	movi(rn(regno), _jitc->function->self.aoff);
+	stxi_i(_jitc->function->aoffoff, _R13_REGNO, rn(regno));
+	jit_unget_reg(regno);
+    }
+}
+
+static void
+_epilog(jit_state_t *_jit, jit_node_t *i0)
+{
+    int32_t		regno, offset;
+    if (_jitc->function->assume_frame)
+	return;
+    if ((_jitc->function->self.call & jit_call_varargs) &&
+	jit_arg_reg_p(_jitc->function->vagp))
+	regno = _jitc->function->vagp;
+    else {
+	for (regno = 4; regno < jit_size(gprs) - 1; regno++) {
+	    if (jit_regset_tstbit(&_jitc->function->regset, gprs[regno]))
+		break;
+	}
+    }
+#if __WORDSIZE == 32
+    if (_jitc->function->self.call & jit_call_varargs)
+	offset = regno * 4 + 8;
+    else
+	offset = (regno - 4) * 4 + 32;
+#else
+    if (_jitc->function->self.call & jit_call_varargs)
+	offset = regno * 8 + 16;
+    else
+	offset = (regno - 4) * 8 + 48;
+#endif
+    movr(_R15_REGNO, _R13_REGNO);
+
+#define LOAD(R, O)							\
+    do {								\
+	if (jit_regset_tstbit(&_jitc->function->regset, R))		\
+	    ldxi_d(rn(R), _R15_REGNO, O);				\
+    } while (0)
+    if (_jitc->function->self.call & jit_call_varargs) {
+	LOAD(_F8, _jitc->function->vaoff + offsetof(jit_va_list_t, f8));
+	LOAD(_F9, _jitc->function->vaoff + offsetof(jit_va_list_t, f9));
+	LOAD(_F10, _jitc->function->vaoff + offsetof(jit_va_list_t, f10));
+	LOAD(_F11, _jitc->function->vaoff + offsetof(jit_va_list_t, f11));
+	LOAD(_F12, _jitc->function->vaoff + offsetof(jit_va_list_t, f12));
+	LOAD(_F13, _jitc->function->vaoff + offsetof(jit_va_list_t, f13));
+	LOAD(_F14, _jitc->function->vaoff + offsetof(jit_va_list_t, f14));
+    }
+    else {
+#if __WORDSIZE == 32
+	LOAD(_F10, 0);
+	LOAD(_F11, 8);
+	LOAD(_F12, 16);
+	LOAD(_F13, 24);
+	LOAD(_F14, 72);
+	LOAD(_F8, 80);
+	LOAD(_F9, 88);
+#else
+	LOAD(_F10, 16);
+	LOAD(_F11, 24);
+	LOAD(_F12, 32);
+	LOAD(_F13, 48);
+	LOAD(_F14, 136);
+	LOAD(_F8, 144);
+	LOAD(_F9, 152);
+#endif
+    }
+#undef LOAD
+#if __WORDSIZE == 32
+    LM(rn(gprs[regno]), _R15_REGNO, x20(offset), _R15_REGNO);
+#else
+    LMG(rn(gprs[regno]), _R15_REGNO, x20(offset), _R15_REGNO);
+#endif
+    BR(_R14_REGNO);
+}
+
+static void
+_vastart(jit_state_t *_jit, int32_t r0)
+{
+    int32_t		reg;
+
+    assert(_jitc->function->self.call & jit_call_varargs);
+
+    /* Return jit_va_list_t in the register argument */
+    addi(r0, _R13_REGNO, _jitc->function->vaoff);
+    reg = jit_get_reg(jit_class_gpr);
+
+    /* Initialize gp offset in the save area. */
+    movi(rn(reg), _jitc->function->vagp);
+    stxi(offsetof(jit_va_list_t, gpoff), r0, rn(reg));
+
+    /* Initialize fp offset in the save area. */
+    movi(rn(reg), _jitc->function->vafp);
+    stxi(offsetof(jit_va_list_t, fpoff), r0, rn(reg));
+
+    /* Initialize overflow pointer to the first stack argument. */
+    addi(rn(reg), _R13_REGNO, _jitc->function->self.size);
+    stxi(offsetof(jit_va_list_t, over), r0, rn(reg));
+
+    /* Initialize register save area pointer. */
+    stxi(offsetof(jit_va_list_t, save), r0, _R13_REGNO);
+
+    jit_unget_reg(reg);
+}
+
+static void
+_vaarg(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		rg0;
+    int32_t		rg1;
+    int32_t		rg2;
+    jit_word_t		ge_code;
+    jit_word_t		lt_code;
+
+    assert(_jitc->function->self.call & jit_call_varargs);
+
+    rg0 = jit_get_reg_but_zero(0);
+    rg1 = jit_get_reg_but_zero(0);
+
+    /* Load the gp offset in save area in the first temporary. */
+    ldxi(rn(rg0), r1, offsetof(jit_va_list_t, gpoff));
+
+    /* Jump over if there are no remaining arguments in the save area. */
+    ge_code = bgei_p(_jit->pc.w, rn(rg0), 5);
+
+    /* Load the save area pointer in the second temporary. */
+    ldxi(rn(rg1), r1, offsetof(jit_va_list_t, save));
+
+    /* Scale offset */
+    rg2 = jit_get_reg_but_zero(0);
+    lshi(rn(rg2), rn(rg0),
+#if __WORDSIZE == 32
+	 2
+#else
+	 3
+#endif
+	 );
+    /* Add offset to saved area. */
+    addi(rn(rg2), rn(rg2), 2 * sizeof(jit_word_t));
+
+    /* Load the vararg argument in the first argument. */
+    ldxr(r0, rn(rg1), rn(rg2));
+    jit_unget_reg_but_zero(rg2);
+
+    /* Update the gp offset. */
+    addi(rn(rg0), rn(rg0), 1);
+    stxi(offsetof(jit_va_list_t, gpoff), r1, rn(rg0));
+
+    /* Will only need one temporary register below. */
+    jit_unget_reg_but_zero(rg1);
+
+    /* Jump over overflow code. */
+    lt_code = jmpi_p(_jit->pc.w);
+
+    /* Where to land if argument is in overflow area. */
+    patch_at(ge_code, _jit->pc.w);
+
+    /* Load overflow pointer. */
+    ldxi(rn(rg0), r1, offsetof(jit_va_list_t, over));
+
+    /* Load argument. */
+    ldr(r0, rn(rg0));
+
+    /* Update overflow pointer. */
+    addi(rn(rg0), rn(rg0), sizeof(jit_word_t));
+    stxi(offsetof(jit_va_list_t, over), r1, rn(rg0));
+
+    /* Where to land if argument is in save area. */
+    patch_at(lt_code, _jit->pc.w);
+
+    jit_unget_reg_but_zero(rg0);
+}
+
+static void
+_patch_at(jit_state_t *_jit, jit_word_t instr, jit_word_t label)
+{
+    jit_word_t			 d;
+    union {
+	uint16_t		*s;
+	jit_word_t		 w;
+    } u;
+    u.w = instr;
+    union {
+	struct {
+	    uint16_t	op :  8;
+	    uint16_t	r1 :  4;
+	    uint16_t	r3 :  4;
+	} b;
+	uint16_t		s;
+    } i0;
+    union {
+	struct {
+	    uint16_t	i2;
+	} b;
+	uint16_t		s;
+    } i1;
+    union {
+	struct {
+	    uint32_t	ih : 16;
+	    uint32_t	il : 16;
+	} b;
+	uint32_t		i;
+    } i12;
+    i0.s = u.s[0];
+    /* movi_p */
+    if (i0.b.op ==
+#if __WORDSIZE == 32
+	0xA7 && i0.b.r3 == 8
+#else
+	0xA5
+#endif
+	) {
+#if __WORDSIZE == 64
+	assert(i0.b.r3 == 3);
+#endif
+	i1.b.i2 = (jit_uword_t)label;
+	u.s[1] = i1.s;
+	i0.s = u.s[2];
+	assert(i0.b.op == 0xA5 && i0.b.r3 == 2);
+	i1.b.i2 = (jit_uword_t)label >> 16;
+	u.s[3] = i1.s;
+#if __WORDSIZE == 64
+	i0.s = u.s[4];
+	assert(i0.b.op == 0xA5 && i0.b.r3 == 1);
+	i1.b.i2 = (jit_uword_t)label >> 32;
+	u.s[5] = i1.s;
+	i0.s = u.s[6];
+	assert(i0.b.op == 0xA5 && i0.b.r3 == 0);
+	i1.b.i2 = (jit_uword_t)label >> 48;
+	u.s[7] = i1.s;
+#endif
+    }
+    /* BRC */
+    else if (i0.b.op == 0xA7) {
+	assert(i0.b.r3 == 0x4);
+	d = (label - instr) >> 1;
+	assert(s16_p(d));
+	i1.b.i2 = d;
+	u.s[1] = i1.s;
+    }
+    /* BRCL */
+    else if (i0.b.op == 0xC0) {
+	assert(i0.b.r3 == 0x4);
+	d = (label - instr) >> 1;
+	assert(s32_p(d));
+	i12.i = d;
+	u.s[1] = i12.b.ih;
+	u.s[2] = i12.b.il;
+    }
+    else
+	abort();
+}
+#endif
diff --git a/libguile/lightening/lightening/s390-fpu.c b/libguile/lightening/lightening/s390-fpu.c
new file mode 100644
index 000000000..386664369
--- /dev/null
+++ b/libguile/lightening/lightening/s390-fpu.c
@@ -0,0 +1,1316 @@
+/*
+ * Copyright (C) 2013-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#if PROTO
+#  define RND_CUR			0
+#  define RND_BIAS_NEAR			1
+#  define RND_NEAR			4
+#  define RND_ZERO			5
+#  define RND_POS_INF			6
+#  define RND_NEG_INF			7
+/****************************************************************
+ * Floating Point Instructions					*
+ ****************************************************************/
+/* CONVERT BFP TO HFP */
+#  define THDER(R1,R2)			RRE_(0xB358,R1,R2)
+#  define THDR(R1,R2)			RRE_(0xB359,R1,R2)
+/* CONVERT HFP TO BFP */
+#  define TBEDR(R1,R2)			RRE_(0xB350,R1,R2)
+#  define TBDR(R1,R2)			RRE_(0xB351,R1,R2)
+/* LOAD */
+#  define LER(R1,R2)			RR_(0x38,R1,R2)
+#  define LDR(R1,R2)			RR_(0x28,R1,R2)
+#  define LXR(R1,R2)			RRE_(0xB365,R1,R2)
+#  define LE(R1,D2,X2,B2)		RX_(0x78,R1,X2,B2,D2)
+#  define LD(R1,D2,X2,B2)		RX_(0x68,R1,X2,B2,D2)
+#  define LEY(R1,D2,X2,B2)		RXY_(0xED,R1,X2,B2,D2,0x64)
+#  define LDY(R1,D2,X2,B2)		RXY_(0xED,R1,X2,B2,D2,0x65)
+/* LOAD ZERO */
+#  define LZER(R1)			RRE_(0xB374,R1,0)
+#  define LZDR(R1)			RRE_(0xB375,R1,0)
+#  define LZXR(R1)			RRE_(0xB376,R1,0)
+/* STORE */
+#  define STE(R1,D2,X2,B2)		RX_(0x70,R1,X2,B2,D2)
+#  define STD(R1,D2,X2,B2)		RX_(0x60,R1,X2,B2,D2)
+#  define STEY(R1,D2,X2,B2)		RXY_(0xED,R1,X2,B2,D2,0x66)
+#  define STDY(R1,D2,X2,B2)		RXY_(0xED,R1,X2,B2,D2,0x67)
+/****************************************************************
+ * Hexadecimal Floating Point Instructions			*
+ ****************************************************************/
+/* ADD NORMALIZED */
+#  define AER(R1,R2)			RR_(0x3A,R1,R2)
+#  define ADR(R1,R2)			RR_(0x2A,R1,R2)
+#  define AXR(R1,R2)			RR_(0x36,R1,R2)
+#  define AE(R1,D2,X2,B2)		RX_(0x7A,R1,X2,B2,D2)
+#  define AD(R1,D2,X2,B2)		RX_(0x6A,R1,X2,B2,D2)
+/* ADD UNNORMALIZED */
+#  define AUR(R1,R2)			RR_(0x3E,R1,R2)
+#  define AWR(R1,R2)			RR_(0x2E,R1,R2)
+#  define AU(R1,D2,X2,B2)		RX_(0x7E,R1,X2,B2,D2)
+#  define AW(R1,D2,X2,B2)		RX_(0x6E,R1,X2,B2,D2)
+/* COMPARE */
+#  define CER(R1,R2)			RR_(0x39,R1,R2)
+#  define CDR(R1,R2)			RR_(0x29,R1,R2)
+#  define CXR(R1,R2)			RRE_(0xB369,R1,R2)
+#  define CE(R1,D2,X2,B2)		RX_(0x79,R1,X2,B2,D2)
+#  define CD(R1,D2,X2,B2)		RX_(0x69,R1,X2,B2,D2)
+/* CONVERT FROM FIXED */
+#  define CEFR(R1,R2)			RRE_(0xB3B4,R1,R2)
+#  define CDFR(R1,R2)			RRE_(0xB3B5,R1,R2)
+#  define CXFR(R1,R2)			RRE_(0xB3B6,R1,R2)
+#  define CEGR(R1,R2)			RRE_(0xB3C4,R1,R2)
+#  define CDGR(R1,R2)			RRE_(0xB3C5,R1,R2)
+#  define CXGR(R1,R2)			RRE_(0xB3C6,R1,R2)
+/* CONVERT TO FIXED */
+#  define CFER(R1,R2)			RRE_(0xB3B8,R1,R2)
+#  define CFDR(R1,R2)			RRE_(0xB3B9,R1,R2)
+#  define CFXR(R1,R2)			RRE_(0xB3BA,R1,R2)
+#  define CGER(R1,R2)			RRE_(0xB3C8,R1,R2)
+#  define CGDR(R1,R2)			RRE_(0xB3C9,R1,R2)
+#  define CGXR(R1,R2)			RRE_(0xB3CA,R1,R2)
+/* DIVIDE */
+#  define DER(R1,R2)			RR_(0x3D,R1,R2)
+#  define DDR(R1,R2)			RR_(0x2D,R1,R2)
+#  define DXR(R1,R2)			RRE_(0xB22D,R1,R2)
+#  define DE(R1,D2,X2,B2)		RX_(0x7D,R1,X2,B2,D2)
+#  define DD(R1,D2,X2,B2)		RX_(0x6D,R1,X2,B2,D2)
+/* HALVE */
+#  define HER(R1,R2)			RR_(0x34,R1,R2)
+#  define HDR(R1,R2)			RR_(0x24,R1,R2)
+/* LOAD AND TEST */
+#  define LTER(R1,R2)			RR_(0x32,R1,R2)
+#  define LTDR(R1,R2)			RR_(0x22,R1,R2)
+#  define LTXR(R1,R2)			RRE_(0xB362,R1,R2)
+/* LOAD COMPLEMENT */
+#  define LCER(R1,R2)			RR_(0x33,R1,R2)
+#  define LCDR(R1,R2)			RR_(0x23,R1,R2)
+#  define LCXR(R1,R2)			RRE_(0xB363,R1,R2)
+/* LOAD FP INTEGER */
+#  define FIER(R1,R2)			RRE_(0xB377,R1,R2)
+#  define FIDR(R1,R2)			RRE_(0xB37F,R1,R2)
+#  define FIXR(R1,R2)			RRE_(0xB367,R1,R2)
+/* LOAD LENGHTENED */
+#  define LDER(R1,R2)			RRE_(0xB324,R1,R2)
+#  define LXDR(R1,R2)			RRE_(0xB325,R1,R2)
+#  define LXER(R1,R2)			RRE_(0xB326,R1,R2)
+#  define LDE(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x24)
+#  define LXD(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x25)
+#  define LXE(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x26)
+/* LOAD NEGATIVE */
+#  define LNER(R1,R2)			RR_(0x31,R1,R2)
+#  define LNDR(R1,R2)			RR_(0x21,R1,R2)
+#  define LNXR(R1,R2)			RRE_(0xB361,R1,R2)
+/* LOAD POSITIVE */
+#  define LPER(R1,R2)			RR_(0x30,R1,R2)
+#  define LPDR(R1,R2)			RR_(0x20,R1,R2)
+#  define LPXR(R1,R2)			RRE_(0xB360,R1,R2)
+/* LOAD ROUNDED */
+#  define LEDR(R1,R2)			RR_(0x35,R1,R2)
+#  define LDXR(R1,R2)			RR_(0x25,R1,R2)
+#  define LRER(R1,R2)			LEDR(R1,R2)
+#  define LRDR(R1,R2)			LDXR(R1,R2)
+#  define LRXR(R1,R2)			RRE_(0xB366,R1,R2)
+/* MULTIPLY */
+#  define MEER(R1,R2)			RRE_(0xB337,R1,R2)
+#  define MDR(R1,R2)			RR_(0x2C,R1,R2)
+#  define MXR(R1,R2)			RR_(0x26,R1,R2)
+#  define MDER(R1,R2)			RR_(0x3C,R1,R2)
+#  define MXDR(R1,R2)			RR_(0x27,R1,R2)
+#  define MER(R1,R2)			MDER(R1,R2)
+#  define MEE(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x37)
+#  define MD(R1,D2,X2,B2)		RX_(0x6C,R1,X2,B2,D2)
+#  define MDE(R1,D2,X2,B2)		RX_(0x7C,R1,X2,B2,D2)
+#  define MXD(R1,D2,X2,B2)		RX_(0x67,R1,X2,B2,D2)
+#  define ME(R1,D2,X2,B2)		MDE(R1,D2,X2,B2)
+/* MULTIPLY AND ADD */
+#  define MAER(R1,R3,R2)		RRF_(0xB32E,R1,0,R3,R2)
+#  define MADR(R1,R3,R2)		RRF_(0xB33E,R1,0,R3,R2)
+#  define MAE(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x2E)
+#  define MAD(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x3E)
+/* MULTIPLY AND SUBTRACT */
+#  define MSER(R1,R3,R2)		RRF_(0xB32F,R1,0,R3,R2)
+#  define MSDR(R1,R3,R2)		RRF_(0xB33F,R1,0,R3,R2)
+#  define MSE(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x2F)
+#  define MSD(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x3F)
+/* SQUARE ROOT */
+#  define SQER(R1,R2)			RRE_(0xB245,R1,R2)
+#  define SQDR(R1,R2)			RRE_(0xB244,R1,R2)
+#  define SQXR(R1,R2)			RRE_(0xB336,R1,R2)
+#  define SQE(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x34)
+#  define SQD(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x35)
+/* SUBTRACT NORMALIZED */
+#  define SER(R1,R2)			RR_(0x3B,R1,R2)
+#  define SDR(R1,R2)			RR_(0x2B,R1,R2)
+#  define SXR(R1,R2)			RR_(0x37,R1,R2)
+#  define SE(R1,D2,X2,B2)		RX_(0x7B,R1,X2,B2,D2)
+#  define SD(R1,D2,X2,B2)		RX_(0x6B,R1,X2,B2,D2)
+/* SUBTRACT UNNORMALIZED */
+#  define SUR(R1,R2)			RR_(0x3F,R1,R2)
+#  define SWR(R1,R2)			RR_(0x2F,R1,R2)
+#  define SU(R1,D2,X2,B2)		RX_(0x7F,R1,X2,B2,D2)
+#  define SW(R1,D2,X2,B2)		RX_(0x6F,R1,X2,B2,D2)
+/****************************************************************
+ * Binary Floating Point Instructions				*
+ ****************************************************************/
+/* ADD */
+#  define AEBR(R1,R2)			RRE_(0xB30A,R1,R2)
+#  define ADBR(R1,R2)			RRE_(0xB31A,R1,R2)
+#  define AXBR(R1,R2)			RRE_(0xB34A,R1,R2)
+#  define AEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x0A)
+#  define ADB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x1A)
+/* COMPARE */
+#  define CEBR(R1,R2)			RRE_(0xB309,R1,R2)
+#  define CDBR(R1,R2)			RRE_(0xB319,R1,R2)
+#  define CXBR(R1,R2)			RRE_(0xB349,R1,R2)
+#  define CEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x09)
+#  define CDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x19)
+/* COMPARE AND SIGNAL */
+#  define KEBR(R1,R2)			RRE_(0xB308,R1,R2)
+#  define KDBR(R1,R2)			RRE_(0xB318,R1,R2)
+#  define KXBR(R1,R2)			RRE_(0xB348,R1,R2)
+#  define KEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x08)
+#  define KDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x18)
+/* CONVERT FROM FIXED */
+#  define CEFBR(R1,R2)			RRE_(0xB394,R1,R2)
+#  define CDFBR(R1,R2)			RRE_(0xB395,R1,R2)
+#  define CXFBR(R1,R2)			RRE_(0xB396,R1,R2)
+#  define CEGBR(R1,R2)			RRE_(0xB3A4,R1,R2)
+#  define CDGBR(R1,R2)			RRE_(0xB3A5,R1,R2)
+#  define CXGBR(R1,R2)			RRE_(0xB3A6,R1,R2)
+/* CONVERT TO FIXED */
+#  define CFEBR(R1,M3,R2)		RRF_(0xB398,M3,0,R1,R2)
+#  define CFDBR(R1,M3,R2)		RRF_(0xB399,M3,0,R1,R2)
+#  define CFXBR(R1,M3,R2)		RRF_(0xB39A,M3,0,R1,R2)
+#  define CGEBR(R1,M3,R2)		RRF_(0xB3A8,M3,0,R1,R2)
+#  define CGDBR(R1,M3,R2)		RRF_(0xB3A9,M3,0,R1,R2)
+#  define CGXBR(R1,M3,R2)		RRF_(0xB3AA,M3,0,R1,R2)
+/* DIVIDE */
+#  define DEBR(R1,R2)			RRE_(0xB30D,R1,R2)
+#  define DDBR(R1,R2)			RRE_(0xB31D,R1,R2)
+#  define DXBR(R1,R2)			RRE_(0xB34D,R1,R2)
+#  define DEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x0D)
+#  define DDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x1D)
+/* DIVIDE TO INTEGER */
+#  define DIEBR(R1,R3,R2,M4)		RRF_(0xB353,R3,M4,R1,R2)
+#  define DIDBR(R1,R3,R2,M4)		RRF_(0xB35B,R3,M4,R1,R2)
+/* EXTRACT FPC */
+#  define EFPC(R1)			RRE_(0xB38C,R1,0)
+/* LOAD AND TEST */
+#  define LTEBR(R1,R2)			RRE_(0xB302,R1,R2)
+#  define LTDBR(R1,R2)			RRE_(0xB312,R1,R2)
+#  define LTXBR(R1,R2)			RRE_(0xB342,R1,R2)
+/* LOAD COMPLEMENT */
+#  define LCEBR(R1,R2)			RRE_(0xB303,R1,R2)
+#  define LCDBR(R1,R2)			RRE_(0xB313,R1,R2)
+#  define LCXBR(R1,R2)			RRE_(0xB343,R1,R2)
+/* LOAD FP INTEGER */
+#  define FIEBR(R1,M3,R2)		RRF_(0xB357,M3,0,R1,R2)
+#  define FIDBR(R1,M3,R2)		RRF_(0xB35F,M3,0,R1,R2)
+#  define FIXBR(R1,M3,R2)		RRF_(0xB347,M3,0,R1,R2)
+/* LOAD FPC */
+#  define LFPC(D2,B2)			S_(0xB29D,B2,D2)
+/* LOAD LENGTHENED */
+#  define LDEBR(R1,R2)			RRE_(0xB304,R1,R2)
+#  define LXDBR(R1,R2)			RRE_(0xB305,R1,R2)
+#  define LXEBR(R1,R2)			RRE_(0xB306,R1,R2)
+#  define LDEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x04)
+#  define LXDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x05)
+#  define LXEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x06)
+/* LOAD NEGATIVE */
+#  define LNEBR(R1,R2)			RRE_(0xB301,R1,R2)
+#  define LNDBR(R1,R2)			RRE_(0xB311,R1,R2)
+#  define LNXBR(R1,R2)			RRE_(0xB341,R1,R2)
+/* LOAD POSITIVE */
+#  define LPEBR(R1,R2)			RRE_(0xB300,R1,R2)
+#  define LPDBR(R1,R2)			RRE_(0xB310,R1,R2)
+#  define LPXBR(R1,R2)			RRE_(0xB340,R1,R2)
+/* LOAD ROUNDED */
+#  define LEDBR(R1,R2)			RRE_(0xB344,R1,R2)
+#  define LDXBR(R1,R2)			RRE_(0xB345,R1,R2)
+#  define LEXBR(R1,R2)			RRE_(0xB346,R1,R2)
+/* MULTIPLY */
+#  define MEEBR(R1,R2)			RRE_(0xB317,R1,R2)
+#  define MDBR(R1,R2)			RRE_(0xB31C,R1,R2)
+#  define MXBR(R1,R2)			RRE_(0xB34C,R1,R2)
+#  define MDEBR(R1,R2)			RRE_(0xB30C,R1,R2)
+#  define MXDBR(R1,R2)			RRE_(0xB307,R1,R2)
+#  define MEEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x17)
+#  define MDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x1C)
+#  define MDEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x0C)
+#  define MXDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x07)
+/* MULTIPLY AND ADD */
+#  define MAEBR(R1,R3,R2)		RRF_(0xB30E,R1,0,R3,R2)
+#  define MADBR(R1,R3,R2)		RRF_(0xB31E,R1,0,R3,R2)
+#  define MAEB(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x0E)
+#  define MADB(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x1E)
+/* MULTIPLY AND SUBTRACT */
+#  define MSEBR(R1,R3,R2)		RRF_(0xB30F,R1,0,R3,R2)
+#  define MSDBR(R1,R3,R2)		RRF_(0xB31F,R1,0,R3,R2)
+#  define MSEB(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x0F)
+#  define MSDB(R1,R3,D2,X2,B2)		RXF_(0xED,R3,X2,B2,D2,R1,0x1F)
+/* SET FPC */
+#  define SFPC(R1)			RRE_(0xB384,R1,0)
+/* SET ROUNDING MODE */
+#  define SRNM(D2,B2)			S_(0xB299,B2,D2)
+/* SQUARE ROOT */
+#  define SQEBR(R1,R2)			RRE_(0xB314,R1,R2)
+#  define SQDBR(R1,R2)			RRE_(0xB315,R1,R2)
+#  define SQXBR(R1,R2)			RRE_(0xB316,R1,R2)
+/* STORE FPC */
+#  define STFPC(D2,B2)			S_(0xB29C,B2,D2)
+/* SUBTRACT */
+#  define SEBR(R1,R2)			RRE_(0xB30B,R1,R2)
+#  define SDBR(R1,R2)			RRE_(0xB31B,R1,R2)
+#  define SXBR(R1,R2)			RRE_(0xB34B,R1,R2)
+#  define SEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x0B)
+#  define SDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x1B)
+/* TEST DATA CLASS */
+#  define TCEB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x10)
+#  define TCDB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x11)
+#  define TCXB(R1,D2,X2,B2)		RXE_(0xED,R1,X2,B2,D2,0x12)
+#  define fp(code,r0,r1,i0)		_fp(_jit,jit_code_##code##i_f,r0,r1,i0)
+static void _fp(jit_state_t*,jit_code_t,
+		int32_t,int32_t,jit_float32_t*);
+#  define dp(code,r0,r1,i0)		_dp(_jit,jit_code_##code##i_d,r0,r1,i0)
+static void _dp(jit_state_t*,jit_code_t,
+		int32_t,int32_t,jit_float64_t*);
+#  define fr(cc,r0,r1,r2)		_fr(_jit,cc,r0,r1,r2)
+static void _fr(jit_state_t*,int32_t,
+		int32_t,int32_t,int32_t);
+#  define dr(cc,r0,r1,r2)		_dr(_jit,cc,r0,r1,r2)
+static void _dr(jit_state_t*,int32_t,
+		int32_t,int32_t,int32_t);
+#  define fi(cc,r0,r1,i0)		_fi(_jit,cc,r0,r1,i0)
+static void _fi(jit_state_t*,int32_t,
+		int32_t,int32_t,jit_float32_t*);
+#  define di(cc,r0,r1,i0)		_di(_jit,cc,r0,r1,i0)
+static void _di(jit_state_t*,int32_t,
+		int32_t,int32_t,jit_float64_t*);
+#  define bfr(cc,i0,r0,r1)		_bfr(_jit,cc,i0,r0,r1)
+static void _bfr(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,int32_t);
+#  define bdr(cc,i0,r0,r1)		_bdr(_jit,cc,i0,r0,r1)
+static void _bdr(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,int32_t);
+#  define bfr_p(cc,i0,r0,r1)		_bfr_p(_jit,cc,i0,r0,r1)
+static jit_word_t _bfr_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,int32_t);
+#  define bdr_p(cc,i0,r0,r1)		_bdr_p(_jit,cc,i0,r0,r1)
+static jit_word_t _bdr_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,int32_t);
+#  define bfi(cc,i0,r0,i1)		_bfi(_jit,cc,i0,r0,i1)
+static void _bfi(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,jit_float32_t*);
+#  define bdi(cc,i0,r0,i1)		_bdi(_jit,cc,i0,r0,i1)
+static void _bdi(jit_state_t*,int32_t,
+		 jit_word_t,int32_t,jit_float64_t*);
+#  define bfi_p(cc,i0,r0,i1)		_bfi_p(_jit,cc,i0,r0,i1)
+static jit_word_t _bfi_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,jit_float32_t*);
+#  define bdi_p(cc,i0,r0,i1)		_bdi_p(_jit,cc,i0,r0,i1)
+static jit_word_t _bdi_p(jit_state_t*,int32_t,
+			 jit_word_t,int32_t,jit_float64_t*);
+#  define buneqr(db,i0,r0,r1)		_buneqr(_jit,db,i0,r0,r1)
+static jit_word_t _buneqr(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,int32_t);
+#  define buneqi(db,i0,r0,i1)		_buneqi(_jit,db,i0,r0,(jit_word_t)i1)
+static jit_word_t _buneqi(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,jit_word_t);
+#  define bltgtr(db,i0,r0,r1)		_bltgtr(_jit,db,i0,r0,r1)
+static jit_word_t _bltgtr(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,int32_t);
+#  define bltgti(db,i0,r0,i1)		_bltgti(_jit,db,i0,r0,(jit_word_t)i1)
+static jit_word_t _bltgti(jit_state_t*,int32_t,
+			  jit_word_t,int32_t,jit_word_t);
+#  define movr_f(r0,r1)			_movr_f(_jit,r0,r1)
+static void _movr_f(jit_state_t*,int32_t,int32_t);
+#  define movi_f(r0,i0)			_movi_f(_jit,r0,i0)
+static void _movi_f(jit_state_t*,int32_t,jit_float32_t*);
+#  define movr_d(r0,r1)			_movr_d(_jit,r0,r1)
+static void _movr_d(jit_state_t*,int32_t,int32_t);
+#  define movi_d(r0,i0)			_movi_d(_jit,r0,i0)
+static void _movi_d(jit_state_t*,int32_t,jit_float64_t*);
+#  define absr_f(r0,r1)			LPEBR(r0,r1)
+#  define absr_d(r0,r1)			LPDBR(r0,r1)
+#  define negr_f(r0,r1)			LCEBR(r0,r1)
+#  define negr_d(r0,r1)			LCDBR(r0,r1)
+#  define sqrtr_f(r0,r1)		SQEBR(r0,r1)
+#  define sqrtr_d(r0,r1)		SQDBR(r0,r1)
+#  define truncr_f_i(r0,r1)		CFEBR(r0,RND_ZERO,r1)
+#  define truncr_d_i(r0,r1)		CFDBR(r0,RND_ZERO,r1)
+#  if __WORDSIZE == 64
+#    define truncr_f_l(r0,r1)		CGEBR(r0,RND_ZERO,r1)
+#    define truncr_d_l(r0,r1)		CGDBR(r0,RND_ZERO,r1)
+#  endif
+#  if __WORDSIZE == 32
+#    define extr_f(r0,r1)		CEFBR(r0,r1)
+#    define extr_d(r0,r1)		CDFBR(r0,r1)
+#  else
+#    define extr_f(r0,r1)		CEGBR(r0,r1)
+#    define extr_d(r0,r1)		CDGBR(r0,r1)
+#  endif
+#  define extr_d_f(r0,r1)		LEDBR(r0,r1)
+#  define extr_f_d(r0,r1)		LDEBR(r0,r1)
+#  define addr_f(r0,r1,r2)		_addr_f(_jit,r0,r1,r2)
+static void _addr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addi_f(r0,r1,i0)		fp(add,r0,r1,i0)
+#  define addr_d(r0,r1,r2)		_addr_d(_jit,r0,r1,r2)
+static void _addr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define addi_d(r0,r1,i0)		dp(add,r0,r1,i0)
+#  define subr_f(r0,r1,r2)		_subr_f(_jit,r0,r1,r2)
+static void _subr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subi_f(r0,r1,i0)		fp(sub,r0,r1,i0)
+#  define subr_d(r0,r1,r2)		_subr_d(_jit,r0,r1,r2)
+static void _subr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define subi_d(r0,r1,i0)		dp(sub,r0,r1,i0)
+#  define rsbr_f(r0,r1,r2)		subr_f(r0,r2,r1)
+#  define rsbi_f(r0,r1,i0)		fp(rsb,r0,r1,i0)
+#  define rsbr_d(r0,r1,r2)		subr_d(r0,r2,r1)
+#  define rsbi_d(r0,r1,i0)		dp(rsb,r0,r1,i0)
+#  define mulr_f(r0,r1,r2)		_mulr_f(_jit,r0,r1,r2)
+static void _mulr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define muli_f(r0,r1,i0)		fp(mul,r0,r1,i0)
+#  define mulr_d(r0,r1,r2)		_mulr_d(_jit,r0,r1,r2)
+static void _mulr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define muli_d(r0,r1,i0)		dp(mul,r0,r1,i0)
+#  define divr_f(r0,r1,r2)		_divr_f(_jit,r0,r1,r2)
+static void _divr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi_f(r0,r1,i0)		fp(div,r0,r1,i0)
+#  define divr_d(r0,r1,r2)		_divr_d(_jit,r0,r1,r2)
+static void _divr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define divi_d(r0,r1,i0)		dp(div,r0,r1,i0)
+#  define ldr_f(r0,r1)			LE(r0,0,0,r1)
+#  define ldr_d(r0,r1)			LD(r0,0,0,r1)
+#  define ldi_f(r0,i0)			_ldi_f(_jit,r0,i0)
+static void _ldi_f(jit_state_t*,int32_t,jit_word_t);
+#  define ldi_d(r0,i0)			_ldi_d(_jit,r0,i0)
+static void _ldi_d(jit_state_t*,int32_t,jit_word_t);
+#  define ldxr_f(r0,r1,r2)		_ldxr_f(_jit,r0,r1,r2)
+static void _ldxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxr_d(r0,r1,r2)		_ldxr_d(_jit,r0,r1,r2)
+static void _ldxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ldxi_f(r0,r1,i0)		_ldxi_f(_jit,r0,r1,i0)
+static void _ldxi_f(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define ldxi_d(r0,r1,i0)		_ldxi_d(_jit,r0,r1,i0)
+static void _ldxi_d(jit_state_t*,int32_t,int32_t,jit_word_t);
+#  define str_f(r0,r1)			STE(r1,0,0,r0)
+#  define str_d(r0,r1)			STD(r1,0,0,r0)
+#  define sti_f(i0,r0)			_sti_f(_jit,i0,r0)
+static void _sti_f(jit_state_t*,jit_word_t,int32_t);
+#  define sti_d(i0,r0)			_sti_d(_jit,i0,r0)
+static void _sti_d(jit_state_t*,jit_word_t,int32_t);
+#  define stxr_f(r0,r1,r2)		_stxr_f(_jit,r0,r1,r2)
+static void _stxr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxr_d(r0,r1,r2)		_stxr_d(_jit,r0,r1,r2)
+static void _stxr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define stxi_f(i0,r0,r1)		_stxi_f(_jit,i0,r0,r1)
+static void _stxi_f(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define stxi_d(i0,r0,r1)		_stxi_d(_jit,i0,r0,r1)
+static void _stxi_d(jit_state_t*,jit_word_t,int32_t,int32_t);
+#  define ltr_f(r0,r1,r2)		fr(CC_L,r0,r1,r2)
+#  define ltr_d(r0,r1,r2)		dr(CC_L,r0,r1,r2)
+#  define lti_f(r0,r1,i0)		fi(CC_L,r0,r1,i0)
+#  define lti_d(r0,r1,i0)		di(CC_L,r0,r1,i0)
+#  define ler_f(r0,r1,r2)		fr(CC_LE,r0,r1,r2)
+#  define ler_d(r0,r1,r2)		dr(CC_LE,r0,r1,r2)
+#  define lei_f(r0,r1,i0)		fi(CC_LE,r0,r1,i0)
+#  define lei_d(r0,r1,i0)		di(CC_LE,r0,r1,i0)
+#  define eqr_f(r0,r1,r2)		fr(CC_E,r0,r1,r2)
+#  define eqr_d(r0,r1,r2)		dr(CC_E,r0,r1,r2)
+#  define eqi_f(r0,r1,i0)		fi(CC_E,r0,r1,i0)
+#  define eqi_d(r0,r1,i0)		di(CC_E,r0,r1,i0)
+#  define ger_f(r0,r1,r2)		fr(CC_HE,r0,r1,r2)
+#  define ger_d(r0,r1,r2)		dr(CC_HE,r0,r1,r2)
+#  define gei_f(r0,r1,i0)		fi(CC_HE,r0,r1,i0)
+#  define gei_d(r0,r1,i0)		di(CC_HE,r0,r1,i0)
+#  define gtr_f(r0,r1,r2)		fr(CC_H,r0,r1,r2)
+#  define gtr_d(r0,r1,r2)		dr(CC_H,r0,r1,r2)
+#  define gti_f(r0,r1,i0)		fi(CC_H,r0,r1,i0)
+#  define gti_d(r0,r1,i0)		di(CC_H,r0,r1,i0)
+#  define ner_f(r0,r1,r2)		fr(CC_NE,r0,r1,r2)
+#  define ner_d(r0,r1,r2)		dr(CC_NE,r0,r1,r2)
+#  define nei_f(r0,r1,i0)		fi(CC_NE,r0,r1,i0)
+#  define nei_d(r0,r1,i0)		di(CC_NE,r0,r1,i0)
+#  define unltr_f(r0,r1,r2)		fr(CC_NHE,r0,r1,r2)
+#  define unltr_d(r0,r1,r2)		dr(CC_NHE,r0,r1,r2)
+#  define unlti_f(r0,r1,i0)		fi(CC_NHE,r0,r1,i0)
+#  define unlti_d(r0,r1,i0)		di(CC_NHE,r0,r1,i0)
+#  define unler_f(r0,r1,r2)		fr(CC_NH,r0,r1,r2)
+#  define unler_d(r0,r1,r2)		dr(CC_NH,r0,r1,r2)
+#  define unlei_f(r0,r1,i0)		fi(CC_NH,r0,r1,i0)
+#  define unlei_d(r0,r1,i0)		di(CC_NH,r0,r1,i0)
+#  define uneqr_f(r0,r1,r2)		_uneqr_f(_jit,r0,r1,r2)
+static void _uneqr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define uneqr_d(r0,r1,r2)		_uneqr_d(_jit,r0,r1,r2)
+static void _uneqr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define uneqi_f(r0,r1,i0)		fp(uneq,r0,r1,i0)
+#  define uneqi_d(r0,r1,i0)		dp(uneq,r0,r1,i0)
+#  define unger_f(r0,r1,r2)		fr(CC_NL,r0,r1,r2)
+#  define unger_d(r0,r1,r2)		dr(CC_NL,r0,r1,r2)
+#  define ungei_f(r0,r1,i0)		fi(CC_NL,r0,r1,i0)
+#  define ungei_d(r0,r1,i0)		di(CC_NL,r0,r1,i0)
+#  define ungtr_f(r0,r1,r2)		fr(CC_NLE,r0,r1,r2)
+#  define ungtr_d(r0,r1,r2)		dr(CC_NLE,r0,r1,r2)
+#  define ungti_f(r0,r1,i0)		fi(CC_NLE,r0,r1,i0)
+#  define ungti_d(r0,r1,i0)		di(CC_NLE,r0,r1,i0)
+#  define ltgtr_f(r0,r1,r2)		_ltgtr_f(_jit,r0,r1,r2)
+static void _ltgtr_f(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ltgtr_d(r0,r1,r2)		_ltgtr_d(_jit,r0,r1,r2)
+static void _ltgtr_d(jit_state_t*,int32_t,int32_t,int32_t);
+#  define ltgti_f(r0,r1,i0)		fp(ltgt,r0,r1,i0)
+#  define ltgti_d(r0,r1,i0)		dp(ltgt,r0,r1,i0)
+#  define ordr_f(r0,r1,r2)		fr(CC_NO,r0,r1,r2)
+#  define ordr_d(r0,r1,r2)		dr(CC_NO,r0,r1,r2)
+#  define ordi_f(r0,r1,i0)		fi(CC_NO,r0,r1,i0)
+#  define ordi_d(r0,r1,i0)		di(CC_NO,r0,r1,i0)
+#  define unordr_f(r0,r1,r2)		fr(CC_O,r0,r1,r2)
+#  define unordr_d(r0,r1,r2)		dr(CC_O,r0,r1,r2)
+#  define unordi_f(r0,r1,i0)		fi(CC_O,r0,r1,i0)
+#  define unordi_d(r0,r1,i0)		di(CC_O,r0,r1,i0)
+#  define bltr_f(i0,r0,r1)		bfr(CC_L,i0,r0,r1)
+#  define bltr_d(i0,r0,r1)		bdr(CC_L,i0,r0,r1)
+#  define blti_f(i0,r0,i1)		bfi(CC_L,i0,r0,i1)
+#  define blti_d(i0,r0,i1)		bdi(CC_L,i0,r0,i1)
+#  define bltr_f_p(i0,r0,r1)		bfr_p(CC_L,i0,r0,r1)
+#  define bltr_d_p(i0,r0,r1)		bdr_p(CC_L,i0,r0,r1)
+#  define blti_f_p(i0,r0,i1)		bfi_p(CC_L,i0,r0,i1)
+#  define blti_d_p(i0,r0,i1)		bdi_p(CC_L,i0,r0,i1)
+#  define bler_f(i0,r0,r1)		bfr(CC_LE,i0,r0,r1)
+#  define bler_d(i0,r0,r1)		bdr(CC_LE,i0,r0,r1)
+#  define blei_f(i0,r0,i1)		bfi(CC_LE,i0,r0,i1)
+#  define blei_d(i0,r0,i1)		bdi(CC_LE,i0,r0,i1)
+#  define bler_f_p(i0,r0,r1)		bfr_p(CC_LE,i0,r0,r1)
+#  define bler_d_p(i0,r0,r1)		bdr_p(CC_LE,i0,r0,r1)
+#  define blei_f_p(i0,r0,i1)		bfi_p(CC_LE,i0,r0,i1)
+#  define blei_d_p(i0,r0,i1)		bdi_p(CC_LE,i0,r0,i1)
+#  define beqr_f(i0,r0,r1)		bfr(CC_E,i0,r0,r1)
+#  define beqr_d(i0,r0,r1)		bdr(CC_E,i0,r0,r1)
+#  define beqi_f(i0,r0,i1)		bfi(CC_E,i0,r0,i1)
+#  define beqi_d(i0,r0,i1)		bdi(CC_E,i0,r0,i1)
+#  define beqr_f_p(i0,r0,r1)		bfr_p(CC_E,i0,r0,r1)
+#  define beqr_d_p(i0,r0,r1)		bdr_p(CC_E,i0,r0,r1)
+#  define beqi_f_p(i0,r0,i1)		bfi_p(CC_E,i0,r0,i1)
+#  define beqi_d_p(i0,r0,i1)		bdi_p(CC_E,i0,r0,i1)
+#  define bger_f(i0,r0,r1)		bfr(CC_HE,i0,r0,r1)
+#  define bger_d(i0,r0,r1)		bdr(CC_HE,i0,r0,r1)
+#  define bgei_f(i0,r0,i1)		bfi(CC_HE,i0,r0,i1)
+#  define bgei_d(i0,r0,i1)		bdi(CC_HE,i0,r0,i1)
+#  define bger_f_p(i0,r0,r1)		bfr_p(CC_HE,i0,r0,r1)
+#  define bger_d_p(i0,r0,r1)		bdr_p(CC_HE,i0,r0,r1)
+#  define bgei_f_p(i0,r0,i1)		bfi_p(CC_HE,i0,r0,i1)
+#  define bgei_d_p(i0,r0,i1)		bdi_p(CC_HE,i0,r0,i1)
+#  define bgtr_f(i0,r0,r1)		bfr(CC_H,i0,r0,r1)
+#  define bgtr_d(i0,r0,r1)		bdr(CC_H,i0,r0,r1)
+#  define bgti_f(i0,r0,i1)		bfi(CC_H,i0,r0,i1)
+#  define bgti_d(i0,r0,i1)		bdi(CC_H,i0,r0,i1)
+#  define bgtr_f_p(i0,r0,r1)		bfr_p(CC_H,i0,r0,r1)
+#  define bgtr_d_p(i0,r0,r1)		bdr_p(CC_H,i0,r0,r1)
+#  define bgti_f_p(i0,r0,i1)		bfi_p(CC_H,i0,r0,i1)
+#  define bgti_d_p(i0,r0,i1)		bdi_p(CC_H,i0,r0,i1)
+#  define bner_f(i0,r0,r1)		bfr(CC_NE,i0,r0,r1)
+#  define bner_d(i0,r0,r1)		bdr(CC_NE,i0,r0,r1)
+#  define bnei_f(i0,r0,i1)		bfi(CC_NE,i0,r0,i1)
+#  define bnei_d(i0,r0,i1)		bdi(CC_NE,i0,r0,i1)
+#  define bner_f_p(i0,r0,r1)		bfr_p(CC_NE,i0,r0,r1)
+#  define bner_d_p(i0,r0,r1)		bdr_p(CC_NE,i0,r0,r1)
+#  define bnei_f_p(i0,r0,i1)		bfi_p(CC_NE,i0,r0,i1)
+#  define bnei_d_p(i0,r0,i1)		bdi_p(CC_NE,i0,r0,i1)
+#  define bunltr_f(i0,r0,r1)		bfr(CC_NHE,i0,r0,r1)
+#  define bunltr_d(i0,r0,r1)		bdr(CC_NHE,i0,r0,r1)
+#  define bunlti_f(i0,r0,i1)		bfi(CC_NHE,i0,r0,i1)
+#  define bunlti_d(i0,r0,i1)		bdi(CC_NHE,i0,r0,i1)
+#  define bunltr_f_p(i0,r0,r1)		bfr_p(CC_NHE,i0,r0,r1)
+#  define bunltr_d_p(i0,r0,r1)		bdr_p(CC_NHE,i0,r0,r1)
+#  define bunlti_f_p(i0,r0,i1)		bfi_p(CC_NHE,i0,r0,i1)
+#  define bunlti_d_p(i0,r0,i1)		bdi_p(CC_NHE,i0,r0,i1)
+#  define bunler_f(i0,r0,r1)		bfr(CC_NH,i0,r0,r1)
+#  define bunler_d(i0,r0,r1)		bdr(CC_NH,i0,r0,r1)
+#  define bunlei_f(i0,r0,i1)		bfi(CC_NH,i0,r0,i1)
+#  define bunlei_d(i0,r0,i1)		bdi(CC_NH,i0,r0,i1)
+#  define bunler_f_p(i0,r0,r1)		bfr_p(CC_NH,i0,r0,r1)
+#  define bunler_d_p(i0,r0,r1)		bdr_p(CC_NH,i0,r0,r1)
+#  define bunlei_f_p(i0,r0,i1)		bfi_p(CC_NH,i0,r0,i1)
+#  define bunlei_d_p(i0,r0,i1)		bdi_p(CC_NH,i0,r0,i1)
+#  define buneqr_f(i0,r0,r1)		buneqr(0,i0,r0,r1)
+#  define buneqr_d(i0,r0,r1)		buneqr(1,i0,r0,r1)
+#  define buneqi_f(i0,r0,i1)		buneqi(0,i0,r0,i1)
+#  define buneqi_d(i0,r0,i1)		buneqi(1,i0,r0,i1)
+#  define buneqr_f_p(i0,r0,r1)		buneqr(0,i0,r0,r1)
+#  define buneqr_d_p(i0,r0,r1)		buneqr(1,i0,r0,r1)
+#  define buneqi_f_p(i0,r0,i1)		buneqi(0,i0,r0,i1)
+#  define buneqi_d_p(i0,r0,i1)		buneqi(1,i0,r0,i1)
+#  define bunger_f(i0,r0,r1)		bfr(CC_NL,i0,r0,r1)
+#  define bunger_d(i0,r0,r1)		bdr(CC_NL,i0,r0,r1)
+#  define bungei_f(i0,r0,i1)		bfi(CC_NL,i0,r0,i1)
+#  define bungei_d(i0,r0,i1)		bdi(CC_NL,i0,r0,i1)
+#  define bunger_f_p(i0,r0,r1)		bfr_p(CC_NL,i0,r0,r1)
+#  define bunger_d_p(i0,r0,r1)		bdr_p(CC_NL,i0,r0,r1)
+#  define bungei_f_p(i0,r0,i1)		bfi_p(CC_NL,i0,r0,i1)
+#  define bungei_d_p(i0,r0,i1)		bdi_p(CC_NL,i0,r0,i1)
+#  define bungtr_f(i0,r0,r1)		bfr(CC_NLE,i0,r0,r1)
+#  define bungtr_d(i0,r0,r1)		bdr(CC_NLE,i0,r0,r1)
+#  define bungti_f(i0,r0,i1)		bfi(CC_NLE,i0,r0,i1)
+#  define bungti_d(i0,r0,i1)		bdi(CC_NLE,i0,r0,i1)
+#  define bungtr_f_p(i0,r0,r1)		bfr_p(CC_NLE,i0,r0,r1)
+#  define bungtr_d_p(i0,r0,r1)		bdr_p(CC_NLE,i0,r0,r1)
+#  define bungti_f_p(i0,r0,i1)		bfi_p(CC_NLE,i0,r0,i1)
+#  define bungti_d_p(i0,r0,i1)		bdi_p(CC_NLE,i0,r0,i1)
+#  define bltgtr_f(i0,r0,r1)		bltgtr(0,i0,r0,r1)
+#  define bltgtr_d(i0,r0,r1)		bltgtr(1,i0,r0,r1)
+#  define bltgti_f(i0,r0,i1)		bltgti(0,i0,r0,i1)
+#  define bltgti_d(i0,r0,i1)		bltgti(1,i0,r0,i1)
+#  define bltgtr_f_p(i0,r0,r1)		bltgtr(0,i0,r0,r1)
+#  define bltgtr_d_p(i0,r0,r1)		bltgtr(1,i0,r0,r1)
+#  define bltgti_f_p(i0,r0,i1)		bltgti(0,i0,r0,i1)
+#  define bltgti_d_p(i0,r0,i1)		bltgti(1,i0,r0,i1)
+#  define bordr_f(i0,r0,r1)		bfr(CC_NO,i0,r0,r1)
+#  define bordr_d(i0,r0,r1)		bdr(CC_NO,i0,r0,r1)
+#  define bordi_f(i0,r0,i1)		bfi(CC_NO,i0,r0,i1)
+#  define bordi_d(i0,r0,i1)		bdi(CC_NO,i0,r0,i1)
+#  define bordr_f_p(i0,r0,r1)		bfr_p(CC_NO,i0,r0,r1)
+#  define bordr_d_p(i0,r0,r1)		bdr_p(CC_NO,i0,r0,r1)
+#  define bordi_f_p(i0,r0,i1)		bfi_p(CC_NO,i0,r0,i1)
+#  define bordi_d_p(i0,r0,i1)		bdi_p(CC_NO,i0,r0,i1)
+#  define bunordr_f(i0,r0,r1)		bfr(CC_O,i0,r0,r1)
+#  define bunordr_d(i0,r0,r1)		bdr(CC_O,i0,r0,r1)
+#  define bunordi_f(i0,r0,i1)		bfi(CC_O,i0,r0,i1)
+#  define bunordi_d(i0,r0,i1)		bdi(CC_O,i0,r0,i1)
+#  define bunordr_f_p(i0,r0,r1)		bfr_p(CC_O,i0,r0,r1)
+#  define bunordr_d_p(i0,r0,r1)		bdr_p(CC_O,i0,r0,r1)
+#  define bunordi_f_p(i0,r0,i1)		bfi_p(CC_O,i0,r0,i1)
+#  define bunordi_d_p(i0,r0,i1)		bdi_p(CC_O,i0,r0,i1)
+#  define vaarg_d(r0, r1)		_vaarg_d(_jit, r0, r1)
+static void _vaarg_d(jit_state_t*, int32_t, int32_t);
+#endif
+
+#if CODE
+static void
+_fp(jit_state_t *_jit, jit_code_t code,
+    int32_t r0, int32_t r1, jit_float32_t *i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr);
+    movi_f(rn(reg), i0);
+    switch (code) {
+	case jit_code_addi_f:	addr_f(r0, r1, rn(reg));	break;
+	case jit_code_subi_f:	subr_f(r0, r1, rn(reg));	break;
+	case jit_code_rsbi_f:	rsbr_f(r0, r1, rn(reg));	break;
+	case jit_code_muli_f:	mulr_f(r0, r1, rn(reg));	break;
+	case jit_code_divi_f:	divr_f(r0, r1, rn(reg));	break;
+	case jit_code_uneqi_f:	uneqr_f(r0, r1, rn(reg));	break;
+	case jit_code_ltgti_f:	ltgtr_f(r0, r1, rn(reg));	break;
+	default:		abort();
+    }
+    jit_unget_reg(reg);
+}
+
+static void
+_dp(jit_state_t *_jit, jit_code_t code,
+    int32_t r0, int32_t r1, jit_float64_t *i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr);
+    movi_d(rn(reg), i0);
+    switch (code) {
+	case jit_code_addi_d:	addr_d(r0, r1, rn(reg));	break;
+	case jit_code_subi_d:	subr_d(r0, r1, rn(reg));	break;
+	case jit_code_rsbi_d:	rsbr_d(r0, r1, rn(reg));	break;
+	case jit_code_muli_d:	mulr_d(r0, r1, rn(reg));	break;
+	case jit_code_divi_d:	divr_d(r0, r1, rn(reg));	break;
+	case jit_code_uneqi_d:	uneqr_d(r0, r1, rn(reg));	break;
+	case jit_code_ltgti_d:	ltgtr_d(r0, r1, rn(reg));	break;
+	default:		abort();
+    }
+    jit_unget_reg(reg);
+}
+
+static void
+_fr(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    LGHI(r0, 1);
+    CEBR(r1, r2);
+    w = _jit->pc.w;
+    BRC(cc, 0);
+    LGHI(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+
+static void
+_dr(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		w;
+    LGHI(r0, 1);
+    CDBR(r1, r2);
+    w = _jit->pc.w;
+    BRC(cc, 0);
+    LGHI(r0, 0);
+    patch_at(w, _jit->pc.w);
+}
+
+static void
+_fi(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, jit_float32_t *i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr|jit_class_nospill);
+    movi_f(rn(reg), i0);
+    fr(cc, r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_di(jit_state_t *_jit, int32_t cc,
+     int32_t r0, int32_t r1, jit_float64_t *i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr|jit_class_nospill);
+    movi_d(rn(reg), i0);
+    dr(cc, r0, r1, rn(reg));
+    jit_unget_reg(reg);
+}
+
+
+static void
+_bfr(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    CEBR(r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static void
+_bdr(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		d;
+    CDBR(r0, r1);
+    d = (i0 - _jit->pc.w) >> 1;
+    if (s16_p(d))
+	BRC(cc, x16(d));
+    else {
+	assert(s32_p(d));
+	BRCL(cc, d);
+    }
+}
+
+static jit_word_t
+_bfr_p(jit_state_t *_jit, int32_t cc,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    CEBR(r0, r1);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static jit_word_t
+_bdr_p(jit_state_t *_jit, int32_t cc,
+       jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		w;
+    CDBR(r0, r1);
+    w = _jit->pc.w;
+    BRCL(cc, 0);
+    return (w);
+}
+
+static void
+_bfi(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_float32_t *i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi_f(rn(reg), i1);
+    bfr(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static void
+_bdi(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_float64_t *i1)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi_d(rn(reg), i1);
+    bdr(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+}
+
+static jit_word_t
+_bfi_p(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_float32_t *i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi_f(rn(reg), i1);
+    w = bfr_p(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bdi_p(jit_state_t *_jit, int32_t cc,
+     jit_word_t i0, int32_t r0, jit_float64_t *i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr|jit_class_nospill);
+    movi_d(rn(reg), i1);
+    w = bdr_p(cc, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_buneqr(jit_state_t *_jit, int32_t db,
+	jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		unord, ne, w;
+    if (db)	CDBR(r0, r1);
+    else	CEBR(r0, r1);
+    unord = _jit->pc.w;
+    BRC(CC_O, 0);			/* unord satisfies condition */
+    ne = _jit->pc.w;
+    BRC(CC_NE, 0);			/* ne does not satisfy condition */
+    patch_at(unord, _jit->pc.w);
+    w = _jit->pc.w;
+    BRCL(CC_AL, (i0 - _jit->pc.w) >> 1);
+    patch_at(ne, _jit->pc.w);
+    return (w);
+}
+
+static jit_word_t
+_buneqi(jit_state_t *_jit, int32_t db,
+	jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr|jit_class_nospill);
+    if (db)
+	movi_d(rn(reg), (jit_float64_t *)i1);
+    else
+	movi_f(rn(reg), (jit_float32_t *)i1);
+    w = buneqr(db, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static jit_word_t
+_bltgtr(jit_state_t *_jit, int32_t db,
+	jit_word_t i0, int32_t r0, int32_t r1)
+{
+    jit_word_t		unord, eq, w;
+    if (db)	CDBR(r0, r1);
+    else	CEBR(r0, r1);
+    unord = _jit->pc.w;
+    BRC(CC_O, 0);			/* unord does not satisfy condition */
+    eq = _jit->pc.w;
+    BRC(CC_E, 0);			/* eq does not satisfy condition */
+    w = _jit->pc.w;
+    BRCL(CC_AL, (i0 - _jit->pc.w) >> 1);
+    patch_at(unord, _jit->pc.w);
+    patch_at(eq, _jit->pc.w);
+    return (w);
+}
+
+static jit_word_t
+_bltgti(jit_state_t *_jit, int32_t db,
+	jit_word_t i0, int32_t r0, jit_word_t i1)
+{
+    jit_word_t		w;
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_fpr|jit_class_nospill);
+    if (db)
+	movi_d(rn(reg), (jit_float64_t *)i1);
+    else
+	movi_f(rn(reg), (jit_float32_t *)i1);
+    w = bltgtr(db, i0, r0, rn(reg));
+    jit_unget_reg(reg);
+    return (w);
+}
+
+static void
+_movr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	LER(r0, r1);
+}
+
+static void
+_movi_f(jit_state_t *_jit, int32_t r0, jit_float32_t *i0)
+{
+    union {
+	int32_t	 i;
+	jit_float32_t	 f;
+    } data;
+    int32_t		 reg;
+
+    if (*(int32_t *)i0 == 0)
+	LZER(r0);
+    else if (_jitc->no_data) {
+	data.f = *i0;
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), data.i & 0xffffffff);
+	stxi_i(-4, _FP_REGNO, rn(reg));
+	jit_unget_reg_but_zero(reg);
+	ldxi_f(r0, _FP_REGNO, -4);
+    }
+    else
+	ldi_f(r0, (jit_word_t)i0);
+}
+
+static void
+_movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    if (r0 != r1)
+	LDR(r0, r1);
+}
+
+static void
+_movi_d(jit_state_t *_jit, int32_t r0, jit_float64_t *i0)
+{
+    union {
+#if __WORDSIZE == 32
+	int32_t	 i[2];
+#else
+	int64_t	 l;
+#endif
+	jit_float64_t	 d;
+    } data;
+    int32_t		 reg;
+
+    if (*(int64_t *)i0 == 0)
+	LZDR(r0);
+    else if (_jitc->no_data) {
+	data.d = *i0;
+	reg = jit_get_reg_but_zero(0);
+#if __WORDSIZE == 32
+	movi(rn(reg), data.i[0]);
+	stxi_i(-8, _FP_REGNO, rn(reg));
+	movi(rn(reg), data.i[1]);
+	stxi_i(-4, _FP_REGNO, rn(reg));
+#else
+	movi(rn(reg), data.l);
+	stxi_l(-8, _FP_REGNO, rn(reg));
+#endif
+	jit_unget_reg_but_zero(reg);
+	ldxi_d(r0, _FP_REGNO, -8);
+    }
+    else
+	ldi_d(r0, (jit_word_t)i0);
+}
+
+static void
+_addr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	AEBR(r0, r1);
+    else {
+	movr_f(r0, r1);
+	AEBR(r0, r2);
+    }
+}
+
+static void
+_addr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	ADBR(r0, r1);
+    else {
+	movr_d(r0, r1);
+	ADBR(r0, r2);
+    }
+}
+
+static void
+_subr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_fpr);
+	movr_f(rn(reg), r2);
+	movr_f(r0, r1);
+	SEBR(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr_f(r0, r1);
+	SEBR(r0, r2);
+    }
+}
+
+static void
+_subr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_fpr);
+	movr_d(rn(reg), r2);
+	movr_d(r0, r1);
+	SDBR(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr_d(r0, r1);
+	SDBR(r0, r2);
+    }
+}
+
+static void
+_mulr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	MEEBR(r0, r1);
+    else {
+	movr_f(r0, r1);
+	MEEBR(r0, r2);
+    }
+}
+
+static void
+_mulr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    if (r0 == r2)
+	MDBR(r0, r1);
+    else {
+	movr_d(r0, r1);
+	MDBR(r0, r2);
+    }
+}
+
+static void
+_divr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_fpr);
+	movr_f(rn(reg), r2);
+	movr_f(r0, r1);
+	DEBR(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr_f(r0, r1);
+	DEBR(r0, r2);
+    }
+}
+
+static void
+_divr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    if (r0 == r2) {
+	reg = jit_get_reg(jit_class_fpr);
+	movr_d(rn(reg), r2);
+	movr_d(r0, r1);
+	DDBR(r0, rn(reg));
+	jit_unget_reg(reg);
+    }
+    else {
+	movr_d(r0, r1);
+	DDBR(r0, r2);
+    }
+}
+
+static void
+_ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    ldr_f(r0, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    ldr_d(r0, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r1);
+    addr(rn(reg), rn(reg), r2);
+    ldr_f(r0, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r1);
+    addr(rn(reg), rn(reg), r2);
+    ldr_d(r0, rn(reg));
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	LE(r0, i0, 0, r1);
+    else if (s20_p(i0))
+	LEY(r0, x20(i0), 0, r1);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_f(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	LD(r0, i0, 0, r1);
+    else if (s20_p(i0))
+	LDY(r0, x20(i0), 0, r1);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r1);
+	ldr_d(r0, rn(reg));
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_f(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movi(rn(reg), i0);
+    str_d(rn(reg), r0);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_f(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    int32_t		reg;
+    reg = jit_get_reg_but_zero(0);
+    movr(rn(reg), r0);
+    addr(rn(reg), rn(reg), r1);
+    str_d(rn(reg), r2);
+    jit_unget_reg_but_zero(reg);
+}
+
+static void
+_stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	STE(r1, i0, 0, r0);
+    else if (s20_p(i0))
+	STEY(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r0);
+	str_f(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+    int32_t		reg;
+    if (u12_p(i0))
+	STD(r1, i0, 0, r0);
+    else if (s20_p(i0))
+	STDY(r1, x20(i0), 0, r0);
+    else {
+	reg = jit_get_reg_but_zero(0);
+	movi(rn(reg), i0);
+	addr(rn(reg), rn(reg), r0);
+	str_d(rn(reg), r1);
+	jit_unget_reg_but_zero(reg);
+    }
+}
+
+static void
+_uneqr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		unord, eq;
+    movi(r0, 1);			/* set to one */
+    CEBR(r1, r2);
+    unord = _jit->pc.w;			/* keep set to one if unord */
+    BRC(CC_O, 0);
+    eq = _jit->pc.w;
+    BRC(CC_E, 0);			/* keep set to one if eq */
+    movi(r0, 0);			/* set to zero */
+    patch_at(unord, _jit->pc.w);
+    patch_at(eq, _jit->pc.w);
+}
+
+static void
+_uneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		unord, eq;
+    movi(r0, 1);			/* set to one */
+    CDBR(r1, r2);
+    unord = _jit->pc.w;			/* keep set to one if unord */
+    BRC(CC_O, 0);
+    eq = _jit->pc.w;
+    BRC(CC_E, 0);			/* keep set to one if eq */
+    movi(r0, 0);			/* set to zero */
+    patch_at(unord, _jit->pc.w);
+    patch_at(eq, _jit->pc.w);
+}
+
+static void
+_ltgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		unord, eq;
+    movi(r0, 0);			/* set to zero */
+    CEBR(r1, r2);
+    unord = _jit->pc.w;			/* keep set to zero if unord */
+    BRC(CC_O, 0);
+    eq = _jit->pc.w;
+    BRC(CC_E, 0);			/* keep set to zero if eq */
+    movi(r0, 1);			/* set to one */
+    patch_at(unord, _jit->pc.w);
+    patch_at(eq, _jit->pc.w);
+}
+
+static void
+_ltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+    jit_word_t		unord, eq;
+    movi(r0, 0);			/* set to zero */
+    CDBR(r1, r2);
+    unord = _jit->pc.w;			/* keep set to zero if unord */
+    BRC(CC_O, 0);
+    eq = _jit->pc.w;
+    BRC(CC_E, 0);			/* keep set to zero if eq */
+    movi(r0, 1);			/* set to one */
+    patch_at(unord, _jit->pc.w);
+    patch_at(eq, _jit->pc.w);
+}
+
+static void
+_vaarg_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+    int32_t		rg0;
+    int32_t		rg1;
+    int32_t		rg2;
+    jit_word_t		ge_code;
+    jit_word_t		lt_code;
+
+    assert(_jitc->function->self.call & jit_call_varargs);
+
+    rg0 = jit_get_reg_but_zero(jit_class_gpr);
+    rg1 = jit_get_reg_but_zero(jit_class_gpr);
+
+    /* Load the fp offset in save area in the first temporary. */
+    ldxi(rn(rg0), r1, offsetof(jit_va_list_t, fpoff));
+
+    /* Jump over if there are no remaining arguments in the save area. */
+    ge_code = bgei_p(_jit->pc.w, rn(rg0), NUM_FLOAT_REG_ARGS);
+
+    /* Load the save area pointer in the second temporary. */
+    ldxi(rn(rg1), r1, offsetof(jit_va_list_t, save));
+
+    /* Scale offset. */
+    rg2 = jit_get_reg_but_zero(0);
+    lshi(rn(rg2), rn(rg0), 3);
+    /* Add offset to saved area */
+    addi(rn(rg2), rn(rg2), 16 * sizeof(jit_word_t));
+
+    /* Load the vararg argument in the first argument. */
+    ldxr_d(r0, rn(rg1), rn(rg2));
+    jit_unget_reg_but_zero(rg2);
+
+    /* Update the fp offset. */
+    addi(rn(rg0), rn(rg0), 1);
+    stxi(offsetof(jit_va_list_t, fpoff), r1, rn(rg0));
+
+    /* Will only need one temporary register below. */
+    jit_unget_reg_but_zero(rg1);
+
+    /* Jump over overflow code. */
+    lt_code = jmpi_p(_jit->pc.w);
+
+    /* Where to land if argument is in overflow area. */
+    patch_at(ge_code, _jit->pc.w);
+
+    /* Load overflow pointer. */
+    ldxi(rn(rg0), r1, offsetof(jit_va_list_t, over));
+
+    /* Load argument. */
+    ldr_d(r0, rn(rg0));
+
+    /* Update overflow pointer. */
+    addi(rn(rg0), rn(rg0), sizeof(jit_float64_t));
+    stxi(offsetof(jit_va_list_t, over), r1, rn(rg0));
+
+    /* Where to land if argument is in save area. */
+    patch_at(lt_code, _jit->pc.w);
+
+    jit_unget_reg_but_zero(rg0);
+}
+#endif
diff --git a/libguile/lightening/lightening/s390.c b/libguile/lightening/lightening/s390.c
new file mode 100644
index 000000000..41e0de42f
--- /dev/null
+++ b/libguile/lightening/lightening/s390.c
@@ -0,0 +1,1691 @@
+/*
+ * Copyright (C) 2013-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+# define JIT_SP         _R15
+# define JIT_RET                _R2
+# define JIT_FRET               _F0
+
+#if __WORDSIZE == 32
+#  define NUM_FLOAT_REG_ARGS		2
+#else
+#  define NUM_FLOAT_REG_ARGS		4
+#endif
+#define jit_arg_reg_p(i)		((i) >= 0 && (i) < 5)
+#define jit_arg_f_reg_p(i)		((i) >= 0 && (i) < NUM_FLOAT_REG_ARGS)
+
+/*
+ * Types
+ */
+typedef struct jit_va_list {
+    /* The offsets are "1" based, as addresses are fixed in the
+     * standard stack frame format. */
+    jit_word_t		gpoff;
+    jit_word_t		fpoff;
+
+    /* Easier when there is an explicitly defined type...
+(gdb) ptype ap
+type = struct __va_list_tag {
+    long __gpr;
+    long __fpr;
+    void *__overflow_arg_area;
+    void *__reg_save_area;
+
+    Note that gopff (__gpr) and fpoff (__fpr) are jit_word_t equivalent
+    and, again, "1" (unit) based, so must be adjusted at va_arg time.
+ */
+    jit_pointer_t	over;
+    jit_pointer_t	save;
+
+    /* For variadic functions, always allocate space to save callee
+     * save fpr registers.
+     * Note that s390 has a standard stack frame format that lightning
+     * does not fully comply with, but for variadic functions it must,
+     * for those (variadic) do not use the "empty" spaces for any
+     * callee save fpr register, but save them after the va_list
+     * space; and use the standard stack frame format, as required
+     * by variadic functions (and have a compatible va_list pointer). */
+    jit_float64_t	f8;
+    jit_float64_t	f9;
+    jit_float64_t	f10;
+    jit_float64_t	f11;
+    jit_float64_t	f12;
+    jit_float64_t	f13;
+    jit_float64_t	f14;
+    jit_float64_t	f15;
+} jit_va_list_t;
+
+/*
+ * Prototypes
+ */
+#define jit_get_reg_pair()		_jit_get_reg_pair(_jit)
+static int32_t _jit_get_reg_pair(jit_state_t*);
+#define jit_unget_reg_pair(regno)	_jit_unget_reg_pair(_jit,regno)
+static void _jit_unget_reg_pair(jit_state_t*,int32_t);
+#define jit_get_reg_but_zero(flags)	_jit_get_reg_but_zero(_jit,flags)
+static int32_t _jit_get_reg_but_zero(jit_state_t*,int32_t);
+#define jit_unget_reg_but_zero(reg)	jit_unget_reg(reg)
+#define patch(instr, node)		_patch(_jit, instr, node)
+static void _patch(jit_state_t*,jit_word_t,jit_node_t*);
+
+/* libgcc */
+extern void __clear_cache(void *, void *);
+
+#define PROTO				1
+#  include "s390-cpu.c"
+#  include "s390-fpu.c"
+#undef PROTO
+
+/*
+ * Initialization
+ */
+static const jit_register_t _rvs[] = {
+    { rc(gpr) | 0x0,			"%r0" },
+    { rc(gpr) | 0x1,			"%r1" },
+    { rc(gpr) | rc(sav) | 0xc,		"%r12" },
+    { rc(gpr) | rc(sav) | 0xb,		"%r11" },
+    { rc(gpr) | rc(sav) | 0xa,		"%r10" },
+    { rc(gpr) | rc(sav) | 0x9,		"%r9" },
+    { rc(gpr) | rc(sav) | 0x8,		"%r8" },
+    { rc(gpr) | rc(sav) | 0x7,		"%r7" },
+    { rc(gpr) | rc(arg) | rc(sav) | 0x6,"%r6" },
+    { rc(gpr) | rc(arg) | 0x5,		"%r5" },
+    { rc(gpr) | rc(arg) | 0x4,		"%r4" },
+    { rc(gpr) | rc(arg) | 0x3,		"%r3" },
+    { rc(gpr) | rc(arg) | 0x2,		"%r2" },
+    { rc(sav) | 0xd,			"%r13" },	/* used as JIT_FP */
+    { 0xe,				"%r14" },
+    { rc(sav) | 0xf,			"%r15" },
+    { rc(fpr) | 0x1,			"%f1" },
+    { rc(fpr) | 0x3,			"%f3" },
+    { rc(fpr) | 0x5,			"%f5" },
+    { rc(fpr) | 0x7,			"%f7" },
+    { rc(fpr) | rc(sav) | 0xe,		"%f14" },
+    /* Do not use as temporary to simplify stack layout */
+    { 0xf,				"%f15" },
+    { rc(fpr) | rc(sav) | 0x8,		"%f8" },
+    { rc(fpr) | rc(sav) | 0x9,		"%f9" },
+    { rc(fpr) | rc(sav) | 0xa,		"%f10" },
+    { rc(fpr) | rc(sav) | 0xb,		"%f11" },
+    { rc(fpr) | rc(sav) | 0xc,		"%f12" },
+    { rc(fpr) | rc(sav) | 0xd,		"%f13" },
+    { rc(fpr) | rc(arg) | 0x6,		"%f6" },
+    { rc(fpr) | rc(arg) | 0x4,		"%f4" },
+    { rc(fpr) | rc(arg) | 0x2,		"%f2" },
+    { rc(fpr) | rc(arg) | 0x0,		"%f0" },
+    { _NOREG,				"<none>" },
+};
+
+/*
+ * Implementation
+ */
+void
+jit_get_cpu(void)
+{
+}
+
+void
+_jit_init(jit_state_t *_jit)
+{
+    _jitc->reglen = jit_size(_rvs) - 1;
+}
+
+void
+_jit_prolog(jit_state_t *_jit)
+{
+    int32_t		offset;
+
+    if (_jitc->function)
+	jit_epilog();
+    assert(jit_regset_cmp_ui(&_jitc->regarg, 0) == 0);
+    jit_regset_set_ui(&_jitc->regsav, 0);
+    offset = _jitc->functions.offset;
+    if (offset >= _jitc->functions.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->functions.ptr,
+		    _jitc->functions.length * sizeof(jit_function_t),
+		    (_jitc->functions.length + 16) * sizeof(jit_function_t));
+	_jitc->functions.length += 16;
+    }
+    _jitc->function = _jitc->functions.ptr + _jitc->functions.offset++;
+    _jitc->function->self.size = stack_framesize;
+    _jitc->function->self.argi = _jitc->function->self.argf =
+	_jitc->function->self.aoff = _jitc->function->self.alen = 0;
+    /* preallocate 8 bytes if not using a constant data buffer */
+    if (_jitc->no_data)
+	_jitc->function->self.aoff = -8;
+    _jitc->function->self.call = jit_call_default;
+    jit_alloc((jit_pointer_t *)&_jitc->function->regoff,
+	      _jitc->reglen * sizeof(int32_t));
+
+    /* _no_link here does not mean the jit_link() call can be removed
+     * by rewriting as:
+     * _jitc->function->prolog = jit_new_node(jit_code_prolog);
+     */
+    _jitc->function->prolog = jit_new_node_no_link(jit_code_prolog);
+    jit_link(_jitc->function->prolog);
+    _jitc->function->prolog->w.w = offset;
+    _jitc->function->epilog = jit_new_node_no_link(jit_code_epilog);
+    /*	u:	label value
+     *	v:	offset in blocks vector
+     *	w:	offset in functions vector
+     */
+    _jitc->function->epilog->w.w = offset;
+
+    jit_regset_new(&_jitc->function->regset);
+}
+
+int32_t
+_jit_allocai(jit_state_t *_jit, int32_t length)
+{
+    assert(_jitc->function);
+    switch (length) {
+	case 0:	case 1:						break;
+	case 2:		_jitc->function->self.aoff &= -2;	break;
+	case 3:	case 4:	_jitc->function->self.aoff &= -4;	break;
+	default:	_jitc->function->self.aoff &= -8;	break;
+    }
+    _jitc->function->self.aoff -= length;
+    if (!_jitc->realize) {
+	jit_inc_synth_ww(allocai, _jitc->function->self.aoff, length);
+	jit_dec_synth();
+    }
+    return (_jitc->function->self.aoff);
+}
+
+void
+_jit_allocar(jit_state_t *_jit, int32_t u, int32_t v)
+{
+    int32_t		 reg;
+    assert(_jitc->function);
+    jit_inc_synth_ww(allocar, u, v);
+    if (!_jitc->function->allocar) {
+	_jitc->function->aoffoff = jit_allocai(sizeof(int32_t));
+	_jitc->function->allocar = 1;
+    }
+    reg = jit_get_reg(jit_class_gpr);
+    jit_negr(reg, v);
+    jit_andi(reg, reg, -8);
+    jit_ldxi_i(u, JIT_FP, _jitc->function->aoffoff);
+    jit_addr(u, u, reg);
+    jit_addr(JIT_SP, JIT_SP, reg);
+    jit_stxi_i(_jitc->function->aoffoff, JIT_FP, u);
+    jit_unget_reg(reg);
+    jit_dec_synth();
+}
+
+void
+_jit_ret(jit_state_t *_jit)
+{
+    jit_node_t		*instr;
+    assert(_jitc->function);
+    jit_inc_synth(ret);
+    /* jump to epilog */
+    instr = jit_jmpi();
+    jit_patch_at(instr, _jitc->function->epilog);
+    jit_dec_synth();
+}
+
+void
+_jit_retr(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr, u);
+    jit_movr(JIT_RET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti(jit_state_t *_jit, jit_word_t u)
+{
+    jit_inc_synth_w(reti, u);
+    jit_movi(JIT_RET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_f(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_f, u);
+    jit_movr_f(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_f(jit_state_t *_jit, jit_float32_t u)
+{
+    jit_inc_synth_f(reti_f, u);
+    jit_movi_f(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_retr_d(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(retr_d, u);
+    jit_movr_d(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_reti_d(jit_state_t *_jit, jit_float64_t u)
+{
+    jit_inc_synth_d(reti_d, u);
+    jit_movi_d(JIT_FRET, u);
+    jit_ret();
+    jit_dec_synth();
+}
+
+void
+_jit_epilog(jit_state_t *_jit)
+{
+    assert(_jitc->function);
+    assert(_jitc->function->epilog->next == NULL);
+    jit_link(_jitc->function->epilog);
+    _jitc->function = NULL;
+}
+
+jit_bool_t
+_jit_arg_register_p(jit_state_t *_jit, jit_node_t *u)
+{
+    if (u->code == jit_code_arg)
+	return (jit_arg_reg_p(u->u.w));
+    assert(u->code == jit_code_arg_f || u->code == jit_code_arg_d);
+    return (jit_arg_f_reg_p(u->u.w));
+}
+
+void
+_jit_ellipsis(jit_state_t *_jit)
+{
+    jit_inc_synth(ellipsis);
+    if (_jitc->prepare) {
+	jit_link_prepare();
+	assert(!(_jitc->function->call.call & jit_call_varargs));
+	_jitc->function->call.call |= jit_call_varargs;
+    }
+    else {
+	jit_link_prolog();
+	assert(!(_jitc->function->self.call & jit_call_varargs));
+	_jitc->function->self.call |= jit_call_varargs;
+
+	/* Allocate va_list like object in the stack. */
+	_jitc->function->vaoff = jit_allocai(sizeof(jit_va_list_t));
+
+	/* Initialize gp offset in save area. */
+	if (jit_arg_reg_p(_jitc->function->self.argi))
+	    _jitc->function->vagp = _jitc->function->self.argi;
+	else
+	    _jitc->function->vagp = 5;
+
+	/* Initialize fp offset in save area. */
+	if (jit_arg_f_reg_p(_jitc->function->self.argf))
+	    _jitc->function->vafp = _jitc->function->self.argf;
+	else
+	    _jitc->function->vafp = NUM_FLOAT_REG_ARGS;
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_va_push(jit_state_t *_jit, int32_t u)
+{
+    jit_inc_synth_w(va_push, u);
+    jit_pushargr(u);
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_arg(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_reg_p(_jitc->function->self.argi))
+	offset = _jitc->function->self.argi++;
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += sizeof(jit_word_t);
+    }
+    node = jit_new_node_ww(jit_code_arg, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+jit_node_t *
+_jit_arg_f(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_f_reg_p(_jitc->function->self.argf))
+	offset = _jitc->function->self.argf++;
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += sizeof(jit_word_t);
+    }
+    node = jit_new_node_ww(jit_code_arg_f, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+jit_node_t *
+_jit_arg_d(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    int32_t		 offset;
+    assert(_jitc->function);
+    if (jit_arg_f_reg_p(_jitc->function->self.argf))
+	offset = _jitc->function->self.argf++;
+    else {
+	offset = _jitc->function->self.size;
+	_jitc->function->self.size += sizeof(jit_float64_t);
+    }
+    node = jit_new_node_ww(jit_code_arg_d, offset,
+			   ++_jitc->function->self.argn);
+    jit_link_prolog();
+    return (node);
+}
+
+void
+_jit_getarg_c(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_c, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_c(u, _R2 - v->u.w);
+    else
+	jit_ldxi_c(u, JIT_FP,
+		   v->u.w + (__WORDSIZE >> 3) - sizeof(int8_t));
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_uc(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_uc, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_uc(u, _R2 - v->u.w);
+    else
+	jit_ldxi_uc(u, JIT_FP,
+		    v->u.w + (__WORDSIZE >> 3) - sizeof(uint8_t));
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_s(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_s, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_s(u, _R2 - v->u.w);
+    else
+	jit_ldxi_s(u, JIT_FP,
+		   v->u.w + (__WORDSIZE >> 3) - sizeof(int16_t));
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_us(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_us, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_us(u, _R2 - v->u.w);
+    else
+	jit_ldxi_us(u, JIT_FP,
+		    v->u.w + (__WORDSIZE >> 3) - sizeof(uint16_t));
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_i(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_i, u, v);
+    if (jit_arg_reg_p(v->u.w)) {
+#if __WORDSIZE == 32
+	jit_movr(u, _R2 - v->u.w);
+#else
+	jit_extr_i(u, _R2 - v->u.w);
+#endif
+    }
+    else
+	jit_ldxi_i(u, JIT_FP,
+		   v->u.w + (__WORDSIZE >> 3) - sizeof(int32_t));
+    jit_dec_synth();
+}
+
+#if __WORDSIZE == 64
+void
+_jit_getarg_ui(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_ui, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_extr_ui(u, _R2 - v->u.w);
+    else
+	jit_ldxi_ui(u, JIT_FP,
+		    v->u.w + (__WORDSIZE >> 3) - sizeof(uint32_t));
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_l(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(getarg_l, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(u, _R2 - v->u.w);
+    else
+	jit_ldxi_l(u, JIT_FP, v->u.w);
+    jit_dec_synth();
+}
+#endif
+
+void
+_jit_putargr(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(putargr, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movr(_R2 - v->u.w, u);
+    else
+	jit_stxi(v->u.w, JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi(jit_state_t *_jit, jit_word_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg);
+    jit_inc_synth_wp(putargi, u, v);
+    if (jit_arg_reg_p(v->u.w))
+	jit_movi(_R2 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(v->u.w, JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(getarg_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_f(u, _F0 - v->u.w);
+    else
+	jit_ldxi_f(u, JIT_FP,
+		   v->u.w
+#if __WORDSIZE == 64
+		   + (__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+		   );
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_f(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_wp(putargr_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_f(_F0 - v->u.w, u);
+    else
+	jit_stxi_f(v->u.w
+#if __WORDSIZE == 64
+		   + (__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+		   , JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_f(jit_state_t *_jit, jit_float32_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_f);
+    jit_inc_synth_fp(putargi_f, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movi_f(_F0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+	jit_stxi_f(v->u.w
+#if __WORDSIZE == 64
+		   + (__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+		   , JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_getarg_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(getarg_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(u, _F0 - v->u.w);
+    else
+	jit_ldxi_d(u, JIT_FP, v->u.w);
+    jit_dec_synth();
+}
+
+void
+_jit_putargr_d(jit_state_t *_jit, int32_t u, jit_node_t *v)
+{
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_wp(putargr_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movr_d(_F0 - v->u.w, u);
+    else
+	jit_stxi_d(v->u.w, JIT_FP, u);
+    jit_dec_synth();
+}
+
+void
+_jit_putargi_d(jit_state_t *_jit, jit_float64_t u, jit_node_t *v)
+{
+    int32_t		regno;
+    assert(v->code == jit_code_arg_d);
+    jit_inc_synth_dp(putargi_d, u, v);
+    if (jit_arg_f_reg_p(v->u.w))
+	jit_movi_d(_F0 - v->u.w, u);
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+	jit_stxi_d(v->u.w, JIT_FP, regno);
+	jit_unget_reg(regno);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr, u);
+    jit_link_prepare();
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movr(_R2 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	jit_stxi(_jitc->function->call.size + stack_framesize, JIT_SP, u);
+	_jitc->function->call.size += sizeof(jit_word_t);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi(jit_state_t *_jit, jit_word_t u)
+{
+    int32_t		 regno;
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargi, u);
+    jit_link_prepare();
+    if (jit_arg_reg_p(_jitc->function->call.argi)) {
+	jit_movi(_R2 - _jitc->function->call.argi, u);
+	++_jitc->function->call.argi;
+    }
+    else {
+	regno = jit_get_reg(jit_class_gpr);
+	jit_movi(regno, u);
+	jit_stxi(_jitc->function->call.size + stack_framesize, JIT_SP, regno);
+	jit_unget_reg(regno);
+	_jitc->function->call.size += sizeof(jit_word_t);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_f(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_f, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf)) {
+	jit_movr_f(_F0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+    }
+    else {
+	jit_stxi_f(_jitc->function->call.size + stack_framesize
+#if __WORDSIZE == 64
+		   + (__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+		   , JIT_SP, u);
+	_jitc->function->call.size += sizeof(jit_word_t);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_f(jit_state_t *_jit, jit_float32_t u)
+{
+    int32_t		regno;
+    assert(_jitc->function);
+    jit_inc_synth_f(pushargi_f, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf)) {
+	jit_movi_f(_F0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_f(regno, u);
+ 	jit_stxi_f(_jitc->function->call.size + stack_framesize
+#if __WORDSIZE == 64
+		   + (__WORDSIZE >> 3) - sizeof(jit_float32_t)
+#endif
+		   , JIT_SP, regno);
+	jit_unget_reg(regno);
+	_jitc->function->call.size += sizeof(jit_word_t);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargr_d(jit_state_t *_jit, int32_t u)
+{
+    assert(_jitc->function);
+    jit_inc_synth_w(pushargr_d, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf)) {
+	jit_movr_d(_F0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+    }
+    else {
+	jit_stxi_d(_jitc->function->call.size + stack_framesize, JIT_SP, u);
+	_jitc->function->call.size += sizeof(jit_float64_t);
+    }
+    jit_dec_synth();
+}
+
+void
+_jit_pushargi_d(jit_state_t *_jit, jit_float64_t u)
+{
+    int32_t		regno;
+    assert(_jitc->function);
+    jit_inc_synth_d(pushargi_d, u);
+    jit_link_prepare();
+    if (jit_arg_f_reg_p(_jitc->function->call.argf)) {
+	jit_movi_d(_F0 - _jitc->function->call.argf, u);
+	++_jitc->function->call.argf;
+    }
+    else {
+	regno = jit_get_reg(jit_class_fpr);
+	jit_movi_d(regno, u);
+ 	jit_stxi_d(_jitc->function->call.size + stack_framesize, JIT_SP, regno);
+	jit_unget_reg(regno);
+	_jitc->function->call.size += sizeof(jit_float64_t);
+    }
+    jit_dec_synth();
+}
+
+jit_bool_t
+_jit_regarg_p(jit_state_t *_jit, jit_node_t *node, int32_t regno)
+{
+    int32_t		spec;
+    spec = jit_class(_rvs[regno].spec);
+    if (spec & jit_class_arg) {
+	regno = _R2 - regno;
+	if (regno >= 0 && regno < node->v.w)
+	    return (1);
+	if (spec & jit_class_fpr) {
+	    regno = _F0 - regno;
+	    if (regno >= 0 && regno < node->w.w)
+		return (1);
+	}
+    }
+    return (0);
+}
+
+void
+_jit_finishr(jit_state_t *_jit, int32_t r0)
+{
+    jit_node_t		*call;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishr, r0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    call = jit_callr(r0);
+    call->v.w = _jitc->function->call.argi;
+    call->w.w = _jitc->function->call.argf;
+    _jitc->function->call.argi = _jitc->function->call.argf =
+	_jitc->function->call.size = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+}
+
+jit_node_t *
+_jit_finishi(jit_state_t *_jit, jit_pointer_t i0)
+{
+    jit_node_t		*node;
+    assert(_jitc->function);
+    jit_inc_synth_w(finishi, (jit_word_t)i0);
+    if (_jitc->function->self.alen < _jitc->function->call.size)
+	_jitc->function->self.alen = _jitc->function->call.size;
+    node = jit_calli(i0);
+    node->v.w = _jitc->function->call.argi;
+    node->w.w = _jitc->function->call.argf;
+    _jitc->function->call.argi = _jitc->function->call.argf =
+	_jitc->function->call.size = 0;
+    _jitc->prepare = 0;
+    jit_dec_synth();
+    return (node);
+}
+
+void
+_jit_retval_c(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_c, r0);
+    jit_extr_c(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_uc(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_uc, r0);
+    jit_extr_uc(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_s(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_s, r0);
+    jit_extr_s(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_us(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_us, r0);
+    jit_extr_us(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_i(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_i, r0);
+#if __WORDSIZE == 64
+    jit_extr_i(r0, JIT_RET);
+#else
+    jit_movr(r0, JIT_RET);
+#endif
+    jit_dec_synth();
+}
+
+#if __WORDSIZE == 64
+void
+_jit_retval_ui(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_ui, r0);
+    jit_extr_ui(r0, JIT_RET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_l(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_l, r0);
+    jit_movr(r0, JIT_RET);
+    jit_dec_synth();
+}
+#endif
+
+void
+_jit_retval_f(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_f, r0);
+    jit_movr_f(r0, JIT_FRET);
+    jit_dec_synth();
+}
+
+void
+_jit_retval_d(jit_state_t *_jit, int32_t r0)
+{
+    jit_inc_synth_w(retval_d, r0);
+    jit_movr_d(r0, JIT_FRET);
+    jit_dec_synth();
+}
+
+jit_pointer_t
+_emit_code(jit_state_t *_jit)
+{
+    jit_node_t		*node;
+    jit_node_t		*temp;
+    jit_word_t		 word;
+    int32_t		 value;
+    int32_t		 offset;
+    struct {
+	jit_node_t	*node;
+	jit_word_t	 word;
+#if DEVEL_DISASSEMBLER
+	jit_word_t	 prevw;
+#endif
+	int32_t	 patch_offset;
+    } undo;
+#if DEVEL_DISASSEMBLER
+    jit_word_t		 prevw;
+#endif
+
+    _jitc->function = NULL;
+
+    jit_reglive_setup();
+
+    undo.word = 0;
+    undo.node = NULL;
+    undo.patch_offset = 0;
+
+#define assert_data(node)		/**/
+#define case_rr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w), rn(node->v.w));		\
+		break
+#define case_rw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), node->v.w);		\
+		break
+#define case_wr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w));		\
+		break
+#define case_rrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.w),				\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrrr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		name##r##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), rn(node->w.w));		\
+		break
+#define case_rrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.w), rn(node->v.w), node->w.w);	\
+		break
+#define case_rrrw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(rn(node->u.q.l), rn(node->u.q.h),		\
+			      rn(node->v.w), node->w.w);		\
+		break
+#define case_rrf(name)							\
+	    case jit_code_##name##i_f:					\
+		assert_data(node);					\
+		name##i_f(rn(node->u.w), rn(node->v.w),			\
+			  (jit_float32_t *)node->w.n->u.w);		\
+		break
+#define case_rrd(name)							\
+	    case jit_code_##name##i_d:					\
+		assert_data(node);					\
+		name##i_d(rn(node->u.w), rn(node->v.w),			\
+			  (jit_float64_t *)node->w.n->u.w);		\
+		break
+#define case_wrr(name, type)						\
+	    case jit_code_##name##i##type:				\
+		name##i##type(node->u.w, rn(node->v.w), rn(node->w.w));	\
+		break
+#define case_brr(name, type)						\
+	    case jit_code_##name##r##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##r##type(temp->u.w, rn(node->v.w),		\
+				  rn(node->w.w));			\
+		else {							\
+		    word = name##r##type##_p(_jit->pc.w,		\
+					     rn(node->v.w),		\
+					     rn(node->w.w));		\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brw(name, type)						\
+	    case jit_code_##name##i##type:				\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i##type(temp->u.w,				\
+				  rn(node->v.w), node->w.w);		\
+		else {							\
+		    word = name##i##type##_p(_jit->pc.w,		\
+					     rn(node->v.w), node->w.w);	\
+		    patch(word, node);					\
+		}							\
+		break;
+#define case_brf(name)							\
+	    case jit_code_##name##i_f:					\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i_f(temp->u.w, rn(node->v.w),			\
+			      (jit_float32_t *)node->w.n->u.w);		\
+		else {							\
+		    word = name##i_f_p(_jit->pc.w, rn(node->v.w),	\
+				       (jit_float32_t *)node->w.n->u.w);\
+		    patch(word, node);					\
+		}							\
+		break
+#define case_brd(name)							\
+	    case jit_code_##name##i_d:					\
+		temp = node->u.n;					\
+		assert(temp->code == jit_code_label ||			\
+		       temp->code == jit_code_epilog);			\
+		if (temp->flag & jit_flag_patch)			\
+		    name##i_d(temp->u.w, rn(node->v.w),			\
+			      (jit_float64_t *)node->w.n->u.w);		\
+		else {							\
+		    word = name##i_d_p(_jit->pc.w, rn(node->v.w),	\
+				       (jit_float64_t *)node->w.n->u.w);\
+		    patch(word, node);					\
+		}							\
+		break
+#if DEVEL_DISASSEMBLER
+    prevw = _jit->pc.w;
+#endif
+    for (node = _jitc->head; node; node = node->next) {
+	if (_jit->pc.uc >= _jitc->code.end)
+	    return (NULL);
+
+#if DEVEL_DISASSEMBLER
+	node->offset = (jit_uword_t)_jit->pc.w - (jit_uword_t)prevw;
+	prevw = _jit->pc.w;
+#endif
+	value = jit_classify(node->code);
+	jit_regarg_set(node, value);
+	switch (node->code) {
+	    case jit_code_align:
+		assert(!(node->u.w & (node->u.w - 1)) &&
+		       node->u.w <= sizeof(jit_word_t));
+		if (node->u.w == sizeof(jit_word_t) &&
+		    (word = _jit->pc.w & (sizeof(jit_word_t) - 1)))
+		    nop(sizeof(jit_word_t) - word);
+		break;
+	    case jit_code_note:		case jit_code_name:
+		node->u.w = _jit->pc.w;
+		break;
+	    case jit_code_label:
+		if ((node->link || (node->flag & jit_flag_use)) &&
+		    (word = _jit->pc.w & 3))
+		    nop(4 - word);
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		break;
+		case_rrr(add,);
+		case_rrw(add,);
+		case_rrr(addc,);
+		case_rrw(addc,);
+		case_rrr(addx,);
+		case_rrw(addx,);
+		case_rrr(sub,);
+		case_rrw(sub,);
+		case_rrr(subc,);
+		case_rrw(subc,);
+		case_rrr(subx,);
+		case_rrw(subx,);
+		case_rrw(rsb,);
+		case_rrr(mul,);
+		case_rrw(mul,);
+		case_rrrr(qmul,);
+		case_rrrw(qmul,);
+		case_rrrr(qmul, _u);
+		case_rrrw(qmul, _u);
+		case_rrr(div,);
+		case_rrw(div,);
+		case_rrr(div, _u);
+		case_rrw(div, _u);
+		case_rrr(rem,);
+		case_rrw(rem,);
+		case_rrr(rem, _u);
+		case_rrw(rem, _u);
+		case_rrrr(qdiv,);
+		case_rrrw(qdiv,);
+		case_rrrr(qdiv, _u);
+		case_rrrw(qdiv, _u);
+		case_rrr(lsh,);
+		case_rrw(lsh,);
+		case_rrr(rsh,);
+		case_rrw(rsh,);
+		case_rrr(rsh, _u);
+		case_rrw(rsh, _u);
+		case_rr(neg,);
+		case_rr(com,);
+		case_rrr(and,);
+		case_rrw(and,);
+		case_rrr(or,);
+		case_rrw(or,);
+		case_rrr(xor,);
+		case_rrw(xor,);
+		case_rr(trunc, _f_i);
+		case_rr(trunc, _d_i);
+#if __WORDSIZE == 64
+		case_rr(trunc, _f_l);
+		case_rr(trunc, _d_l);
+#endif
+		case_rr(ld, _c);
+		case_rw(ld, _c);
+		case_rr(ld, _uc);
+		case_rw(ld, _uc);
+		case_rr(ld, _s);
+		case_rw(ld, _s);
+		case_rr(ld, _us);
+		case_rw(ld, _us);
+		case_rr(ld, _i);
+		case_rw(ld, _i);
+#if __WORDSIZE == 64
+		case_rr(ld, _ui);
+		case_rw(ld, _ui);
+		case_rr(ld, _l);
+		case_rw(ld, _l);
+#endif
+		case_rrr(ldx, _c);
+		case_rrw(ldx, _c);
+		case_rrr(ldx, _uc);
+		case_rrw(ldx, _uc);
+		case_rrr(ldx, _s);
+		case_rrw(ldx, _s);
+		case_rrr(ldx, _us);
+		case_rrw(ldx, _us);
+		case_rrr(ldx, _i);
+		case_rrw(ldx, _i);
+#if __WORDSIZE == 64
+		case_rrr(ldx, _ui);
+		case_rrw(ldx, _ui);
+		case_rrr(ldx, _l);
+		case_rrw(ldx, _l);
+#endif
+		case_rr(st, _c);
+		case_wr(st, _c);
+		case_rr(st, _s);
+		case_wr(st, _s);
+		case_rr(st, _i);
+		case_wr(st, _i);
+#if __WORDSIZE == 64
+		case_rr(st, _l);
+		case_wr(st, _l);
+#endif
+		case_rrr(stx, _c);
+		case_wrr(stx, _c);
+		case_rrr(stx, _s);
+		case_wrr(stx, _s);
+		case_rrr(stx, _i);
+		case_wrr(stx, _i);
+#if __WORDSIZE == 64
+		case_rrr(stx, _l);
+		case_wrr(stx, _l);
+#endif
+		case_rr(hton, _us);
+		case_rr(hton, _ui);
+#if __WORDSIZE == 64
+		case_rr(hton, _ul);
+#endif
+		case_rr(ext, _c);
+		case_rr(ext, _uc);
+		case_rr(ext, _s);
+		case_rr(ext, _us);
+#if __WORDSIZE == 64
+		case_rr(ext, _i);
+		case_rr(ext, _ui);
+#endif
+		case_rr(mov,);
+	    case jit_code_movi:
+		if (node->flag & jit_flag_node) {
+		    temp = node->v.n;
+		    if (temp->code == jit_code_data ||
+			(temp->code == jit_code_label &&
+			 (temp->flag & jit_flag_patch)))
+			movi(rn(node->u.w), temp->u.w);
+		    else {
+			assert(temp->code == jit_code_label ||
+			       temp->code == jit_code_epilog);
+			word = movi_p(rn(node->u.w), temp->u.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    movi(rn(node->u.w), node->v.w);
+		break;
+		case_rrr(lt,);
+		case_rrw(lt,);
+		case_rrr(lt, _u);
+		case_rrw(lt, _u);
+		case_rrr(le,);
+		case_rrw(le,);
+		case_rrr(le, _u);
+		case_rrw(le, _u);
+		case_rrr(eq,);
+		case_rrw(eq,);
+		case_rrr(ge,);
+		case_rrw(ge,);
+		case_rrr(ge, _u);
+		case_rrw(ge, _u);
+		case_rrr(gt,);
+		case_rrw(gt,);
+		case_rrr(gt, _u);
+		case_rrw(gt, _u);
+		case_rrr(ne,);
+		case_rrw(ne,);
+		case_brr(blt,);
+		case_brw(blt,);
+		case_brr(blt, _u);
+		case_brw(blt, _u);
+		case_brr(ble,);
+		case_brw(ble,);
+		case_brr(ble, _u);
+		case_brw(ble, _u);
+		case_brr(beq,);
+		case_brw(beq,);
+		case_brr(bge,);
+		case_brw(bge,);
+		case_brr(bge, _u);
+		case_brw(bge, _u);
+		case_brr(bgt,);
+		case_brw(bgt,);
+		case_brr(bgt, _u);
+		case_brw(bgt, _u);
+		case_brr(bne,);
+		case_brw(bne,);
+		case_brr(boadd,);
+		case_brw(boadd,);
+		case_brr(boadd, _u);
+		case_brw(boadd, _u);
+		case_brr(bxadd,);
+		case_brw(bxadd,);
+		case_brr(bxadd, _u);
+		case_brw(bxadd, _u);
+		case_brr(bosub,);
+		case_brw(bosub,);
+		case_brr(bosub, _u);
+		case_brw(bosub, _u);
+		case_brr(bxsub,);
+		case_brw(bxsub,);
+		case_brr(bxsub, _u);
+		case_brw(bxsub, _u);
+		case_brr(bms,);
+		case_brw(bms,);
+		case_brr(bmc,);
+		case_brw(bmc,);
+		case_rrr(add, _f);
+		case_rrf(add);
+		case_rrr(sub, _f);
+		case_rrf(sub);
+		case_rrf(rsb);
+		case_rrr(mul, _f);
+		case_rrf(mul);
+		case_rrr(div, _f);
+		case_rrf(div);
+		case_rr(abs, _f);
+		case_rr(neg, _f);
+		case_rr(sqrt, _f);
+		case_rr(ext, _f);
+		case_rr(ld, _f);
+		case_rw(ld, _f);
+		case_rrr(ldx, _f);
+		case_rrw(ldx, _f);
+		case_rr(st, _f);
+		case_wr(st, _f);
+		case_rrr(stx, _f);
+		case_wrr(stx, _f);
+		case_rr(mov, _f);
+	    case jit_code_movi_f:
+		assert_data(node);
+		movi_f(rn(node->u.w), (jit_float32_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _d_f);
+		case_rrr(lt, _f);
+		case_rrf(lt);
+		case_rrr(le, _f);
+		case_rrf(le);
+		case_rrr(eq, _f);
+		case_rrf(eq);
+		case_rrr(ge, _f);
+		case_rrf(ge);
+		case_rrr(gt, _f);
+		case_rrf(gt);
+		case_rrr(ne, _f);
+		case_rrf(ne);
+		case_rrr(unlt, _f);
+		case_rrf(unlt);
+		case_rrr(unle, _f);
+		case_rrf(unle);
+		case_rrr(uneq, _f);
+		case_rrf(uneq);
+		case_rrr(unge, _f);
+		case_rrf(unge);
+		case_rrr(ungt, _f);
+		case_rrf(ungt);
+		case_rrr(ltgt, _f);
+		case_rrf(ltgt);
+		case_rrr(ord, _f);
+		case_rrf(ord);
+		case_rrr(unord, _f);
+		case_rrf(unord);
+		case_brr(blt, _f);
+		case_brf(blt);
+		case_brr(ble, _f);
+		case_brf(ble);
+		case_brr(beq, _f);
+		case_brf(beq);
+		case_brr(bge, _f);
+		case_brf(bge);
+		case_brr(bgt, _f);
+		case_brf(bgt);
+		case_brr(bne, _f);
+		case_brf(bne);
+		case_brr(bunlt, _f);
+		case_brf(bunlt);
+		case_brr(bunle, _f);
+		case_brf(bunle);
+		case_brr(buneq, _f);
+		case_brf(buneq);
+		case_brr(bunge, _f);
+		case_brf(bunge);
+		case_brr(bungt, _f);
+		case_brf(bungt);
+		case_brr(bltgt, _f);
+		case_brf(bltgt);
+		case_brr(bord, _f);
+		case_brf(bord);
+		case_brr(bunord, _f);
+		case_brf(bunord);
+		case_rrr(add, _d);
+		case_rrd(add);
+		case_rrr(sub, _d);
+		case_rrd(sub);
+		case_rrd(rsb);
+		case_rrr(mul, _d);
+		case_rrd(mul);
+		case_rrr(div, _d);
+		case_rrd(div);
+		case_rr(abs, _d);
+		case_rr(neg, _d);
+		case_rr(sqrt, _d);
+		case_rr(ext, _d);
+		case_rr(ld, _d);
+		case_rw(ld, _d);
+		case_rrr(ldx, _d);
+		case_rrw(ldx, _d);
+		case_rr(st, _d);
+		case_wr(st, _d);
+		case_rrr(stx, _d);
+		case_wrr(stx, _d);
+		case_rr(mov, _d);
+	    case jit_code_movi_d:
+		assert_data(node);
+		movi_d(rn(node->u.w), (jit_float64_t *)node->v.n->u.w);
+		break;
+		case_rr(ext, _f_d);
+		case_rrr(lt, _d);
+		case_rrd(lt);
+		case_rrr(le, _d);
+		case_rrd(le);
+		case_rrr(eq, _d);
+		case_rrd(eq);
+		case_rrr(ge, _d);
+		case_rrd(ge);
+		case_rrr(gt, _d);
+		case_rrd(gt);
+		case_rrr(ne, _d);
+		case_rrd(ne);
+		case_rrr(unlt, _d);
+		case_rrd(unlt);
+		case_rrr(unle, _d);
+		case_rrd(unle);
+		case_rrr(uneq, _d);
+		case_rrd(uneq);
+		case_rrr(unge, _d);
+		case_rrd(unge);
+		case_rrr(ungt, _d);
+		case_rrd(ungt);
+		case_rrr(ltgt, _d);
+		case_rrd(ltgt);
+		case_rrr(ord, _d);
+		case_rrd(ord);
+		case_rrr(unord, _d);
+		case_rrd(unord);
+		case_brr(blt, _d);
+		case_brd(blt);
+		case_brr(ble, _d);
+		case_brd(ble);
+		case_brr(beq, _d);
+		case_brd(beq);
+		case_brr(bge, _d);
+		case_brd(bge);
+		case_brr(bgt, _d);
+		case_brd(bgt);
+		case_brr(bne, _d);
+		case_brd(bne);
+		case_brr(bunlt, _d);
+		case_brd(bunlt);
+		case_brr(bunle, _d);
+		case_brd(bunle);
+		case_brr(buneq, _d);
+		case_brd(buneq);
+		case_brr(bunge, _d);
+		case_brd(bunge);
+		case_brr(bungt, _d);
+		case_brd(bungt);
+		case_brr(bltgt, _d);
+		case_brd(bltgt);
+		case_brr(bord, _d);
+		case_brd(bord);
+		case_brr(bunord, _d);
+		case_brd(bunord);
+	    case jit_code_jmpr:
+		jmpr(rn(node->u.w));
+		break;
+	    case jit_code_jmpi:
+		if (node->flag & jit_flag_node) {
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    if (temp->flag & jit_flag_patch)
+			jmpi(temp->u.w);
+		    else {
+			word = jmpi_p(_jit->pc.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    jmpi(node->u.w);
+		break;
+	    case jit_code_callr:
+		callr(rn(node->u.w));
+		break;
+	    case jit_code_calli:
+		if (node->flag & jit_flag_node) {
+		    temp = node->u.n;
+		    assert(temp->code == jit_code_label ||
+			   temp->code == jit_code_epilog);
+		    if (temp->flag & jit_flag_patch)
+			calli(temp->u.w);
+		    else {
+			word = calli_p(_jit->pc.w);
+			patch(word, node);
+		    }
+		}
+		else
+		    calli(node->u.w);
+		break;
+	    case jit_code_prolog:
+		_jitc->function = _jitc->functions.ptr + node->w.w;
+		undo.node = node;
+		undo.word = _jit->pc.w;
+#if DEVEL_DISASSEMBLER
+		undo.prevw = prevw;
+#endif
+		undo.patch_offset = _jitc->patches.offset;
+	    restart_function:
+		_jitc->again = 0;
+		prolog(node);
+		break;
+	    case jit_code_epilog:
+		assert(_jitc->function == _jitc->functions.ptr + node->w.w);
+		if (_jitc->again) {
+		    for (temp = undo.node->next;
+			 temp != node; temp = temp->next) {
+			if (temp->code == jit_code_label ||
+			    temp->code == jit_code_epilog)
+			    temp->flag &= ~jit_flag_patch;
+		    }
+		    temp->flag &= ~jit_flag_patch;
+		    node = undo.node;
+		    _jit->pc.w = undo.word;
+#if DEVEL_DISASSEMBLER
+		    prevw = undo.prevw;
+#endif
+		    _jitc->patches.offset = undo.patch_offset;
+		    goto restart_function;
+		}
+		if (node->link && (word = _jit->pc.w & 3))
+		    nop(4 - word);
+		/* remember label is defined */
+		node->flag |= jit_flag_patch;
+		node->u.w = _jit->pc.w;
+		epilog(node);
+		_jitc->function = NULL;
+		break;
+	    case jit_code_va_start:
+		vastart(rn(node->u.w));
+		break;
+	    case jit_code_va_arg:
+		vaarg(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_va_arg_d:
+		vaarg_d(rn(node->u.w), rn(node->v.w));
+		break;
+	    case jit_code_live:			case jit_code_ellipsis:
+	    case jit_code_va_push:
+	    case jit_code_allocai:		case jit_code_allocar:
+	    case jit_code_arg:
+	    case jit_code_arg_f:		case jit_code_arg_d:
+	    case jit_code_va_end:
+	    case jit_code_ret:
+	    case jit_code_retr:			case jit_code_reti:
+	    case jit_code_retr_f:		case jit_code_reti_f:
+	    case jit_code_retr_d:		case jit_code_reti_d:
+	    case jit_code_getarg_c:		case jit_code_getarg_uc:
+	    case jit_code_getarg_s:		case jit_code_getarg_us:
+	    case jit_code_getarg_i:
+#if __WORDSIZE == 64
+	    case jit_code_getarg_ui:		case jit_code_getarg_l:
+#endif
+	    case jit_code_getarg_f:		case jit_code_getarg_d:
+	    case jit_code_putargr:		case jit_code_putargi:
+	    case jit_code_putargr_f:		case jit_code_putargi_f:
+	    case jit_code_putargr_d:		case jit_code_putargi_d:
+	    case jit_code_pushargr:		case jit_code_pushargi:
+	    case jit_code_pushargr_f:		case jit_code_pushargi_f:
+	    case jit_code_pushargr_d:		case jit_code_pushargi_d:
+	    case jit_code_retval_c:		case jit_code_retval_uc:
+	    case jit_code_retval_s:		case jit_code_retval_us:
+	    case jit_code_retval_i:
+#if __WORDSIZE == 64
+	    case jit_code_retval_ui:		case jit_code_retval_l:
+#endif
+	    case jit_code_retval_f:		case jit_code_retval_d:
+	    case jit_code_prepare:
+	    case jit_code_finishr:		case jit_code_finishi:
+		break;
+	    default:
+		abort();
+	}
+	jit_regarg_clr(node, value);
+	assert(_jitc->regarg == 0 && _jitc->synth == 0);
+	/* update register live state */
+	jit_reglive(node);
+    }
+#undef case_brw
+#undef case_brr
+#undef case_wrr
+#undef case_rrw
+#undef case_rrr
+#undef case_wr
+#undef case_rw
+#undef case_rr
+
+    for (offset = 0; offset < _jitc->patches.offset; offset++) {
+	node = _jitc->patches.ptr[offset].node;
+	word = node->code == jit_code_movi ? node->v.n->u.w : node->u.n->u.w;
+	patch_at(_jitc->patches.ptr[offset].inst, word);
+    }
+
+    jit_flush(_jit->code.ptr, _jit->pc.uc);
+
+    return (_jit->code.ptr);
+}
+
+#define CODE				1
+#  include "s390-cpu.c"
+#  include "s390-fpu.c"
+#undef CODE
+
+void
+jit_flush(void *fptr, void *tptr)
+{
+#if defined(__GNUC__)
+    jit_word_t		f, t, s;
+
+    s = sysconf(_SC_PAGE_SIZE);
+    f = (jit_word_t)fptr & -s;
+    t = (((jit_word_t)tptr) + s - 1) & -s;
+    __clear_cache((void *)f, (void *)t);
+#endif
+}
+
+void
+_emit_ldxi(jit_state_t *_jit, jit_gpr_t r0, jit_gpr_t r1, jit_word_t i0)
+{
+    ldxi(rn(r0), rn(r1), i0);
+}
+
+void
+_emit_stxi(jit_state_t *_jit, jit_word_t i0, jit_gpr_t r0, jit_gpr_t r1)
+{
+    stxi(i0, rn(r0), rn(r1));
+}
+
+void
+_emit_ldxi_d(jit_state_t *_jit, jit_fpr_t r0, jit_gpr_t r1, jit_word_t i0)
+{
+    ldxi_d(rn(r0), rn(r1), i0);
+}
+
+void
+_emit_stxi_d(jit_state_t *_jit, jit_word_t i0, jit_gpr_t r0, jit_fpr_t r1)
+{
+    stxi_d(i0, rn(r0), rn(r1));
+}
+
+static int32_t
+_jit_get_reg_pair(jit_state_t *_jit)
+{
+    int32_t		r1, r2;
+    /* Try to find a register pair for use with operations that
+     * require a odd based register pair. Search for the best
+     * match to avoid spills or at least a valid operation.
+     */
+
+    /* Try non callee save first */
+    if (jit_reg_free_p(_R0) && jit_reg_free_p(_R1))
+	r1 = _R0, r2 = _R1;
+    else if (jit_reg_free_p(_R2) && jit_reg_free_p(_R3))
+	r1 = _R2, r2 = _R3;
+    else if (jit_reg_free_p(_R4) && jit_reg_free_p(_R5))
+	r1 = _R4, r2 = _R5;
+    /* Try callee save registers */
+    else if (jit_reg_free_p(_R10) && jit_reg_free_p(_R11))
+	r1 = _R10, r2 = _R11;
+    else if (jit_reg_free_p(_R8) && jit_reg_free_p(_R9))
+	r1 = _R8, r2 = _R9;
+    else if (jit_reg_free_p(_R6) && jit_reg_free_p(_R7))
+	r1 = _R6, r2 = _R7;
+
+    /* We *must* find a register pair */
+    else if (jit_reg_free_if_spill_p(_R0) && jit_reg_free_if_spill_p(_R1))
+	r1 = _R0, r2 = _R1;
+    else if (jit_reg_free_if_spill_p(_R2) && jit_reg_free_if_spill_p(_R3))
+	r1 = _R2, r2 = _R3;
+    else if (jit_reg_free_if_spill_p(_R4) && jit_reg_free_if_spill_p(_R5))
+	r1 = _R4, r2 = _R5;
+    else if (jit_reg_free_if_spill_p(_R10) && jit_reg_free_if_spill_p(_R11))
+	r1 = _R10, r2 = _R11;
+    else if (jit_reg_free_if_spill_p(_R8) && jit_reg_free_if_spill_p(_R9))
+	r1 = _R8, r2 = _R9;
+    else if (jit_reg_free_if_spill_p(_R6) && jit_reg_free_if_spill_p(_R7))
+	r1 = _R6, r2 = _R7;
+    else
+	/* Do not jit_get_reg() all registers to avoid it */
+	abort();
+
+    (void)jit_get_reg(jit_class_gpr|jit_class_named|r1);
+    (void)jit_get_reg(jit_class_gpr|jit_class_named|r2);
+
+    return (r1);
+}
+
+static void
+_jit_unget_reg_pair(jit_state_t *_jit, int32_t reg)
+{
+    int32_t		r1, r2;
+    r1 = reg;
+    switch (r1) {
+	case _R0:	r2 = _R1;	break;
+	case _R2:	r2 = _R3;	break;
+	case _R4:	r2 = _R5;	break;
+	case _R6:	r2 = _R7;	break;
+	case _R8:	r2 = _R9;	break;
+	case _R10:	r2 = _R11;	break;
+	default:	abort();
+    }
+    jit_unget_reg(r1);
+    jit_unget_reg(r2);
+}
+
+static int32_t
+_jit_get_reg_but_zero(jit_state_t *_jit, int32_t flags)
+{
+    int32_t		reg;
+    reg = jit_get_reg(jit_class_gpr);
+    if (reg == _R0) {
+	reg = jit_get_reg(jit_class_gpr|flags);
+	jit_unget_reg(_R0);
+    }
+    return (reg);
+}
+
+static void
+_patch(jit_state_t *_jit, jit_word_t instr, jit_node_t *node)
+{
+    int32_t		flag;
+
+    assert(node->flag & jit_flag_node);
+    if (node->code == jit_code_movi)
+	flag = node->v.n->flag;
+    else
+	flag = node->u.n->flag;
+    assert(!(flag & jit_flag_patch));
+    if (_jitc->patches.offset >= _jitc->patches.length) {
+	jit_realloc((jit_pointer_t *)&_jitc->patches.ptr,
+		    _jitc->patches.length * sizeof(jit_patch_t),
+		    (_jitc->patches.length + 1024) * sizeof(jit_patch_t));
+	_jitc->patches.length += 1024;
+    }
+    _jitc->patches.ptr[_jitc->patches.offset].inst = instr;
+    _jitc->patches.ptr[_jitc->patches.offset].node = node;
+    ++_jitc->patches.offset;
+}
diff --git a/libguile/lightening/lightening/s390.h b/libguile/lightening/lightening/s390.h
new file mode 100644
index 000000000..0e74b2e25
--- /dev/null
+++ b/libguile/lightening/lightening/s390.h
@@ -0,0 +1,68 @@
+/*
+ * Copyright (C) 2013-2017  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *	Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_s390_h
+#define _jit_s390_h
+
+#define JIT_HASH_CONSTS		1
+#define JIT_NUM_OPERANDS	2
+
+/*
+ * Types
+ */
+#define JIT_FP			_R13
+typedef enum {
+#define jit_r(i)		(_R12 + ((i) << 1))
+#define jit_r_num()		3
+#define jit_v(i)		(_R11 + ((i) << 1))
+#define jit_v_num()		3
+#define jit_f(i)		(_F8 + (i))
+#define jit_f_num()		6
+#define JIT_R0			_R12
+#define JIT_R1			_R10
+#define JIT_R2			_R8
+#define JIT_V0			_R11
+#define JIT_V1			_R9
+#define JIT_V2			_R7
+     _R0,  _R1,			/* Volatile */
+    _R12,			/* Saved, GOT */
+    _R11,  _R10,  _R9,  _R8,	/* Saved */
+     _R7,			/* Saved */
+     _R6,			/* Saved, parameter */
+     _R5,  _R4,  _R3,		/* Parameter passing */
+     _R2,			/* Volatile, parameter and return value */
+    _R13,			/* Saved, literal pool pointer */
+    _R14,			/* Volatile, return address */
+    _R15,			/* Saved, stack pointer */
+#define JIT_F0			_F8
+#define JIT_F1			_F9
+#define JIT_F2			_F10
+#define JIT_F3			_F11
+#define JIT_F4			_F12
+#define JIT_F5			_F13
+     _F1,  _F3,  _F5,  _F7,	/* Volatile */
+    _F14, _F15,	 _F8,  _F9,	/* Saved */
+    _F10, _F11, _F12, _F13,	/* Saved */
+     _F6,  _F4,  _F2,		/* Volatile, parameter */
+     _F0,			/* Volatile, parameter and return value */
+    _NOREG,
+#define JIT_NOREG		_NOREG
+} jit_reg_t;
+
+#endif /* _jit_s390_h */
diff --git a/libguile/lightening/lightening/x86-cpu.c b/libguile/lightening/lightening/x86-cpu.c
new file mode 100644
index 000000000..7757dc054
--- /dev/null
+++ b/libguile/lightening/lightening/x86-cpu.c
@@ -0,0 +1,2788 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+/* avoid using it due to partial stalls */
+#define USE_INC_DEC                     0
+
+#if __X32
+# define WIDE 0
+# define IF_WIDE(wide, narrow) narrow
+#else
+# define WIDE 1
+# define IF_WIDE(wide, narrow) wide
+#endif
+
+#define _RAX_REGNO                      0
+#define _RCX_REGNO                      1
+#define _RDX_REGNO                      2
+#define _RBX_REGNO                      3
+#define _RSP_REGNO                      4
+#define _RBP_REGNO                      5
+#define _RSI_REGNO                      6
+#define _RDI_REGNO                      7
+#define _R8_REGNO                       8
+#define _R9_REGNO                       9
+#define _R10_REGNO                      10
+#define _R11_REGNO                      11
+#define _R12_REGNO                      12
+#define _R13_REGNO                      13
+#define _R14_REGNO                      14
+#define _R15_REGNO                      15
+#define r7(reg)                 ((reg) & 7)
+#define r8(reg)                 ((reg) & 15)
+#if __X32
+# define reg8_p(rn) ((rn) >= _RAX_REGNO && (rn) <= _RBX_REGNO)
+#else
+# define reg8_p(rn) 1
+#endif
+
+#define can_sign_extend_int_p(im)                                       \
+  IF_WIDE((((im) >= 0 && (long long)(im) <=  0x7fffffffLL) ||           \
+           ((im) <  0 && (long long)(im) >  -0x80000000LL)),            \
+          1)
+#define can_zero_extend_int_p(im)                                       \
+  IF_WIDE(((im) >= 0 && (im) < 0x80000000LL),                           \
+          1)
+#define fits_uint32_p(im)                                               \
+  IF_WIDE((((im) & 0xffffffff00000000LL) == 0),                         \
+          1)
+
+#define _SCL1      0x00
+#define _SCL2      0x01
+#define _SCL4      0x02
+#define _SCL8      0x03
+
+#define X86_ADD    0
+#define X86_OR     1 << 3
+#define X86_ADC    2 << 3
+#define X86_SBB    3 << 3
+#define X86_AND    4 << 3
+#define X86_SUB    5 << 3
+#define X86_XOR    6 << 3
+#define X86_CMP    7 << 3
+#define X86_ROL    0
+#define X86_ROR    1
+#define X86_RCL    2
+#define X86_RCR    3
+#define X86_SHL    4
+#define X86_SHR    5
+#define X86_SAR    7
+#define X86_NOT    2
+#define X86_NEG    3
+#define X86_MUL    4
+#define X86_IMUL   5
+#define X86_DIV    6
+#define X86_IDIV   7
+
+#define FOR_EACH_CC(M) \
+  M(o,   O,   0x0)     \
+  M(no,  NO,  0x1)     \
+  M(nae, NAE, 0x2)     \
+  M(b,   B,   0x2)     \
+  M(c,   C,   0x2)     \
+  M(ae,  AE,  0x3)     \
+  M(nb,  NB,  0x3)     \
+  M(nc,  NC,  0x3)     \
+  M(e,   E,   0x4)     \
+  M(z,   Z,   0x4)     \
+  M(ne,  NE,  0x5)     \
+  M(nz,  NZ,  0x5)     \
+  M(be,  BE,  0x6)     \
+  M(na,  NA,  0x6)     \
+  M(a,   A,   0x7)     \
+  M(nbe, NBE, 0x7)     \
+  M(s,   S,   0x8)     \
+  M(ns,  NS,  0x9)     \
+  M(p,   P,   0xa)     \
+  M(pe,  PE,  0xa)     \
+  M(np,  NP,  0xb)     \
+  M(po,  PO,  0xb)     \
+  M(l,   L,   0xc)     \
+  M(nge, NGE, 0xc)     \
+  M(ge,  GE,  0xd)     \
+  M(nl_, NL,  0xd)     \
+  M(le,  LE,  0xe)     \
+  M(ng,  NG,  0xe)     \
+  M(g,   G,   0xf)     \
+  M(nle, NLE, 0xf)     \
+  /* EOL */
+
+enum x86_cc
+{
+#define DEFINE_ENUM(cc, CC, code) X86_CC_##CC = code,
+  FOR_EACH_CC(DEFINE_ENUM)
+#undef DEFINE_ENUM
+};
+
+static inline void
+mrm(jit_state_t *_jit, uint8_t md, uint8_t r, uint8_t m)
+{
+  emit_u8(_jit, (md<<6) | (r<<3) | m);
+}
+
+static inline void
+sib(jit_state_t *_jit, uint8_t sc, uint8_t i, uint8_t b)
+{
+  emit_u8(_jit, (sc<<6) | (i<<3) | b);
+}
+
+static inline void
+ic(jit_state_t *_jit, uint8_t c)
+{
+  emit_u8(_jit, c);
+}
+
+static inline void
+is(jit_state_t *_jit, uint16_t s)
+{
+  emit_u16(_jit, s);
+}
+
+static inline void
+ii(jit_state_t *_jit, uint32_t i)
+{
+  emit_u32(_jit, i);
+}
+
+#if __X64
+static inline void
+il(jit_state_t *_jit, uint64_t l)
+{
+  emit_u64(_jit, l);
+}
+#endif
+
+static void
+rex(jit_state_t *_jit, int32_t l, int32_t w,
+    int32_t r, int32_t x, int32_t b)
+{
+#if __X64
+  int32_t v = 0x40 | (w << 3);
+
+  if (r != _NOREG)
+    v |= (r & 8) >> 1;
+  if (x != _NOREG)
+    v |= (x & 8) >> 2;
+  if (b != _NOREG)
+    v |= (b & 8) >> 3;
+  if (l || v != 0x40)
+    ic(_jit, v);
+#endif
+}
+
+static void
+rx(jit_state_t *_jit, int32_t rd, int32_t md,
+   int32_t rb, int32_t ri, int32_t ms)
+{
+  if (ri == _NOREG) {
+    if (rb == _NOREG) {
+#if __X32
+      mrm(_jit, 0x00, r7(rd), 0x05);
+#else
+      mrm(_jit, 0x00, r7(rd), 0x04);
+      sib(_jit, _SCL1, 0x04, 0x05);
+#endif
+      ii(_jit, md);
+    } else if (r7(rb) == _RSP_REGNO) {
+      if (md == 0) {
+        mrm(_jit, 0x00, r7(rd), 0x04);
+        sib(_jit, ms, 0x04, 0x04);
+      }
+      else if ((int8_t)md == md) {
+        mrm(_jit, 0x01, r7(rd), 0x04);
+        sib(_jit, ms, 0x04, 0x04);
+        ic(_jit, md);
+      } else {
+        mrm(_jit, 0x02, r7(rd), 0x04);
+        sib(_jit, ms, 0x04, 0x04);
+        ii(_jit, md);
+      }
+    } else {
+      if (md == 0 && r7(rb) != _RBP_REGNO)
+        mrm(_jit, 0x00, r7(rd), r7(rb));
+      else if ((int8_t)md == md) {
+        mrm(_jit, 0x01, r7(rd), r7(rb));
+        ic(_jit, md);
+      } else {
+        mrm(_jit, 0x02, r7(rd), r7(rb));
+        ii(_jit, md);
+      }
+    }
+  }
+  else if (rb == _NOREG) {
+    mrm(_jit, 0x00, r7(rd), 0x04);
+    sib(_jit, ms, r7(ri), 0x05);
+    ii(_jit, md);
+  }
+  else if (r8(ri) != _RSP_REGNO) {
+    if (md == 0 && r7(rb) != _RBP_REGNO) {
+      mrm(_jit, 0x00, r7(rd), 0x04);
+      sib(_jit, ms, r7(ri), r7(rb));
+    } else if ((int8_t)md == md) {
+      mrm(_jit, 0x01, r7(rd), 0x04);
+      sib(_jit, ms, r7(ri), r7(rb));
+      ic(_jit, md);
+    } else {
+      mrm(_jit, 0x02, r7(rd), 0x04);
+      sib(_jit, ms, r7(ri), r7(rb));
+      ic(_jit, md);
+    }
+  } else {
+    fprintf(stderr, "illegal index register");
+    abort();
+  }
+}
+
+static void
+pushr(jit_state_t *_jit, int32_t r0)
+{
+  _jit->frame_size += __WORDSIZE / 8;
+  rex(_jit, 0, WIDE, 0, 0, r0);
+  ic(_jit, 0x50 | r7(r0));
+}
+
+static void
+popr(jit_state_t *_jit, int32_t r0)
+{
+  _jit->frame_size -= __WORDSIZE / 8;
+  rex(_jit, 0, WIDE, 0, 0, r0);
+  ic(_jit, 0x58 | r7(r0));
+}
+
+static void
+nop(jit_state_t *_jit, int32_t count)
+{
+  switch (count) {
+  case 0:
+    break;
+  case 1: /* NOP */
+    ic(_jit, 0x90);
+    break;
+  case 2: /* 66 NOP */
+    ic(_jit, 0x66); ic(_jit, 0x90);
+    break;
+  case 3: /* NOP DWORD ptr [EAX] */
+    ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x00);
+    break;
+  case 4: /* NOP DWORD ptr [EAX + 00H] */
+    ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x40); ic(_jit, 0x00);
+    break;
+  case 5: /* NOP DWORD ptr [EAX + EAX*1 + 00H] */
+    ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x44); ic(_jit, 0x00);
+    ic(_jit, 0x00);
+    break;
+  case 6: /* 66 NOP DWORD ptr [EAX + EAX*1 + 00H] */
+    ic(_jit, 0x66); ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x44);
+    ic(_jit, 0x00); ic(_jit, 0x00);
+    break;
+  case 7: /* NOP DWORD ptr [EAX + 00000000H] */
+    ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x80); ii(_jit, 0x0000);
+    break;
+  case 8: /* NOP DWORD ptr [EAX + EAX*1 + 00000000H] */
+    ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x84); ic(_jit, 0x00);
+    ii(_jit, 0x0000);
+    break;
+  case 9: /* 66 NOP DWORD ptr [EAX + EAX*1 + 00000000H] */
+    ic(_jit, 0x66); ic(_jit, 0x0f); ic(_jit, 0x1f); ic(_jit, 0x84);
+    ic(_jit, 0x00); ii(_jit, 0x0000);
+    break;
+  default:
+    abort();
+  }
+}
+
+static void
+movr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1) {
+    rex(_jit, 0, 1, r1, _NOREG, r0);
+    ic(_jit, 0x89);
+    ic(_jit, 0xc0 | (r1 << 3) | r7(r0));
+  }
+}
+
+static void
+movcr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbe);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+movcr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb6);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+movsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbf);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+movsr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb7);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+#if __X64
+static void
+movir(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 1, r0, _NOREG, r1);
+  ic(_jit, 0x63);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+movir_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 0, r1, _NOREG, r0);
+  ic(_jit, 0x89);
+  ic(_jit, 0xc0 | (r1 << 3) | r7(r0));
+}
+#endif
+
+static jit_reloc_t
+mov_addr(jit_state_t *_jit, int32_t r0)
+{
+  uint8_t *pc_start = _jit->pc.uc;
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  ic(_jit, 0xb8 | r7(r0));
+  ptrdiff_t inst_start = _jit->pc.uc - pc_start;
+  return emit_abs_reloc(_jit, inst_start);
+}
+
+static void
+imovi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+#if __X64
+  if (fits_uint32_p(i0)) {
+    rex(_jit, 0, 0, _NOREG, _NOREG, r0);
+    ic(_jit, 0xb8 | r7(r0));
+    ii(_jit, i0);
+  } else {
+    rex(_jit, 0, 1, _NOREG, _NOREG, r0);
+    ic(_jit, 0xb8 | r7(r0));
+    il(_jit, i0);
+  }
+#else
+  ic(_jit, 0xb8 | r7(r0));
+  ii(_jit, i0);
+#endif
+}
+
+static void
+alur(jit_state_t *_jit, int32_t code, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r1, _NOREG, r0);
+  ic(_jit, code | 0x01);
+  mrm(_jit, 0x03, r7(r1), r7(r0));
+}
+
+static inline void
+icmpr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_CMP, r0, r1);
+}
+static inline void
+iaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_ADD, r0, r1);
+}
+static inline void
+iaddxr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_ADC, r0, r1);
+}
+static inline void
+isubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_SUB, r0, r1);
+}
+static inline void
+isubxr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_SBB, r0, r1);
+}
+static inline void
+iandr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_AND, r0, r1);
+}
+static inline void
+iorr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_OR, r0, r1);
+}
+static inline void
+ixorr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return alur(_jit, X86_XOR, r0, r1);
+}
+
+static void
+movi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (i0)
+    imovi(_jit, r0, i0);
+  else
+    ixorr(_jit, r0, r0);
+}
+
+static void
+alui(jit_state_t *_jit, int32_t code, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+    if ((int8_t)i0 == i0) {
+      ic(_jit, 0x83);
+      ic(_jit, 0xc0 | code | r7(r0));
+      ic(_jit, i0);
+    } else {
+      if (r0 == _RAX_REGNO) {
+        ic(_jit, code | 0x05);
+      } else {
+        ic(_jit, 0x81);
+        ic(_jit, 0xc0 | code | r7(r0));
+      }
+      ii(_jit, i0);
+    }
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    alur(_jit, code, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static inline void
+icmpi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_CMP, r0, i0);
+}
+static inline void
+iaddi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_ADD, r0, i0);
+}
+static inline void
+iaddxi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_ADC, r0, i0);
+}
+static inline void
+isubi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_SUB, r0, i0);
+}
+static inline void
+isubxi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_SBB, r0, i0);
+}
+static inline void
+iandi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_AND, r0, i0);
+}
+static inline void
+iori(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_OR, r0, i0);
+}
+static inline void
+ixori(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  return alui(_jit, X86_XOR, r0, i0);
+}
+
+static void
+unr(jit_state_t *_jit, int32_t code, int32_t r0)
+{
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  ic(_jit, 0xf7);
+  mrm(_jit, 0x03, code, r7(r0));
+}
+
+static inline void
+umulr(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_IMUL, r0);
+}
+static inline void
+umulr_u(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_MUL, r0);
+}
+static inline void
+idivr(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_IDIV, r0);
+}
+static inline void
+idivr_u(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_DIV, r0);
+}
+static inline void
+inegr(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_NEG, r0);
+}
+static inline void
+icomr(jit_state_t *_jit, int32_t r0)
+{
+  return unr(_jit, X86_NOT, r0);
+}
+
+#if USE_INC_DEC
+static void
+incr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movr(_jit, r0, r1);
+#  if __X64
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  ic(_jit, 0xff);
+  ic(_jit, 0xc0 | r7(r0));
+#  else
+  ic(_jit, 0x40 | r7(r0));
+#  endif
+}
+
+static void
+decr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movr(_jit, r0, r1);
+#  if __X64
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  ic(_jit, 0xff);
+  ic(_jit, 0xc8 | r7(r0));
+#  else
+  ic(_jit, 0x48 | r7(r0));
+#  endif
+}
+#endif
+
+static void
+lea(jit_state_t *_jit, int32_t md, int32_t rb,
+     int32_t ri, int32_t ms, int32_t rd)
+{
+  rex(_jit, 0, WIDE, rd, ri, rb);
+  ic(_jit, 0x8d);
+  rx(_jit, rd, md, rb, ri, ms);
+}
+
+static void
+xchgr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r1, _NOREG, r0);
+  ic(_jit, 0x87);
+  mrm(_jit, 0x03, r7(r1), r7(r0));
+}
+
+static void
+xchgrm(jit_state_t *_jit, int32_t val_and_dst, int32_t loc)
+{
+  rex(_jit, 0, WIDE, val_and_dst, _NOREG, loc);
+  ic(_jit, 0x87);
+  rx(_jit, val_and_dst, 0, loc, _NOREG, _SCL1);
+}
+
+static void
+lock(jit_state_t *_jit)
+{
+  ic(_jit, 0xf0);
+}
+
+static void
+cmpxchgmr(jit_state_t *_jit, int32_t loc, int32_t desired)
+{
+  lock(_jit);
+  rex(_jit, 0, WIDE, desired, _NOREG, loc);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb1);
+  rx(_jit, desired, 0, loc, _NOREG, _SCL1);
+}
+
+static void
+testr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r1, _NOREG, r0);
+  ic(_jit, 0x85);
+  mrm(_jit, 0x03, r7(r1), r7(r0));
+}
+
+static void
+testi(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  if (r0 == _RAX_REGNO) {
+    ic(_jit, 0xa9);
+  } else {
+    ic(_jit, 0xf7);
+    mrm(_jit, 0x03, 0x00, r7(r0));
+  }
+  ii(_jit, i0);
+}
+
+static void
+negr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 == r1) {
+    inegr(_jit, r0);
+  } else {
+    ixorr(_jit, r0, r0);
+    isubr(_jit, r0, r1);
+  }
+}
+
+static void
+addr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    iaddr(_jit, r0, r2);
+  else if (r0 == r2)
+    iaddr(_jit, r0, r1);
+  else
+    lea(_jit, 0, r1, r2, _SCL1, r0);
+}
+
+static void
+addi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+#if USE_INC_DEC
+  else if (i0 == 1)
+    incr(_jit, r0, r1);
+  else if (i0 == -1)
+    decr(_jit, r0, r1);
+#endif
+  else if (can_sign_extend_int_p(i0)) {
+    if (r0 == r1)
+      iaddi(_jit, r0, i0);
+    else
+      lea(_jit, i0, r1, _NOREG, _SCL1, r0);
+  }
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    iaddr(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    iaddr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+addcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r2) {
+    iaddr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    iaddr(_jit, r0, r2);
+  }
+}
+
+static void
+addci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    movr(_jit, r0, r1);
+    iaddi(_jit, r0, i0);
+  }
+  else if (r0 == r1) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    iaddr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    movi(_jit, r0, i0);
+    iaddr(_jit, r0, r1);
+  }
+}
+
+static void
+addxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r2) {
+    iaddxr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    iaddxr(_jit, r0, r2);
+  }
+}
+
+static void
+addxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    movr(_jit, r0, r1);
+    iaddxi(_jit, r0, i0);
+  }
+  else if (r0 == r1) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    iaddxr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    movi(_jit, r0, i0);
+    iaddxr(_jit, r0, r1);
+  }
+}
+
+static void
+subr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r1 == r2)
+    ixorr(_jit, r0, r0);
+  else if (r0 == r2) {
+    isubr(_jit, r0, r1);
+    inegr(_jit, r0);
+  } else {
+    movr(_jit, r0, r1);
+    isubr(_jit, r0, r2);
+  }
+}
+
+static void
+subi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+#if USE_INC_DEC
+  else if (i0 == 1)
+    decr(_jit, r0, r1);
+  else if (i0 == -1)
+    incr(_jit, r0, r1);
+#endif
+  else if (can_sign_extend_int_p(i0)) {
+    if (r0 == r1)
+      isubi(_jit, r0, i0);
+    else
+      lea(_jit, -i0, r1, _NOREG, _SCL1, r0);
+  }
+  else if (r0 != r1) {
+    movi(_jit, r0, -i0);
+    iaddr(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    isubr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subcr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r2 && r0 != r1) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r0);
+    movr(_jit, r0, r1);
+    isubr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    movr(_jit, r0, r1);
+    isubr(_jit, r0, r2);
+  }
+}
+
+static void
+subci(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  movr(_jit, r0, r1);
+  if (can_sign_extend_int_p(i0)) {
+    isubi(_jit, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    isubr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+subxr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r2 && r0 != r1) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r0);
+    movr(_jit, r0, r1);
+    isubxr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else {
+    movr(_jit, r0, r1);
+    isubxr(_jit, r0, r2);
+  }
+}
+
+static void
+subxi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  movr(_jit, r0, r1);
+  if (can_sign_extend_int_p(i0)) {
+    isubxi(_jit, r0, i0);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    imovi(_jit, jit_gpr_regno(reg), i0);
+    isubxr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+irotshr(jit_state_t *_jit, int32_t code, int32_t r0)
+{
+  rex(_jit, 0, WIDE, _RCX_REGNO, _NOREG, r0);
+  ic(_jit, 0xd3);
+  mrm(_jit, 0x03, code, r7(r0));
+}
+
+static void
+rotshr(jit_state_t *_jit, int32_t code,
+        int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == _RCX_REGNO) {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r1);
+    if (r2 != _RCX_REGNO)
+      movr(_jit, _RCX_REGNO, r2);
+    irotshr(_jit, code, jit_gpr_regno(reg));
+    movr(_jit, _RCX_REGNO, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  } else if (r2 != _RCX_REGNO) {
+    /* Already know that R0 isn't RCX.  */
+    pushr(_jit, _RCX_REGNO);
+    if (r1 == _RCX_REGNO) {
+      if (r0 == r2)
+        xchgr(_jit, r0, _RCX_REGNO);
+      else {
+        movr(_jit, r0, r1);
+        movr(_jit, _RCX_REGNO, r2);
+      }
+    } else {
+      movr(_jit, _RCX_REGNO, r2);
+      movr(_jit, r0, r1);
+    }
+    irotshr(_jit, code, r0);
+    popr(_jit, _RCX_REGNO);
+  } else {
+    movr(_jit, r0, r1);
+    irotshr(_jit, code, r0);
+  }
+}
+
+static void
+irotshi(jit_state_t *_jit, int32_t code, int32_t r0, jit_word_t i0)
+{
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  if (i0 == 1) {
+    ic(_jit, 0xd1);
+    mrm(_jit, 0x03, code, r7(r0));
+  } else {
+    ic(_jit, 0xc1);
+    mrm(_jit, 0x03, code, r7(r0));
+    ic(_jit, i0);
+  }
+}
+
+static void
+rotshi(jit_state_t *_jit, int32_t code,
+       int32_t r0, int32_t r1, jit_word_t i0)
+{
+  movr(_jit, r0, r1);
+  if (i0)
+    irotshi(_jit, code, r0, i0);
+}
+
+static void
+lshi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else if (i0 <= 3)
+    lea(_jit, 0, _NOREG, r1, i0 == 1 ? _SCL2 : i0 == 2 ? _SCL4 : _SCL8, r0);
+  else
+    rotshi(_jit, X86_SHL, r0, r1, i0);
+}
+
+static void
+lshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return rotshr(_jit, X86_SHL, r0, r1, r2);
+}
+
+static void
+rshr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return rotshr(_jit, X86_SAR, r0, r1, r2);
+}
+
+static void
+rshi(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  return rotshi(_jit, X86_SAR, r0, r1, i0);
+}
+
+static void
+rshr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return rotshr(_jit, X86_SHR, r0, r1, r2);
+}
+
+static void
+rshi_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t i0)
+{
+  return rotshi(_jit, X86_SHR, r0, r1, i0);
+}
+
+static void
+imulr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xaf);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+imuli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    if ((int8_t)i0 == i0) {
+      ic(_jit, 0x6b);
+      mrm(_jit, 0x03, r7(r0), r7(r1));
+      ic(_jit, i0);
+    } else {
+      ic(_jit, 0x69);
+      mrm(_jit, 0x03, r7(r0), r7(r1));
+      ii(_jit, i0);
+    }
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    imulr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+mulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    imulr(_jit, r0, r2);
+  else if (r0 == r2) {
+    imulr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    imulr(_jit, r0, r2);
+  }
+}
+
+static int
+ffsw(jit_word_t i)
+{
+  if (sizeof(int) == sizeof(i))
+    return ffs(i);
+  int bit = ffs((int)i);
+  if (bit == 0) {
+    bit = ffs((int)((uint64_t)i >> 32));
+    if (bit)
+      bit += 32;
+  }
+  return bit;
+}
+
+static void
+muli(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  switch (i0) {
+  case 0:
+    ixorr(_jit, r0, r0);
+    break;
+  case 1:
+    movr(_jit, r0, r1);
+    break;
+  case -1:
+    negr(_jit, r0, r1);
+    break;
+  case 2:
+    lea(_jit, 0, _NOREG, r1, _SCL2, r0);
+    break;
+  case 4:
+    lea(_jit, 0, _NOREG, r1, _SCL4, r0);
+    break;
+  case 8:
+    lea(_jit, 0, _NOREG, r1, _SCL8, r0);
+    break;
+  default:
+    if (i0 > 0 && !(i0 & (i0 - 1)))
+      lshi(_jit, r0, r1, ffsw(i0) - 1);
+    else if (can_sign_extend_int_p(i0))
+      imuli(_jit, r0, r1, i0);
+    else if (r0 != r1) {
+      movi(_jit, r0, i0);
+      imulr(_jit, r0, r1);
+    }
+    else
+      imuli(_jit, r0, r0, i0);
+    break;
+  }
+}
+
+static void
+iqmulr(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, int32_t r3, jit_bool_t sign)
+{
+  if (r0 != _RAX_REGNO && r1 != _RAX_REGNO)
+    pushr(_jit, _RAX_REGNO);
+  if (r0 != _RDX_REGNO && r1 != _RDX_REGNO)
+    pushr(_jit, _RDX_REGNO);
+
+  int32_t mul;
+  if (r3 == _RAX_REGNO) {
+    mul = r2;
+  } else {
+    mul = r3;
+    movr(_jit, _RAX_REGNO, r2);
+  }
+  if (sign)
+    umulr(_jit, mul);
+  else
+    umulr_u(_jit, mul);
+
+  if (r0 == _RDX_REGNO && r1 == _RAX_REGNO) {
+    xchgr(_jit, _RAX_REGNO, _RDX_REGNO);
+  } else {
+    if (r0 != _RDX_REGNO)
+      movr(_jit, r0, _RAX_REGNO);
+    movr(_jit, r1, _RDX_REGNO);
+    if (r0 == _RDX_REGNO)
+      movr(_jit, r0, _RAX_REGNO);
+  }
+
+  if (r0 != _RDX_REGNO && r1 != _RDX_REGNO)
+    popr(_jit, _RDX_REGNO);
+  if (r0 != _RAX_REGNO && r1 != _RAX_REGNO)
+    popr(_jit, _RAX_REGNO);
+}
+
+static void
+qmulr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqmulr(_jit, r0, r1, r2, r3, 1);
+}
+
+static void
+qmulr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqmulr(_jit, r0, r1, r2, r3, 0);
+}
+
+static void
+iqmuli(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+  if (i0 == 0) {
+    ixorr(_jit, r0, r0);
+    ixorr(_jit, r1, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    if (sign)
+      qmulr(_jit, r0, r1, r2, jit_gpr_regno(reg));
+    else
+      qmulr_u(_jit, r0, r1, r2, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+qmuli(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  return iqmuli(_jit, r0, r1, r2, i0, 1);
+}
+
+static void
+qmuli_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  return iqmuli(_jit, r0, r1, r2, i0, 0);
+}
+
+static void
+sign_extend_rdx_rax(jit_state_t *_jit)
+{
+  rex(_jit, 0, WIDE, 0, 0, 0);
+  ic(_jit, 0x99);
+}
+
+static void
+divremr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2,
+         jit_bool_t sign, jit_bool_t divide)
+{
+  if (r0 != _RAX_REGNO)
+    pushr(_jit, _RAX_REGNO);
+  if (r0 != _RDX_REGNO)
+    pushr(_jit, _RDX_REGNO);
+
+  int tmp_divisor = 0;
+  if (r2 == _RAX_REGNO || r2 == _RDX_REGNO) {
+    jit_gpr_t tmp = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(tmp), r2);
+    r2 = jit_gpr_regno(tmp);
+    tmp_divisor = 1;
+  }
+
+  movr(_jit, _RAX_REGNO, r1);
+
+  if (sign) {
+    sign_extend_rdx_rax(_jit);
+    idivr(_jit, r2);
+  } else {
+    ixorr(_jit, _RDX_REGNO, _RDX_REGNO);
+    idivr_u(_jit, r2);
+  }
+
+  if (divide)
+    movr(_jit, r0, _RAX_REGNO);
+  else
+    movr(_jit, r0, _RDX_REGNO);
+
+  if (tmp_divisor)
+    unget_temp_gpr(_jit);
+
+  if (r0 != _RDX_REGNO)
+    popr(_jit, _RDX_REGNO);
+  if (r0 != _RAX_REGNO)
+    popr(_jit, _RAX_REGNO);
+}
+
+static void
+divremi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0,
+         jit_bool_t sign, jit_bool_t divide)
+{
+  jit_gpr_t tmp = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(tmp), i0);
+
+  divremr(_jit, r0, r1, jit_gpr_regno(tmp), sign, divide);
+}
+
+static void
+divr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return divremr(_jit, r0, r1, r2, 1, 1);
+}
+
+static void
+divi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  return divremi(_jit, r0, r1, i0, 1, 1);
+}
+
+static void
+divr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return divremr(_jit, r0, r1, r2, 0, 1);
+}
+
+static void
+divi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  return divremi(_jit, r0, r1, i0, 0, 1);
+}
+
+
+static void
+remr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return divremr(_jit, r0, r1, r2, 1, 0);
+}
+
+static void
+remi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  return divremi(_jit, r0, r1, i0, 1, 0);
+}
+
+static void
+remr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  return divremr(_jit, r0, r1, r2, 0, 0);
+}
+
+static void
+remi_u(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  return divremi(_jit, r0, r1, i0, 0, 0);
+}
+
+static void
+iqdivr(jit_state_t *_jit, int32_t r0, int32_t r1,
+        int32_t r2, int32_t r3, jit_bool_t sign)
+{
+  if (r0 != _RAX_REGNO && r1 != _RAX_REGNO)
+    pushr(_jit, _RAX_REGNO);
+  if (r0 != _RDX_REGNO && r1 != _RDX_REGNO)
+    pushr(_jit, _RDX_REGNO);
+
+  int tmp_divisor = 0;
+  if (r3 == _RAX_REGNO || r3 == _RDX_REGNO) {
+    jit_gpr_t tmp = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(tmp), r3);
+    r3 = jit_gpr_regno(tmp);
+    tmp_divisor = 1;
+  }
+
+  movr(_jit, _RAX_REGNO, r2);
+
+  if (sign) {
+    sign_extend_rdx_rax(_jit);
+    idivr(_jit, r3);
+  } else {
+    ixorr(_jit, _RDX_REGNO, _RDX_REGNO);
+    idivr_u(_jit, r3);
+  }
+
+  if (r0 == _RDX_REGNO && r1 == _RAX_REGNO) {
+    xchgr(_jit, _RAX_REGNO, _RDX_REGNO);
+  } else {
+    if (r0 != _RDX_REGNO)
+      movr(_jit, r0, _RAX_REGNO);
+    movr(_jit, r1, _RDX_REGNO);
+    if (r0 == _RDX_REGNO)
+      movr(_jit, r0, _RAX_REGNO);
+  }
+
+  if (tmp_divisor)
+    unget_temp_gpr(_jit);
+
+  if (r0 != _RDX_REGNO && r1 != _RDX_REGNO)
+    popr(_jit, _RDX_REGNO);
+  if (r0 != _RAX_REGNO && r1 != _RAX_REGNO)
+    popr(_jit, _RAX_REGNO);
+}
+
+static void
+qdivr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit, r0, r1, r2, r3, 1);
+}
+
+static void
+qdivr_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, int32_t r3)
+{
+  return iqdivr(_jit, r0, r1, r2, r3, 0);
+}
+
+static void
+iqdivi(jit_state_t *_jit, int32_t r0, int32_t r1,
+       int32_t r2, jit_word_t i0, jit_bool_t sign)
+{
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i0);
+  if (sign)
+    qdivr(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  else
+    qdivr_u(_jit, r0, r1, r2, jit_gpr_regno(reg));
+  unget_temp_gpr(_jit);
+}
+
+static void
+qdivi(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  return iqdivi(_jit, r0, r1, r2, i0, 1);
+}
+
+static void
+qdivi_u(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2, jit_word_t i0)
+{
+  return iqdivi(_jit, r0, r1, r2, i0, 0);
+}
+
+static void
+comr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movr(_jit, r0, r1);
+  icomr(_jit, r0);
+}
+
+static void
+andr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r1 == r2)
+    movr(_jit, r0, r1);
+  else if (r0 == r1)
+    iandr(_jit, r0, r2);
+  else if (r0 == r2) {
+    iandr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    iandr(_jit, r0, r2);
+  }
+}
+
+static void
+andi(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+
+  if (i0 == 0)
+    ixorr(_jit, r0, r0);
+  else if (i0 == -1)
+    movr(_jit, r0, r1);
+  else if (r0 == r1) {
+    if (can_sign_extend_int_p(i0)) {
+      iandi(_jit, r0, i0);
+    } else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      movi(_jit, jit_gpr_regno(reg), i0);
+      iandr(_jit, r0, jit_gpr_regno(reg));
+      unget_temp_gpr(_jit);
+    }
+  } else {
+    movi(_jit, r0, i0);
+    iandr(_jit, r0, r1);
+  }
+}
+
+static void
+orr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r1 == r2) {
+    movr(_jit, r0, r1);
+  } else if (r0 == r1) {
+    iorr(_jit, r0, r2);
+  } else if (r0 == r2) {
+    iorr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    iorr(_jit, r0, r2);
+  }
+}
+
+static void
+ori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else if (i0 == -1)
+    movi(_jit, r0, -1);
+  else if (can_sign_extend_int_p(i0)) {
+    movr(_jit, r0, r1);
+    iori(_jit, r0, i0);
+  }
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    iorr(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    iorr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+xorr(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r1 == r2)
+    ixorr(_jit, r0, r0);
+  else if (r0 == r1)
+    ixorr(_jit, r0, r2);
+  else if (r0 == r2) {
+    ixorr(_jit, r0, r1);
+  } else {
+    movr(_jit, r0, r1);
+    ixorr(_jit, r0, r2);
+  }
+}
+
+static void
+xori(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (i0 == 0)
+    movr(_jit, r0, r1);
+  else if (i0 == -1)
+    comr(_jit, r0, r1);
+  else if (can_sign_extend_int_p(i0)) {
+    movr(_jit, r0, r1);
+    ixori(_jit, r0, i0);
+  }
+  else if (r0 != r1) {
+    movi(_jit, r0, i0);
+    ixorr(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ixorr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+extr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (reg8_p(r1)) {
+    movcr(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r1);
+    movcr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+extr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (reg8_p(r1)) {
+    movcr_u(_jit, r0, r1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r1);
+    movcr_u(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+extr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return movsr(_jit, r0, r1);
+}
+
+static void
+extr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return movsr_u(_jit, r0, r1);
+}
+
+#if __X64
+static void
+extr_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return movir(_jit, r0, r1);
+}
+static void
+extr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return movir_u(_jit, r0, r1);
+}
+#endif
+
+static void
+bswapr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  extr_us(_jit, r0, r1);
+  ic(_jit, 0x66);
+  rex(_jit, 0, 0, _NOREG, _NOREG, r0);
+  ic(_jit, 0xc1);
+  mrm(_jit, 0x03, X86_ROR, r7(r0));
+  ic(_jit, 8);
+}
+
+static void
+bswapr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movr(_jit, r0, r1);
+  rex(_jit, 0, 0, _NOREG, _NOREG, r0);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xc8 | r7(r0));
+}
+
+#if __X64
+static void
+bswapr_ul(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movr(_jit, r0, r1);
+  rex(_jit, 0, 1, _NOREG, _NOREG, r0);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xc8 | r7(r0));
+}
+#endif
+
+static void
+ldr_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbe);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_c(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, _NOREG);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xbe);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_c(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_uc(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb6);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_uc(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, _NOREG);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xb6);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_uc(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbf);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_s(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, _NOREG);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xbf);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_s(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_us(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb7);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_us(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, _NOREG);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xb7);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_us(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+#if __X64
+  rex(_jit, 0, WIDE, r0, _NOREG, r1);
+  ic(_jit, 0x63);
+#else
+  ic(_jit, 0x8b);
+#endif
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_i(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+#if __X64
+    rex(_jit, 0, WIDE, r0, _NOREG, _NOREG);
+    ic(_jit, 0x63);
+#else
+    ic(_jit, 0x8b);
+#endif
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_i(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+#if __X64
+static void
+ldr_ui(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 0, r0, _NOREG, r1);
+  ic(_jit, 0x63);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_ui(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 0, r0, _NOREG, _NOREG);
+    ic(_jit, 0x63);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_ui(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldr_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 1, r0, _NOREG, r1);
+  ic(_jit, 0x8b);
+  rx(_jit, r0, 0, r1, _NOREG, _SCL1);
+}
+
+static void
+ldi_l(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 1, r0, _NOREG, _NOREG);
+    ic(_jit, 0x8b);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_l(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+#endif
+
+static void
+ldxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, WIDE, r0, r1, r2);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbe);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_c(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xbe);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_c(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_uc(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, WIDE, r0, r1, r2);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb6);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_uc(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xb6);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_uc(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, WIDE, r0, r1, r2);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xbf);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_s(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xbf);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_s(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_us(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, WIDE, r0, r1, r2);
+  ic(_jit, 0x0f);
+  ic(_jit, 0xb7);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_us(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    ic(_jit, 0x0f);
+    ic(_jit, 0xb7);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_us(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+#if __X64
+  rex(_jit, 0, WIDE, r0, r1, r2);
+  ic(_jit, 0x63);
+#else
+  ic(_jit, 0x8b);
+#endif
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_i(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+#if __X64
+    rex(_jit, 0, WIDE, r0, _NOREG, r1);
+    ic(_jit, 0x63);
+#else
+    ic(_jit, 0x8b);
+#endif
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_i(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+#if __X64
+static void
+ldxr_ui(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, 0, r0, r1, r2);
+  ic(_jit, 0x8b);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_ui(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 0, r0, _NOREG, r1);
+    ic(_jit, 0x8b);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_ui(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, 1, r0, r1, r2);
+  ic(_jit, 0x8b);
+  rx(_jit, r0, 0, r2, r1, _SCL1);
+}
+
+static void
+ldxi_l(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 1, r0, _NOREG, r1);
+    ic(_jit, 0x8b);
+    rx(_jit, r0, i0, r1, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_l(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+#endif
+
+static void stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1);
+
+static void
+str_c(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (reg8_p(r1)) {
+    rex(_jit, 0, 0, r1, _NOREG, r0);
+    ic(_jit, 0x88);
+    rx(_jit, r1, 0, r0, _NOREG, _SCL1);
+  } else {
+    // See comment in stxi_c.
+    return stxi_c(_jit, 0, r0, r1);
+  }
+}
+
+static void
+sti_c(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    if (reg8_p(r0)) {
+      rex(_jit, 0, 0, r0, _NOREG, _NOREG);
+      ic(_jit, 0x88);
+      rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+    } else {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      movr(_jit, jit_gpr_regno(reg), r0);
+      rex(_jit, 0, 0, jit_gpr_regno(reg), _NOREG, _NOREG);
+      ic(_jit, 0x88);
+      rx(_jit, jit_gpr_regno(reg), i0, _NOREG, _NOREG, _SCL1);
+      unget_temp_gpr(_jit);
+    }
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_c(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+str_s(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ic(_jit, 0x66);
+  rex(_jit, 0, 0, r1, _NOREG, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r1, 0, r0, _NOREG, _SCL1);
+}
+
+static void
+sti_s(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    ic(_jit, 0x66);
+    rex(_jit, 0, 0, r0, _NOREG, _NOREG);
+    ic(_jit, 0x89);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_s(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+str_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 0, r1, _NOREG, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r1, 0, r0, _NOREG, _SCL1);
+}
+
+static void
+sti_i(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 0, r0, _NOREG, _NOREG);
+    ic(_jit, 0x89);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_i(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+
+#if __X64
+static void
+str_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 1, r1, _NOREG, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r1, 0, r0, _NOREG, _SCL1);
+}
+
+static void
+sti_l(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 1, r0, _NOREG, _NOREG);
+    ic(_jit, 0x89);
+    rx(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_l(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+#endif
+
+static void
+stxr_c(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (reg8_p(r2)) {
+    rex(_jit, 0, 0, r2, r1, r0);
+    ic(_jit, 0x88);
+    rx(_jit, r2, 0, r0, r1, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movr(_jit, jit_gpr_regno(reg), r2);
+    rex(_jit, 0, 0, jit_gpr_regno(reg), r1, r0);
+    ic(_jit, 0x88);
+    rx(_jit, jit_gpr_regno(reg), 0, r0, r1, _SCL1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxi_c(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0)) {
+    if (reg8_p(r1)) {
+      rex(_jit, 0, 0, r1, _NOREG, r0);
+      ic(_jit, 0x88);
+      rx(_jit, r1, i0, r0, _NOREG, _SCL1);
+    } else {
+      // Here we have a hack.  Normally tmp registers are just for the
+      // backend's use, but there are cases in which jit_move_operands
+      // can use a temp register too.  In a move of an operand to memory
+      // this would result in two simultaneous uses of a temp register.
+      // Oddly this situation only applies on 32-bit x86 with byte
+      // stores -- this is the only platform on which reg8_p can be
+      // false -- so we just make a special case here.
+      ASSERT(r0 != r1);
+      int32_t tmp = r0 == _RAX_REGNO ? _RCX_REGNO : _RAX_REGNO;
+      ASSERT(reg8_p(tmp));
+      pushr(_jit, tmp);
+      movr(_jit, tmp, r1);
+      if (r0 == _RSP_REGNO)
+        i0 += __WORDSIZE / 8;
+      rex(_jit, 0, 0, tmp, _NOREG, r0);
+      ic(_jit, 0x88);
+      rx(_jit, tmp, i0, r0, _NOREG, _SCL1);
+      popr(_jit, tmp);
+    }
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_c(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxr_s(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  ic(_jit, 0x66);
+  rex(_jit, 0, 0, r2, r1, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r2, 0, r0, r1, _SCL1);
+}
+
+static void
+stxi_s(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0)) {
+    ic(_jit, 0x66);
+    rex(_jit, 0, 0, r1, _NOREG, r0);
+    ic(_jit, 0x89);
+    rx(_jit, r1, i0, r0, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_s(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxr_i(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, 0, r2, r1, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r2, 0, r0, r1, _SCL1);
+}
+
+static void
+stxi_i(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 0, r1, _NOREG, r0);
+    ic(_jit, 0x89);
+    rx(_jit, r1, i0, r0, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_i(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+#if __X64
+static void
+stxr_l(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  rex(_jit, 0, 1, r2, r1, r0);
+  ic(_jit, 0x89);
+  rx(_jit, r2, 0, r0, r1, _SCL1);
+}
+
+static void
+stxi_l(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0)) {
+    rex(_jit, 0, 1, r1, _NOREG, r0);
+    ic(_jit, 0x89);
+    rx(_jit, r1, i0, r0, _NOREG, _SCL1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_l(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+#endif
+
+static jit_reloc_t
+jccs(jit_state_t *_jit, int32_t code)
+{
+  ic(_jit, 0x70 | code);
+  return emit_rel8_reloc(_jit, 1);
+}
+
+static jit_reloc_t
+jcc(jit_state_t *_jit, int32_t code)
+{
+  ic(_jit, 0x0f);
+  ic(_jit, 0x80 | code);
+  return emit_rel32_reloc(_jit, 2);
+}
+
+static void
+jcci(jit_state_t *_jit, int32_t code, jit_word_t i0)
+{
+  ptrdiff_t rel8 = i0 - (_jit->pc.w + 1 + 1);
+  ptrdiff_t rel32 = i0 - (_jit->pc.w + 2 + 4);
+  if (INT8_MIN <= rel8 && rel8 <= INT8_MAX)
+    {
+      ic(_jit, 0x70 | code);
+      ic(_jit, rel8);
+    }
+  else
+    {
+      ASSERT(INT32_MIN <= rel32 && rel32 <= INT32_MAX);
+      ic(_jit, 0x0f);
+      ic(_jit, 0x80 | code);
+      ii(_jit, rel32);
+    }
+}
+
+#define DEFINE_JUMPS(cc, CC, code)                                      \
+  static inline jit_reloc_t j##cc(jit_state_t *_jit)                    \
+  {                                                                     \
+    return jcc(_jit, X86_CC_##CC);                                      \
+  }                                                                     \
+  static inline jit_reloc_t j##cc##s(jit_state_t *_jit)                 \
+  {                                                                     \
+    return jccs(_jit, X86_CC_##CC);                                     \
+  }
+FOR_EACH_CC(DEFINE_JUMPS)
+#undef DEFINE_JUMPS
+
+static jit_reloc_t
+jcr(jit_state_t *_jit, int32_t code, int32_t r0, int32_t r1)
+{
+  alur(_jit, X86_CMP, r0, r1);
+  return jcc(_jit, code);
+}
+
+static jit_reloc_t
+jci(jit_state_t *_jit, int32_t code, int32_t r0, jit_word_t i0)
+{
+  alui(_jit, X86_CMP, r0, i0);
+  return jcc(_jit, code);
+}
+
+static jit_reloc_t
+jci0(jit_state_t *_jit, int32_t code, int32_t r0)
+{
+  testr(_jit, r0, r0);
+  return jcc(_jit, code);
+}
+
+static jit_reloc_t
+bltr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr(_jit, X86_CC_L, r0, r1);
+}
+
+static jit_reloc_t
+blti(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_L, r0, i1);
+  else    return jci0(_jit, X86_CC_S, r0);
+}
+
+static jit_reloc_t
+bltr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr(_jit, X86_CC_B, r0, r1);
+}
+
+static jit_reloc_t
+blti_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_B, r0, i1);
+  else    return jci0(_jit, X86_CC_B, r0);
+}
+
+static jit_reloc_t
+bler(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr (_jit, X86_CC_LE, r0, r1);
+}
+
+static jit_reloc_t
+blei(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_LE, r0, i1);
+  else    return jci0(_jit, X86_CC_LE, r0);
+}
+
+static jit_reloc_t
+bler_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr (_jit, X86_CC_BE, r0, r1);
+}
+
+static jit_reloc_t
+blei_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_BE, r0, i1);
+  else    return jci0(_jit, X86_CC_BE, r0);
+}
+
+static jit_reloc_t
+beqr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr (_jit, X86_CC_E, r0, r1);
+}
+
+static jit_reloc_t
+beqi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_E, r0, i1);
+  else    return jci0(_jit, X86_CC_E, r0);
+}
+
+static jit_reloc_t
+bger(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr (_jit, X86_CC_GE, r0, r1);
+}
+
+static jit_reloc_t
+bgei(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_GE, r0, i1);
+  else    return jci0(_jit, X86_CC_NS, r0);
+}
+
+static jit_reloc_t
+bger_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr (_jit, X86_CC_AE, r0, r1);
+}
+
+static jit_reloc_t
+bgei_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  return jci (_jit, X86_CC_AE, r0, i1);
+}
+
+static jit_reloc_t
+bgtr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr(_jit, X86_CC_G, r0, r1);
+}
+
+static jit_reloc_t
+bgti(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  return jci(_jit, X86_CC_G, r0, i1);
+}
+
+static jit_reloc_t
+bgtr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr(_jit, X86_CC_A, r0, r1);
+}
+
+static jit_reloc_t
+bgti_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_A, r0, i1);
+  else    return jci0(_jit, X86_CC_NE, r0);
+}
+
+static jit_reloc_t
+bner(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  return jcr(_jit, X86_CC_NE, r0, r1);
+}
+
+static jit_reloc_t
+bnei(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (i1) return jci (_jit, X86_CC_NE, r0, i1);
+  else    return jci0(_jit, X86_CC_NE, r0);
+}
+
+static jit_reloc_t
+bmsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  testr(_jit, r0, r1);
+  return jnz(_jit);
+}
+
+static jit_reloc_t
+bmsi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_zero_extend_int_p(i1)) {
+    testi(_jit, r0, i1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    testr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return jnz(_jit);
+}
+
+static jit_reloc_t
+bmcr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  testr(_jit, r0, r1);
+  return jz(_jit);
+}
+
+static jit_reloc_t
+bmci(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_zero_extend_int_p(i1)) {
+    testi(_jit, r0, i1);
+  } else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i1);
+    testr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+  return jz(_jit);
+}
+
+static jit_reloc_t
+boaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  iaddr(_jit, r0, r1);
+  return jo(_jit);
+}
+
+static jit_reloc_t
+boaddi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    iaddi(_jit, r0, i1);
+    return jo(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return boaddr(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+boaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  iaddr(_jit, r0, r1);
+  return jc(_jit);
+}
+
+static jit_reloc_t
+boaddi_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    iaddi(_jit, r0, i1);
+    return jc(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return boaddr_u(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bxaddr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  iaddr(_jit, r0, r1);
+  return jno(_jit);
+}
+
+static jit_reloc_t
+bxaddi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    iaddi(_jit, r0, i1);
+    return jno(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bxaddr(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bxaddr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  iaddr(_jit, r0, r1);
+  return jnc(_jit);
+}
+
+static jit_reloc_t
+bxaddi_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    iaddi(_jit, r0, i1);
+    return jnc(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bxaddr_u(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bosubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  isubr(_jit, r0, r1);
+  return jo(_jit);
+}
+
+static jit_reloc_t
+bosubi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    isubi(_jit, r0, i1);
+    return jo(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bosubr(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bosubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  isubr(_jit, r0, r1);
+  return jc(_jit);
+}
+
+static jit_reloc_t
+bosubi_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    isubi(_jit, r0, i1);
+    return jc(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bosubr_u(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bxsubr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  isubr(_jit, r0, r1);
+  return jno(_jit);
+}
+
+static jit_reloc_t
+bxsubi(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    isubi(_jit, r0, i1);
+    return jno(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bxsubr(_jit, r0, jit_gpr_regno(reg));
+}
+
+static jit_reloc_t
+bxsubr_u(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  isubr(_jit, r0, r1);
+  return jnc(_jit);
+}
+
+static jit_reloc_t
+bxsubi_u(jit_state_t *_jit, int32_t r0, jit_word_t i1)
+{
+  if (can_sign_extend_int_p(i1)) {
+    isubi(_jit, r0, i1);
+    return jnc(_jit);
+  }
+  jit_gpr_t reg = get_temp_gpr(_jit);
+  movi(_jit, jit_gpr_regno(reg), i1);
+  unget_temp_gpr(_jit);
+  return bxsubr_u(_jit, r0, jit_gpr_regno(reg));
+}
+
+static void
+callr(jit_state_t *_jit, int32_t r0)
+{
+  rex(_jit, 0, 0, _NOREG, _NOREG, r0);
+  ic(_jit, 0xff);
+  mrm(_jit, 0x03, 0x02, r7(r0));
+}
+
+static void
+calli(jit_state_t *_jit, jit_word_t i0)
+{
+  ptrdiff_t rel32 = i0 - (_jit->pc.w + 1 + 4);
+  if (INT32_MIN <= rel32 && rel32 <= INT32_MAX)
+    {
+      ic(_jit, 0xe8);
+      ii(_jit, rel32);
+    }
+  else
+    {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      jit_patch_there(_jit, mov_addr(_jit, jit_gpr_regno(reg)), (void*)i0);
+      callr(_jit, jit_gpr_regno(reg));
+      unget_temp_gpr(_jit);
+    }
+}
+
+static void
+jmpi_with_link(jit_state_t *_jit, jit_word_t i0)
+{
+  return calli(_jit, i0);
+}
+
+static void
+pop_link_register(jit_state_t *_jit)
+{
+  /* Treat this instruction as having no effect on the stack size; its
+   * effect is non-local (across functions) and handled manually.  */
+
+  int saved_frame_size = _jit->frame_size;
+  popr(_jit, jit_gpr_regno (JIT_LR));
+  _jit->frame_size = saved_frame_size;
+}
+
+static void
+push_link_register(jit_state_t *_jit)
+{
+  /* See comment in pop_link_register.  */
+
+  int saved_frame_size = _jit->frame_size;
+  pushr(_jit, jit_gpr_regno (JIT_LR));
+  _jit->frame_size = saved_frame_size;
+}
+
+static void
+jmpr(jit_state_t *_jit, int32_t r0)
+{
+  rex(_jit, 0, WIDE, _NOREG, _NOREG, r0);
+  ic(_jit, 0xff);
+  mrm(_jit, 0x03, 0x04, r7(r0));
+}
+
+static void
+jmpi(jit_state_t *_jit, jit_word_t i0)
+{
+  ptrdiff_t rel8 = i0 - (_jit->pc.w + 1 + 1);
+  ptrdiff_t rel32 = i0 - (_jit->pc.w + 1 + 4);
+  if (INT8_MIN <= rel8 && rel8 <= INT8_MAX)
+    {
+      ic(_jit, 0xeb);
+      ic(_jit, rel8);
+    }
+  else if (INT32_MIN <= rel32 && rel32 <= INT32_MAX)
+    {
+      ic(_jit, 0xe9);
+      ii(_jit, rel32);
+    }
+  else
+    {
+      jit_gpr_t reg = get_temp_gpr(_jit);
+      jit_patch_there(_jit, mov_addr(_jit, jit_gpr_regno(reg)), (void*)i0);
+      jmpr(_jit, jit_gpr_regno(reg));
+      unget_temp_gpr(_jit);
+    }
+}
+
+static jit_reloc_t
+jmp(jit_state_t *_jit)
+{
+  ic(_jit, 0xe9);
+  return emit_rel32_reloc(_jit, 1);
+}
+
+static void
+ret(jit_state_t *_jit)
+{
+  ic(_jit, 0xc3);
+}
+
+static void
+retr(jit_state_t *_jit, int32_t r0)
+{
+  movr(_jit, _RAX_REGNO, r0);
+  ret(_jit);
+}
+
+static void
+reti(jit_state_t *_jit, jit_word_t i0)
+{
+  movi(_jit, _RAX_REGNO, i0);
+  ret(_jit);
+}
+
+static void
+retval_c(jit_state_t *_jit, int32_t r0)
+{
+  extr_c(_jit, r0, _RAX_REGNO);
+}
+
+static void
+retval_uc(jit_state_t *_jit, int32_t r0)
+{
+  extr_uc(_jit, r0, _RAX_REGNO);
+}
+
+static void
+retval_s(jit_state_t *_jit, int32_t r0)
+{
+  extr_s(_jit, r0, _RAX_REGNO);
+}
+
+static void
+retval_us(jit_state_t *_jit, int32_t r0)
+{
+  extr_us(_jit, r0, _RAX_REGNO);
+}
+
+static void
+retval_i(jit_state_t *_jit, int32_t r0)
+{
+#if __X32
+  movr(_jit, r0, _RAX_REGNO);
+#else
+  extr_i(_jit, r0, _RAX_REGNO);
+#endif
+}
+
+#if __X64
+static void
+retval_ui(jit_state_t *_jit, int32_t r0)
+{
+  extr_ui(_jit, r0, _RAX_REGNO);
+}
+
+static void
+retval_l(jit_state_t *_jit, int32_t r0)
+{
+  movr(_jit, r0, _RAX_REGNO);
+}
+#endif
+
+static void
+mfence(jit_state_t *_jit)
+{
+  ic(_jit, 0x0f);
+  ic(_jit, 0xae);
+  ic(_jit, 0xf0);
+}
+
+static void
+ldr_atomic(jit_state_t *_jit, int32_t dst, int32_t loc)
+{
+#if __X64
+  ldr_l(_jit, dst, loc);
+#else
+  ldr_i(_jit, dst, loc);
+#endif
+}
+
+static void
+str_atomic(jit_state_t *_jit, int32_t loc, int32_t val)
+{
+#if __X64
+  str_l(_jit, loc, val);
+#else
+  str_i(_jit, loc, val);
+#endif
+  mfence(_jit);
+}
+
+static void
+swap_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t val)
+{
+  if (dst == val) {
+    xchgrm(_jit, dst, loc);
+  } else {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    movr(_jit, tmp, val);
+    xchgrm(_jit, tmp, loc);
+    movr(_jit, dst, tmp);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+cas_atomic(jit_state_t *_jit, int32_t dst, int32_t loc, int32_t expected,
+           int32_t desired)
+{
+  ASSERT(loc != expected);
+  ASSERT(loc != desired);
+
+  if (dst == jit_gpr_regno(_RAX)) {
+    if (loc == dst) {
+      int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+      movr(_jit, tmp ,loc);
+      movr(_jit, dst, expected);
+      cmpxchgmr(_jit, tmp, desired);
+      unget_temp_gpr(_jit);
+    } else {
+      movr(_jit, dst, expected);
+      cmpxchgmr(_jit, loc, desired);
+    }
+  } else if (loc == jit_gpr_regno(_RAX)) {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    movr(_jit, tmp, loc);
+    movr(_jit, jit_gpr_regno(_RAX), expected);
+    cmpxchgmr(_jit, tmp, desired);
+    movr(_jit, dst, jit_gpr_regno(_RAX));
+    movr(_jit, loc, tmp);
+    unget_temp_gpr(_jit);
+  } else if (expected == jit_gpr_regno(_RAX)) {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    movr(_jit, tmp, expected);
+    cmpxchgmr(_jit, loc, desired);
+    movr(_jit, dst, jit_gpr_regno(_RAX));
+    movr(_jit, expected, tmp);
+    unget_temp_gpr(_jit);
+  } else if (desired == jit_gpr_regno(_RAX)) {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    movr(_jit, tmp, desired);
+    movr(_jit, jit_gpr_regno(_RAX), expected);
+    cmpxchgmr(_jit, loc, tmp);
+    movr(_jit, dst, jit_gpr_regno(_RAX));
+    movr(_jit, desired, tmp);
+    unget_temp_gpr(_jit);
+  } else {
+    int32_t tmp = jit_gpr_regno(get_temp_gpr(_jit));
+    movr(_jit, tmp, jit_gpr_regno(_RAX));
+    movr(_jit, jit_gpr_regno(_RAX), expected);
+    cmpxchgmr(_jit, loc, desired);
+    movr(_jit, dst, jit_gpr_regno(_RAX));
+    movr(_jit, jit_gpr_regno(_RAX), tmp);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+breakpoint(jit_state_t *_jit)
+{
+  ic(_jit, 0xcc);
+}
diff --git a/libguile/lightening/lightening/x86-sse.c b/libguile/lightening/lightening/x86-sse.c
new file mode 100644
index 000000000..ab66dc7c5
--- /dev/null
+++ b/libguile/lightening/lightening/x86-sse.c
@@ -0,0 +1,1016 @@
+/*
+ * Copyright (C) 2012-2017, 2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#define _XMM0_REGNO                     0
+#define _XMM1_REGNO                     1
+#define _XMM2_REGNO                     2
+#define _XMM3_REGNO                     3
+#define _XMM4_REGNO                     4
+#define _XMM5_REGNO                     5
+#define _XMM6_REGNO                     6
+#define _XMM7_REGNO                     7
+#define _XMM8_REGNO                     8
+#define _XMM9_REGNO                     9
+#define _XMM10_REGNO                    10
+#define _XMM11_REGNO                    11
+#define _XMM12_REGNO                    12
+#define _XMM13_REGNO                    13
+#define _XMM14_REGNO                    14
+#define _XMM15_REGNO                    15
+#define X86_SSE_MOV                     0x10
+#define X86_SSE_MOV1                    0x11
+#define X86_SSE_MOVLP                   0x12
+#define X86_SSE_MOVHP                   0x16
+#define X86_SSE_MOVA                    0x28
+#define X86_SSE_CVTIS                   0x2a
+#define X86_SSE_CVTTSI                  0x2c
+#define X86_SSE_CVTSI                   0x2d
+#define X86_SSE_UCOMI                   0x2e
+#define X86_SSE_COMI                    0x2f
+#define X86_SSE_ROUND                   0x3a
+#define X86_SSE_SQRT                    0x51
+#define X86_SSE_RSQRT                   0x52
+#define X86_SSE_RCP                     0x53
+#define X86_SSE_AND                     0x54
+#define X86_SSE_ANDN                    0x55
+#define X86_SSE_OR                      0x56
+#define X86_SSE_XOR                     0x57
+#define X86_SSE_ADD                     0x58
+#define X86_SSE_MUL                     0x59
+#define X86_SSE_CVTSD                   0x5a
+#define X86_SSE_CVTDT                   0x5b
+#define X86_SSE_SUB                     0x5c
+#define X86_SSE_MIN                     0x5d
+#define X86_SSE_DIV                     0x5e
+#define X86_SSE_MAX                     0x5f
+#define X86_SSE_X2G                     0x6e
+#define X86_SSE_EQB                     0x74
+#define X86_SSE_EQW                     0x75
+#define X86_SSE_EQD                     0x76
+#define X86_SSE_G2X                     0x7e
+#define X86_SSE_MOV2                    0xd6
+
+static void
+sser(jit_state_t *_jit, int32_t c, int32_t r0, int32_t r1)
+{
+  rex(_jit, 0, 0, r0, 0, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, c);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+ssexr(jit_state_t *_jit, int32_t p, int32_t c,
+      int32_t r0, int32_t r1)
+{
+  ic(_jit, p);
+  rex(_jit, 0, 0, r0, 0, r1);
+  ic(_jit, 0x0f);
+  ic(_jit, c);
+  mrm(_jit, 0x03, r7(r0), r7(r1));
+}
+
+static void
+ssexi(jit_state_t *_jit, int32_t c, int32_t r0,
+      int32_t m, int32_t i)
+{
+  ic(_jit, 0x66);
+  rex(_jit, 0, 0, 0, 0, r0);
+  ic(_jit, 0x0f);
+  ic(_jit, c);
+  mrm(_jit, 0x03, r7(m), r7(r0));
+  ic(_jit, i);
+}
+
+static void
+sselxr(jit_state_t *_jit, int32_t p, int32_t c, int32_t r0, int32_t r1)
+{
+  if (__X64) {
+    ic(_jit, p);
+    rex(_jit, 0, 1, r0, 0, r1);
+    ic(_jit, 0x0f);
+    ic(_jit, c);
+    mrm(_jit, 0x03, r7(r0), r7(r1));
+  } else {
+    ssexr(_jit, p, c, r0, r1);
+  }
+}
+
+static void
+ssexrx(jit_state_t *_jit, int32_t px, int32_t code, int32_t md,
+       int32_t rb, int32_t ri, int32_t ms, int32_t rd)
+{
+  ic(_jit, px);
+  rex(_jit, 0, 0, rd, ri, rb);
+  ic(_jit, 0x0f);
+  ic(_jit, code);
+  rx(_jit, rd, md, rb, ri, ms);
+}
+
+static void
+movdlxr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_X2G, r0, r1);
+}
+
+static void movdqxr(jit_state_t *_jit, int32_t r0, int32_t r1) maybe_unused;
+static void
+movdqxr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sselxr(_jit, 0x66, X86_SSE_X2G, r0, r1);
+}
+
+static void
+movssmr(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms, int32_t rd)
+{
+  ssexrx(_jit, 0xf3, X86_SSE_MOV, md, rb, ri, ms, rd);
+}
+static void
+movsdmr(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms, int32_t rd)
+{
+  ssexrx(_jit, 0xf2, X86_SSE_MOV, md, rb, ri, ms, rd);
+}
+static void
+movssrm(jit_state_t *_jit, int32_t rs, int32_t md, int32_t mb, int32_t mi, int32_t ms)
+{
+  ssexrx(_jit, 0xf3, X86_SSE_MOV1, md, mb, mi, ms, rs);
+}
+static void
+movsdrm(jit_state_t *_jit, int32_t rs, int32_t md, int32_t mb, int32_t mi, int32_t ms)
+{
+  ssexrx(_jit, 0xf2, X86_SSE_MOV1, md, mb, mi, ms, rs);
+}
+
+static void
+movr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    ssexr(_jit, 0xf3, X86_SSE_MOV, r0, r1);
+}
+
+static void
+movr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 != r1)
+    ssexr(_jit, 0xf2, X86_SSE_MOV, r0, r1);
+}
+
+static void
+addssr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_ADD, r0, r1);
+}
+static void
+addsdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_ADD, r0, r1);
+}
+static void
+subssr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_SUB, r0, r1);
+}
+static void
+subsdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_SUB, r0, r1);
+}
+static void
+mulssr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_MUL, r0, r1);
+}
+static void
+mulsdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_MUL, r0, r1);
+}
+static void
+divssr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_DIV, r0, r1);
+}
+static void
+divsdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_DIV, r0, r1);
+}
+static void
+andpsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sser(_jit,        X86_SSE_AND, r0, r1);
+}
+static void
+andpdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_AND, r0, r1);
+}
+static void
+truncr_f_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_CVTTSI, r0, r1);
+}
+static void
+truncr_d_i(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_CVTTSI, r0, r1);
+}
+#if __X64
+static void
+truncr_f_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sselxr(_jit, 0xf3, X86_SSE_CVTTSI, r0, r1);
+}
+static void
+truncr_d_l(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sselxr(_jit, 0xf2, X86_SSE_CVTTSI, r0, r1);
+}
+#endif
+static void
+extr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sselxr(_jit, 0xf3, X86_SSE_CVTIS, r0, r1);
+}
+static void
+extr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sselxr(_jit, 0xf2, X86_SSE_CVTIS, r0, r1);
+}
+
+static void
+extr_f_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_CVTSD, r0, r1);
+}
+static void
+extr_d_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_CVTSD, r0, r1);
+}
+static void
+ucomissr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sser(_jit, X86_SSE_UCOMI, r0, r1);
+}
+static void
+ucomisdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_UCOMI, r0, r1);
+}
+static void
+xorpsr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  sser(_jit, X86_SSE_XOR, r0, r1);
+}
+static void
+xorpdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_XOR, r0, r1);
+}
+static void orpdr(jit_state_t *_jit, int32_t r0, int32_t r1) maybe_unused;
+static void
+orpdr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_OR, r0, r1);
+}
+static void
+pcmpeqlr(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0x66, X86_SSE_EQD, r0, r1);
+}
+static void
+psrl(jit_state_t *_jit, int32_t r0, int32_t i0)
+{
+  ssexi(_jit, 0x72, r0, 0x02, i0);
+}
+static void
+psrq(jit_state_t *_jit, int32_t r0, int32_t i0)
+{
+  ssexi(_jit, 0x73, r0, 0x02, i0);
+}
+static void
+pslq(jit_state_t *_jit, int32_t r0, int32_t i0)
+{
+  ssexi(_jit, 0x73, r0, 0x06, i0);
+}
+static void
+sqrtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf3, X86_SSE_SQRT, r0, r1);
+}
+static void
+sqrtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ssexr(_jit, 0xf2, X86_SSE_SQRT, r0, r1);
+}
+static void
+ldr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movssmr(_jit, 0, r1, _NOREG, _SCL1, r0);
+}
+static void
+str_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movssrm(_jit, r1, 0, r0, _NOREG, _SCL1);
+}
+static void
+ldr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movsdmr(_jit, 0, r1, _NOREG, _SCL1, r0);
+}
+static void
+str_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  movsdrm(_jit, r1, 0, r0, _NOREG, _SCL1);
+}
+
+static void
+movi_f(jit_state_t *_jit, int32_t r0, jit_float32_t i0)
+{
+  union {
+    int32_t i;
+    jit_float32_t f;
+  } data;
+
+  data.f = i0;
+  if (data.f == 0.0 && !(data.i & 0x80000000))
+    xorpsr(_jit, r0, r0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), data.i);
+    movdlxr(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+movi_d(jit_state_t *_jit, int32_t r0, jit_float64_t i0)
+{
+  union {
+    int32_t ii[2];
+    jit_word_t w;
+    jit_float64_t d;
+  } data;
+
+  data.d = i0;
+  if (data.d == 0.0 && !(data.ii[1] & 0x80000000))
+    xorpdr(_jit, r0, r0);
+  else {
+    jit_gpr_t ireg = get_temp_gpr(_jit);
+#if __X64
+    movi(_jit, jit_gpr_regno(ireg), data.w);
+    movdqxr(_jit, r0, jit_gpr_regno(ireg));
+    unget_temp_gpr(_jit);
+#else
+    jit_fpr_t freg = get_temp_fpr(_jit);
+    movi(_jit, jit_gpr_regno(ireg), data.ii[1]);
+    movdlxr(_jit, jit_fpr_regno(freg), jit_gpr_regno(ireg));
+    pslq(_jit, jit_fpr_regno(freg), 32);
+    movi(_jit, jit_gpr_regno(ireg), data.ii[0]);
+    movdlxr(_jit, r0, jit_gpr_regno(ireg));
+    orpdr(_jit, r0, jit_fpr_regno(freg));
+    unget_temp_fpr(_jit);
+    unget_temp_gpr(_jit);
+#endif
+  }
+}
+
+#if __X32
+static void
+x87rx(jit_state_t *_jit, int32_t code, int32_t md,
+      int32_t rb, int32_t ri, int32_t ms)
+{
+  rex(_jit, 0, 1, rb, ri, _NOREG);
+  ic(_jit, 0xd8 | (code >> 3));
+  rx(_jit, (code & 7), md, rb, ri, ms);
+}
+
+static void
+fldsm(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms)
+{
+  return x87rx(_jit, 010, md, rb, ri, ms);
+}
+
+static void
+fstsm(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms)
+{
+  return x87rx(_jit, 013, md, rb, ri, ms);
+}
+
+static void
+fldlm(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms)
+{
+  return x87rx(_jit, 050, md, rb, ri, ms);
+}
+
+static void
+fstlm(jit_state_t *_jit, int32_t md, int32_t rb, int32_t ri, int32_t ms)
+{
+  return x87rx(_jit, 053, md, rb, ri, ms);
+}
+#endif
+
+static void
+retval_f(jit_state_t *_jit, int32_t r0)
+{
+#if __X32
+  subi(_jit, _RSP_REGNO, _RSP_REGNO, 4);
+  fstsm(_jit, 0, _RSP_REGNO, _NOREG, _SCL1);
+  ldr_f(_jit, r0, _RSP_REGNO);
+  addi(_jit, _RSP_REGNO, _RSP_REGNO, 4);
+#else
+  movr_f(_jit, r0, _XMM0_REGNO);
+#endif
+}
+
+static void
+retval_d(jit_state_t *_jit, int32_t r0)
+{
+#if __X32
+  subi(_jit, _RSP_REGNO, _RSP_REGNO, 8);
+  fstlm(_jit, 0, _RSP_REGNO, _NOREG, _SCL1);
+  ldr_d(_jit, r0, _RSP_REGNO);
+  addi(_jit, _RSP_REGNO, _RSP_REGNO, 8);
+#else
+  movr_d(_jit, r0, _XMM0_REGNO);
+#endif
+}
+
+static void
+retr_f(jit_state_t *_jit, int32_t u)
+{
+#if __X32
+  subi(_jit, _RSP_REGNO, _RSP_REGNO, 4);
+  str_f(_jit, _RSP_REGNO, u);
+  fldsm(_jit, 0, _RSP_REGNO, _NOREG, _SCL1);
+  addi(_jit, _RSP_REGNO, _RSP_REGNO, 4);
+#else
+  movr_f(_jit, _XMM0_REGNO, u);
+#endif
+  ret(_jit);
+}
+
+static void
+retr_d(jit_state_t *_jit, int32_t u)
+{
+#if __X32
+  subi(_jit, _RSP_REGNO, _RSP_REGNO, 8);
+  str_d(_jit, _RSP_REGNO, u);
+  fldlm(_jit, 0, _RSP_REGNO, _NOREG, _SCL1);
+  addi(_jit, _RSP_REGNO, _RSP_REGNO, 8);
+#else
+  movr_d(_jit, _XMM0_REGNO, u);
+#endif
+  ret(_jit);
+}
+
+static void
+addr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    addssr(_jit, r0, r2);
+  else if (r0 == r2)
+    addssr(_jit, r0, r1);
+  else {
+    movr_f(_jit, r0, r1);
+    addssr(_jit, r0, r2);
+  }
+}
+
+static void
+addr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    addsdr(_jit, r0, r2);
+  else if (r0 == r2)
+    addsdr(_jit, r0, r1);
+  else {
+    movr_d(_jit, r0, r1);
+    addsdr(_jit, r0, r2);
+  }
+}
+
+static void
+subr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    subssr(_jit, r0, r2);
+  else if (r0 == r2) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    movr_f(_jit, jit_fpr_regno(reg), r0);
+    movr_f(_jit, r0, r1);
+    subssr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    movr_f(_jit, r0, r1);
+    subssr(_jit, r0, r2);
+  }
+}
+
+static void
+subr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    subsdr(_jit, r0, r2);
+  else if (r0 == r2) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    movr_d(_jit, jit_fpr_regno(reg), r0);
+    movr_d(_jit, r0, r1);
+    subsdr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    movr_d(_jit, r0, r1);
+    subsdr(_jit, r0, r2);
+  }
+}
+
+static void
+mulr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    mulssr(_jit, r0, r2);
+  else if (r0 == r2)
+    mulssr(_jit, r0, r1);
+  else {
+    movr_f(_jit, r0, r1);
+    mulssr(_jit, r0, r2);
+  }
+}
+
+static void
+mulr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    mulsdr(_jit, r0, r2);
+  else if (r0 == r2)
+    mulsdr(_jit, r0, r1);
+  else {
+    movr_d(_jit, r0, r1);
+    mulsdr(_jit, r0, r2);
+  }
+}
+
+static void
+divr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    divssr(_jit, r0, r2);
+  else if (r0 == r2) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    movr_f(_jit, jit_fpr_regno(reg), r0);
+    movr_f(_jit, r0, r1);
+    divssr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    movr_f(_jit, r0, r1);
+    divssr(_jit, r0, r2);
+  }
+}
+
+static void
+divr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  if (r0 == r1)
+    divsdr(_jit, r0, r2);
+  else if (r0 == r2) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    movr_d(_jit, jit_fpr_regno(reg), r0);
+    movr_d(_jit, r0, r1);
+    divsdr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    movr_d(_jit, r0, r1);
+    divsdr(_jit, r0, r2);
+  }
+}
+
+static void
+absr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 == r1) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    pcmpeqlr(_jit, jit_fpr_regno(reg), jit_fpr_regno(reg));
+    psrl(_jit, jit_fpr_regno(reg), 1);
+    andpsr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    pcmpeqlr(_jit, r0, r0);
+    psrl(_jit, r0, 1);
+    andpsr(_jit, r0, r1);
+  }
+}
+
+static void
+absr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  if (r0 == r1) {
+    jit_fpr_t reg = get_temp_fpr(_jit);
+    pcmpeqlr(_jit, jit_fpr_regno(reg), jit_fpr_regno(reg));
+    psrq(_jit, jit_fpr_regno(reg), 1);
+    andpdr(_jit, r0, jit_fpr_regno(reg));
+    unget_temp_fpr(_jit);
+  }
+  else {
+    pcmpeqlr(_jit, r0, r0);
+    psrq(_jit, r0, 1);
+    andpdr(_jit, r0, r1);
+  }
+}
+
+static void
+negr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t ireg = get_temp_gpr(_jit);
+  imovi(_jit, jit_gpr_regno(ireg), 0x80000000);
+  if (r0 == r1) {
+    jit_fpr_t freg = get_temp_fpr(_jit);
+    movdlxr(_jit, jit_fpr_regno(freg), jit_gpr_regno(ireg));
+    xorpsr(_jit, r0, jit_fpr_regno(freg));
+    unget_temp_fpr(_jit);
+  } else {
+    movdlxr(_jit, r0, jit_gpr_regno(ireg));
+    xorpsr(_jit, r0, r1);
+  }
+  unget_temp_gpr(_jit);
+}
+
+static void
+negr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  jit_gpr_t ireg = get_temp_gpr(_jit);
+  imovi(_jit, jit_gpr_regno(ireg), 0x80000000);
+  if (r0 == r1) {
+    jit_fpr_t freg = get_temp_fpr(_jit);
+    movdlxr(_jit, jit_fpr_regno(freg), jit_gpr_regno(ireg));
+    pslq(_jit, jit_fpr_regno(freg), 32);
+    xorpdr(_jit, r0, jit_fpr_regno(freg));
+    unget_temp_fpr(_jit);
+  } else {
+    movdlxr(_jit, r0, jit_gpr_regno(ireg));
+    pslq(_jit, r0, 32);
+    xorpdr(_jit, r0, r1);
+  }
+  unget_temp_gpr(_jit);
+}
+
+static void
+ldi_f(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0))
+    movssmr(_jit, i0, _NOREG, _NOREG, _SCL1, r0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_f(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  movssmr(_jit, 0, r1, r2, _SCL1, r0);
+}
+
+static void
+ldxi_f(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0))
+    movssmr(_jit, i0, r1, _NOREG, _SCL1, r0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_f(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+sti_f(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0))
+    movssrm(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_f(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxr_f(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  movssrm(_jit, r2, 0, r0, r1, _SCL1);
+}
+
+static void
+stxi_f(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0))
+    movssrm(_jit, r1, i0, r0, _NOREG, _SCL1);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_f(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static jit_reloc_t
+bltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r1, r0);
+  return ja(_jit);
+}
+
+static jit_reloc_t
+bler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r1, r0);
+  return jae(_jit);
+}
+
+static jit_reloc_t
+beqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  jit_reloc_t pos = jps(_jit);
+  jit_reloc_t ret = je(_jit);
+  jit_patch_here(_jit, pos);
+  return ret;
+}
+
+static jit_reloc_t
+bger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jae(_jit);
+}
+
+static jit_reloc_t
+bgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return ja(_jit);
+}
+
+static jit_reloc_t
+bner_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  jit_reloc_t pos = jps(_jit);
+  jit_reloc_t zero = jzs(_jit);
+  jit_patch_here(_jit, pos);
+  jit_reloc_t ret = jmp(_jit);
+  jit_patch_here(_jit, zero);
+  return ret;
+}
+
+static jit_reloc_t
+bunltr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jnae(_jit);
+}
+
+static jit_reloc_t
+bunler_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jna(_jit);
+}
+
+static jit_reloc_t
+buneqr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return je(_jit);
+}
+
+static jit_reloc_t
+bunger_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r1, r0);
+  return jna(_jit);
+}
+
+static jit_reloc_t
+bungtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r1, r0);
+  return jnae(_jit);
+}
+
+static jit_reloc_t
+bltgtr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jne(_jit);
+}
+
+static jit_reloc_t
+bordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jnp(_jit);
+}
+
+static jit_reloc_t
+bunordr_f(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomissr(_jit, r0, r1);
+  return jp(_jit);
+}
+
+static void
+ldi_d(jit_state_t *_jit, int32_t r0, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0))
+    movsdmr(_jit, i0, _NOREG, _NOREG, _SCL1, r0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldr_d(_jit, r0, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+ldxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  movsdmr(_jit, 0, r1, r2, _SCL1, r0);
+}
+
+static void
+ldxi_d(jit_state_t *_jit, int32_t r0, int32_t r1, jit_word_t i0)
+{
+  if (can_sign_extend_int_p(i0))
+    movsdmr(_jit, i0, r1, _NOREG, _SCL1, r0);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    ldxr_d(_jit, r0, r1, jit_gpr_regno(reg));
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+sti_d(jit_state_t *_jit, jit_word_t i0, int32_t r0)
+{
+  if (can_sign_extend_int_p(i0))
+    movsdrm(_jit, r0, i0, _NOREG, _NOREG, _SCL1);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    str_d(_jit, jit_gpr_regno(reg), r0);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static void
+stxr_d(jit_state_t *_jit, int32_t r0, int32_t r1, int32_t r2)
+{
+  movsdrm(_jit, r2, 0, r0, r1, _SCL1);
+}
+
+static void
+stxi_d(jit_state_t *_jit, jit_word_t i0, int32_t r0, int32_t r1)
+{
+  if (can_sign_extend_int_p(i0))
+    movsdrm(_jit, r1, i0, r0, _NOREG, _SCL1);
+  else {
+    jit_gpr_t reg = get_temp_gpr(_jit);
+    movi(_jit, jit_gpr_regno(reg), i0);
+    stxr_d(_jit, jit_gpr_regno(reg), r0, r1);
+    unget_temp_gpr(_jit);
+  }
+}
+
+static jit_reloc_t
+bltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r1, r0);
+  return ja(_jit);
+}
+
+static jit_reloc_t
+bler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r1, r0);
+  return jae(_jit);
+}
+
+static jit_reloc_t
+beqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  jit_reloc_t pos = jps(_jit);
+  jit_reloc_t ret = je(_jit);
+  jit_patch_here(_jit, pos);
+  return ret;
+}
+
+static jit_reloc_t
+bger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jae(_jit);
+}
+
+static jit_reloc_t
+bgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return ja(_jit);
+}
+
+static jit_reloc_t
+bner_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  jit_reloc_t pos = jps(_jit);
+  jit_reloc_t zero = jzs(_jit);
+  jit_patch_here(_jit, pos);
+  jit_reloc_t ret = jmp(_jit);
+  jit_patch_here(_jit, zero);
+  return ret;
+}
+
+static jit_reloc_t
+bunltr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jnae(_jit);
+}
+
+static jit_reloc_t
+bunler_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jna(_jit);
+}
+
+static jit_reloc_t
+buneqr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return je(_jit);
+}
+
+static jit_reloc_t
+bunger_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r1, r0);
+  return jna(_jit);
+}
+
+static jit_reloc_t
+bungtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r1, r0);
+  return jnae(_jit);
+}
+
+static jit_reloc_t
+bltgtr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jne(_jit);
+}
+
+static jit_reloc_t
+bordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jnp(_jit);
+}
+
+static jit_reloc_t
+bunordr_d(jit_state_t *_jit, int32_t r0, int32_t r1)
+{
+  ucomisdr(_jit, r0, r1);
+  return jp(_jit);
+}
diff --git a/libguile/lightening/lightening/x86.c b/libguile/lightening/lightening/x86.c
new file mode 100644
index 000000000..965191a4c
--- /dev/null
+++ b/libguile/lightening/lightening/x86.c
@@ -0,0 +1,407 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#define _NOREG 0xffff
+
+typedef struct {
+  /* x87 present */
+  uint32_t fpu                : 1;
+  /* cmpxchg8b instruction */
+  uint32_t cmpxchg8b  : 1;
+  /* cmov and fcmov branchless conditional mov */
+  uint32_t cmov               : 1;
+  /* mmx registers/instructions available */
+  uint32_t mmx                : 1;
+  /* sse registers/instructions available */
+  uint32_t sse                : 1;
+  /* sse2 registers/instructions available */
+  uint32_t sse2               : 1;
+  /* sse3 instructions available */
+  uint32_t sse3               : 1;
+  /* pcmulqdq instruction */
+  uint32_t pclmulqdq  : 1;
+  /* ssse3 suplemental sse3 instructions available */
+  uint32_t ssse3              : 1;
+  /* fused multiply/add using ymm state */
+  uint32_t fma                : 1;
+  /* cmpxchg16b instruction */
+  uint32_t cmpxchg16b : 1;
+  /* sse4.1 instructions available */
+  uint32_t sse4_1             : 1;
+  /* sse4.2 instructions available */
+  uint32_t sse4_2             : 1;
+  /* movbe instruction available */
+  uint32_t movbe              : 1;
+  /* popcnt instruction available */
+  uint32_t popcnt             : 1;
+  /* aes instructions available */
+  uint32_t aes                : 1;
+  /* avx instructions available */
+  uint32_t avx                : 1;
+  /* lahf/sahf available in 64 bits mode */
+  uint32_t lahf               : 1;
+} jit_cpu_t;
+
+static jit_cpu_t jit_cpu;
+
+static inline jit_reloc_t
+emit_rel8_reloc (jit_state_t *_jit, uint8_t inst_start)
+{
+  uint8_t *loc = _jit->pc.uc;
+  emit_u8 (_jit, 0);
+  return jit_reloc(_jit, JIT_RELOC_REL8, inst_start, loc, _jit->pc.uc, 0);
+}
+
+static inline jit_reloc_t
+emit_rel32_reloc (jit_state_t *_jit, uint8_t inst_start)
+{
+  uint8_t *loc = _jit->pc.uc;
+  emit_u32 (_jit, 0);
+  return jit_reloc(_jit, JIT_RELOC_REL32, inst_start, loc, _jit->pc.uc, 0);
+}
+
+static inline jit_reloc_t
+emit_abs_reloc (jit_state_t *_jit, uint8_t inst_start)
+{
+  uint8_t *loc = _jit->pc.uc;
+  if (sizeof(intptr_t) == 4)
+    emit_u32 (_jit, 0);
+  else
+    emit_u64 (_jit, 0);
+  return jit_reloc(_jit, JIT_RELOC_ABSOLUTE, inst_start, loc, _jit->pc.uc, 0);
+}
+
+#include "x86-cpu.c"
+#include "x86-sse.c"
+
+jit_bool_t
+jit_get_cpu(void)
+{
+  union {
+    struct {
+      uint32_t sse3               : 1;
+      uint32_t pclmulqdq    : 1;
+      uint32_t dtes64       : 1;    /* amd reserved */
+      uint32_t monitor      : 1;
+      uint32_t ds_cpl       : 1;    /* amd reserved */
+      uint32_t vmx          : 1;    /* amd reserved */
+      uint32_t smx          : 1;    /* amd reserved */
+      uint32_t est          : 1;    /* amd reserved */
+      uint32_t tm2          : 1;    /* amd reserved */
+      uint32_t ssse3        : 1;
+      uint32_t cntx_id      : 1;    /* amd reserved */
+      uint32_t __reserved0  : 1;
+      uint32_t fma          : 1;
+      uint32_t cmpxchg16b   : 1;
+      uint32_t xtpr         : 1;    /* amd reserved */
+      uint32_t pdcm         : 1;    /* amd reserved */
+      uint32_t __reserved1  : 1;
+      uint32_t pcid         : 1;    /* amd reserved */
+      uint32_t dca          : 1;    /* amd reserved */
+      uint32_t sse4_1       : 1;
+      uint32_t sse4_2       : 1;
+      uint32_t x2apic       : 1;    /* amd reserved */
+      uint32_t movbe        : 1;    /* amd reserved */
+      uint32_t popcnt       : 1;
+      uint32_t tsc          : 1;    /* amd reserved */
+      uint32_t aes          : 1;
+      uint32_t xsave        : 1;
+      uint32_t osxsave      : 1;
+      uint32_t avx          : 1;
+      uint32_t __reserved2  : 1;    /* amd F16C */
+      uint32_t __reserved3  : 1;
+      uint32_t __alwayszero : 1;    /* amd RAZ */
+    } bits;
+    jit_uword_t     cpuid;
+  } ecx;
+  union {
+    struct {
+      uint32_t fpu          : 1;
+      uint32_t vme          : 1;
+      uint32_t de           : 1;
+      uint32_t pse          : 1;
+      uint32_t tsc          : 1;
+      uint32_t msr          : 1;
+      uint32_t pae          : 1;
+      uint32_t mce          : 1;
+      uint32_t cmpxchg8b    : 1;
+      uint32_t apic         : 1;
+      uint32_t __reserved0  : 1;
+      uint32_t sep          : 1;
+      uint32_t mtrr         : 1;
+      uint32_t pge          : 1;
+      uint32_t mca          : 1;
+      uint32_t cmov         : 1;
+      uint32_t pat          : 1;
+      uint32_t pse36        : 1;
+      uint32_t psn          : 1;    /* amd reserved */
+      uint32_t clfsh        : 1;
+      uint32_t __reserved1  : 1;
+      uint32_t ds           : 1;    /* amd reserved */
+      uint32_t acpi         : 1;    /* amd reserved */
+      uint32_t mmx          : 1;
+      uint32_t fxsr         : 1;
+      uint32_t sse          : 1;
+      uint32_t sse2         : 1;
+      uint32_t ss           : 1;    /* amd reserved */
+      uint32_t htt          : 1;
+      uint32_t tm           : 1;    /* amd reserved */
+      uint32_t __reserved2  : 1;
+      uint32_t pbe          : 1;    /* amd reserved */
+    } bits;
+    jit_uword_t     cpuid;
+  } edx;
+#if __X32
+  int ac, flags;
+#endif
+  jit_uword_t         eax, ebx;
+
+#if __X32
+  /* adapted from glibc __sysconf */
+  __asm__ volatile ("pushfl;\n\t"
+                    "popl %0;\n\t"
+                    "movl $0x240000, %1;\n\t"
+                    "xorl %0, %1;\n\t"
+                    "pushl %1;\n\t"
+                    "popfl;\n\t"
+                    "pushfl;\n\t"
+                    "popl %1;\n\t"
+                    "xorl %0, %1;\n\t"
+                    "pushl %0;\n\t"
+                    "popfl"
+                    : "=r" (flags), "=r" (ac));
+
+  /* i386 or i486 without cpuid */
+  if ((ac & (1 << 21)) == 0)
+    /* probably without x87 as well */
+    return 0;
+#endif
+
+    /* query %eax = 1 function */
+  __asm__ volatile (
+#if __X32 || __X64_32
+                    "xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1"
+#else
+                    "xchgq %%rbx, %1; cpuid; xchgq %%rbx, %1"
+#endif
+                    : "=a" (eax), "=r" (ebx),
+                    "=c" (ecx.cpuid), "=d" (edx.cpuid)
+                    : "0" (1));
+
+  jit_cpu.fpu         = edx.bits.fpu;
+  jit_cpu.cmpxchg8b   = edx.bits.cmpxchg8b;
+  jit_cpu.cmov        = edx.bits.cmov;
+  jit_cpu.mmx         = edx.bits.mmx;
+  jit_cpu.sse         = edx.bits.sse;
+  jit_cpu.sse2        = edx.bits.sse2;
+  jit_cpu.sse3        = ecx.bits.sse3;
+  jit_cpu.pclmulqdq   = ecx.bits.pclmulqdq;
+  jit_cpu.ssse3       = ecx.bits.ssse3;
+  jit_cpu.fma         = ecx.bits.fma;
+  jit_cpu.cmpxchg16b  = ecx.bits.cmpxchg16b;
+  jit_cpu.sse4_1      = ecx.bits.sse4_1;
+  jit_cpu.sse4_2      = ecx.bits.sse4_2;
+  jit_cpu.movbe       = ecx.bits.movbe;
+  jit_cpu.popcnt      = ecx.bits.popcnt;
+  jit_cpu.aes         = ecx.bits.aes;
+  jit_cpu.avx         = ecx.bits.avx;
+
+    /* query %eax = 0x80000001 function */
+#if __X64
+  __asm__ volatile (
+#  if __X64_32
+                    "xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1"
+#  else
+                    "xchgq %%rbx, %1; cpuid; xchgq %%rbx, %1"
+#  endif
+                    : "=a" (eax), "=r" (ebx),
+                    "=c" (ecx.cpuid), "=d" (edx.cpuid)
+                    : "0" (0x80000001));
+  jit_cpu.lahf        = ecx.cpuid & 1;
+#endif
+
+  return jit_cpu.sse2;
+}
+
+jit_bool_t
+jit_init(jit_state_t *_jit)
+{
+  return jit_cpu.sse2;
+}
+
+static const jit_gpr_t abi_gpr_args[] = {
+#if __X32
+  /* No GPRs in args.  */
+#elif __CYGWIN__
+  _RCX, _RDX, _R8, _R9
+#else
+  _RDI, _RSI, _RDX, _RCX, _R8, _R9
+#endif
+};
+
+static const jit_fpr_t abi_fpr_args[] = {
+#if __X32
+  /* No FPRs in args.  */
+#elif __CYGWIN__
+  _XMM0, _XMM1, _XMM2, _XMM3
+#else
+  _XMM0, _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7
+#endif
+};
+
+static const int abi_gpr_arg_count = sizeof(abi_gpr_args) / sizeof(abi_gpr_args[0]);
+static const int abi_fpr_arg_count = sizeof(abi_fpr_args) / sizeof(abi_fpr_args[0]);
+
+struct abi_arg_iterator
+{
+  const jit_operand_t *args;
+  size_t argc;
+
+  size_t arg_idx;
+  size_t gpr_idx;
+  size_t fpr_idx;
+  size_t stack_size;
+  size_t stack_padding;
+};
+
+static size_t
+jit_operand_abi_sizeof(enum jit_operand_abi abi)
+{
+  switch (abi) {
+  case JIT_OPERAND_ABI_UINT8:
+  case JIT_OPERAND_ABI_INT8:
+    return 1;
+  case JIT_OPERAND_ABI_UINT16:
+  case JIT_OPERAND_ABI_INT16:
+    return 2;
+  case JIT_OPERAND_ABI_UINT32:
+  case JIT_OPERAND_ABI_INT32:
+    return 4;
+  case JIT_OPERAND_ABI_UINT64:
+  case JIT_OPERAND_ABI_INT64:
+    return 8;
+  case JIT_OPERAND_ABI_POINTER:
+    return CHOOSE_32_64(4, 8);
+  case JIT_OPERAND_ABI_FLOAT:
+    return 4;
+  case JIT_OPERAND_ABI_DOUBLE:
+    return 8;
+  default:
+    abort();
+  }
+}
+
+static size_t
+round_size_up_to_words(size_t bytes)
+{
+  size_t word_size = CHOOSE_32_64(4, 8);
+  size_t words = (bytes + word_size - 1) / word_size;
+  return words * word_size;
+}
+
+static size_t
+jit_initial_frame_size (void)
+{
+  return __WORDSIZE / 8; // Saved return address is on stack.
+}
+
+static void
+reset_abi_arg_iterator(struct abi_arg_iterator *iter, size_t argc,
+                       const jit_operand_t *args)
+{
+  memset(iter, 0, sizeof *iter);
+  iter->argc = argc;
+  iter->args = args;
+}
+
+static void
+next_abi_arg(struct abi_arg_iterator *iter, jit_operand_t *arg)
+{
+  ASSERT(iter->arg_idx < iter->argc);
+  enum jit_operand_abi abi = iter->args[iter->arg_idx].abi;
+  if (is_gpr_arg(abi) && iter->gpr_idx < abi_gpr_arg_count) {
+    *arg = jit_operand_gpr (abi, abi_gpr_args[iter->gpr_idx++]);
+#ifdef __CYGWIN__
+    iter->fpr_idx++;
+#endif
+  } else if (is_fpr_arg(abi) && iter->fpr_idx < abi_fpr_arg_count) {
+    *arg = jit_operand_fpr (abi, abi_fpr_args[iter->fpr_idx++]);
+#ifdef __CYGWIN__
+    iter->gpr_idx++;
+#endif
+  } else {
+    *arg = jit_operand_mem (abi, JIT_SP, iter->stack_size);
+    size_t bytes = jit_operand_abi_sizeof (abi);
+    iter->stack_size += round_size_up_to_words (bytes);
+  }
+  iter->arg_idx++;
+}
+
+static void
+jit_flush(void *fptr, void *tptr)
+{
+}
+
+static inline size_t
+jit_stack_alignment(void)
+{
+  return 16;
+}
+
+static void
+jit_try_shorten(jit_state_t *_jit, jit_reloc_t reloc, jit_pointer_t addr)
+{
+  uint8_t *loc = _jit->start + reloc.offset;
+  uint8_t *start = loc - reloc.inst_start_offset;
+  jit_imm_t i0 = (jit_imm_t)addr;
+
+  switch (reloc.kind)
+    {
+    case JIT_RELOC_ABSOLUTE: {
+      _jit->pc.uc = start;
+      ASSERT((loc[-1] & ~7) == 0xb8); // MOVI
+      int32_t r0 = loc[-1] & 7;
+      if (start != loc - 1) {
+        ASSERT(start == loc - 2);
+        r0 |= (loc[-2] & 1) << 3;
+      }
+      return movi(_jit, r0, i0);
+    }
+    case JIT_RELOC_REL8:
+      ASSERT((loc[-1] & ~0xf) == 0x70 || loc[-1] == 0xeb); // JCCSI or JMPSI
+      /* Nothing useful to do.  */
+      return;
+    case JIT_RELOC_REL32:
+      _jit->pc.uc = start;
+      if (start[0] == 0xe9) { // JMP
+        return jmpi(_jit, i0);
+      }
+      ASSERT(start[0] == 0x0f); // JCC
+      return jcci(_jit, start[1] & ~0x80, i0);
+    default:
+      /* We don't emit other kinds of reloc.  */
+      abort ();
+    }
+}
+
+static void*
+bless_function_pointer(void *ptr)
+{
+  return ptr;
+}
diff --git a/libguile/lightening/lightening/x86.h b/libguile/lightening/lightening/x86.h
new file mode 100644
index 000000000..983ebdb8f
--- /dev/null
+++ b/libguile/lightening/lightening/x86.h
@@ -0,0 +1,161 @@
+/*
+ * Copyright (C) 2012-2019  Free Software Foundation, Inc.
+ *
+ * This file is part of GNU lightning.
+ *
+ * GNU lightning is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; either version 3, or (at your option)
+ * any later version.
+ *
+ * GNU lightning is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * Authors:
+ *      Paulo Cesar Pereira de Andrade
+ */
+
+#ifndef _jit_x86_h
+#define _jit_x86_h
+
+#if __WORDSIZE == 32
+# if defined(__x86_64__)
+#  define __X64    1
+#  define __X64_32 1
+#  define __X32    0
+# else
+#  define __X64    0
+#  define __X64_32 0
+#  define __X32    1
+# endif
+#else
+#  define __X64    1
+#  define __X64_32 0
+#  define __X32    0
+#endif
+
+#define _RAX     JIT_GPR(0)
+#define _RCX     JIT_GPR(1)
+#define _RDX     JIT_GPR(2)
+#define _RBX     JIT_GPR(3)
+#define _RSP     JIT_GPR(4)
+#define _RBP     JIT_GPR(5)
+#define _RSI     JIT_GPR(6)
+#define _RDI     JIT_GPR(7)
+
+#define _XMM0    JIT_FPR(0)
+#define _XMM1    JIT_FPR(1)
+#define _XMM2    JIT_FPR(2)
+#define _XMM3    JIT_FPR(3)
+#define _XMM4    JIT_FPR(4)
+#define _XMM5    JIT_FPR(5)
+#define _XMM6    JIT_FPR(6)
+#define _XMM7    JIT_FPR(7)
+
+#if __X64
+#  define _R8      JIT_GPR(8)
+#  define _R9      JIT_GPR(9)
+#  define _R10     JIT_GPR(10)
+#  define _R11     JIT_GPR(11)
+#  define _R12     JIT_GPR(12)
+#  define _R13     JIT_GPR(13)
+#  define _R14     JIT_GPR(14)
+#  define _R15     JIT_GPR(15)
+#  define _XMM8    JIT_FPR(8)
+#  define _XMM9    JIT_FPR(9)
+#  define _XMM10   JIT_FPR(10)
+#  define _XMM11   JIT_FPR(11)
+#  define _XMM12   JIT_FPR(12)
+#  define _XMM13   JIT_FPR(13)
+#  define _XMM14   JIT_FPR(14)
+#  define _XMM15   JIT_FPR(15)
+#endif
+
+#define JIT_SP     _RSP
+#define JIT_LR     JIT_TMP0
+#if __X32
+#  define JIT_R0   _RAX
+#  define JIT_R1   _RCX
+#  define JIT_R2   _RDX
+#  define JIT_V0   _RBP
+#  define JIT_V1   _RSI
+#  define JIT_V2   _RDI
+#  define JIT_TMP0 _RBX
+#  define JIT_F0   _XMM0
+#  define JIT_F1   _XMM1
+#  define JIT_F2   _XMM2
+#  define JIT_F3   _XMM3
+#  define JIT_F4   _XMM4
+#  define JIT_F5   _XMM5
+#  define JIT_F6   _XMM6
+#  define JIT_FTMP _XMM7
+#  define JIT_PLATFORM_CALLEE_SAVE_GPRS JIT_TMP0
+#elif __CYGWIN__
+#  define JIT_R0   _RAX
+#  define JIT_R1   _RCX
+#  define JIT_R2   _RDX
+#  define JIT_R3   _R8
+#  define JIT_R4   _R9
+#  define JIT_R5   _R10
+#  define JIT_TMP0 _R11
+#  define JIT_V0   _RBX
+#  define JIT_V1   _RSI
+#  define JIT_V2   _RDI
+#  define JIT_V3   _R12
+#  define JIT_V4   _R13
+#  define JIT_V5   _R14
+#  define JIT_V6   _R15
+#  define JIT_F0   _XMM0
+#  define JIT_F1   _XMM1
+#  define JIT_F2   _XMM2
+#  define JIT_F3   _XMM3
+#  define JIT_F4   _XMM4
+#  define JIT_FTMP  _XMM5
+#  define JIT_VF0  _XMM6
+#  define JIT_VF1  _XMM7
+#  define JIT_VF2  _XMM8
+#  define JIT_VF3  _XMM9
+#  define JIT_VF4  _XMM10
+#  define JIT_VF5  _XMM11
+#  define JIT_VF6  _XMM12
+#  define JIT_VF7  _XMM13
+#  define JIT_VF8  _XMM14
+#  define JIT_VF9  _XMM15
+#  define JIT_PLATFORM_CALLEE_SAVE_GPRS /**/
+#else
+#  define JIT_R0   _RAX
+#  define JIT_R1   _RCX
+#  define JIT_R2   _RDX
+#  define JIT_R3   _RSI
+#  define JIT_R4   _RDI
+#  define JIT_R5   _R8
+#  define JIT_R6   _R9
+#  define JIT_R7   _R10
+#  define JIT_TMP0 _R11
+#  define JIT_V0   _RBX
+#  define JIT_V1   _R12
+#  define JIT_V2   _R13
+#  define JIT_V3   _R14
+#  define JIT_V4   _R15
+#  define JIT_F0   _XMM0
+#  define JIT_F1   _XMM1
+#  define JIT_F2   _XMM2
+#  define JIT_F3   _XMM3
+#  define JIT_F4   _XMM4
+#  define JIT_F5   _XMM5
+#  define JIT_F6   _XMM6
+#  define JIT_F7   _XMM7
+#  define JIT_F8   _XMM8
+#  define JIT_F9   _XMM9
+#  define JIT_F10  _XMM10
+#  define JIT_F11  _XMM11
+#  define JIT_F12  _XMM12
+#  define JIT_F13  _XMM13
+#  define JIT_F14  _XMM14
+#  define JIT_FTMP _XMM15
+#  define JIT_PLATFORM_CALLEE_SAVE_GPRS /**/
+#endif
+
+#endif /* _jit_x86_h */
diff --git a/libguile/lightening/lightning.texi b/libguile/lightening/lightning.texi
new file mode 100644
index 000000000..88f397a37
--- /dev/null
+++ b/libguile/lightening/lightning.texi
@@ -0,0 +1,1760 @@
+\input texinfo.tex  @c -*- texinfo -*-
+@c %**start of header (This is for running Texinfo on a region.)
+
+@setfilename lightning.info
+
+@set TITLE       Using @sc{gnu} @i{lightning}
+@set TOPIC       installing and using
+
+@settitle @value{TITLE}
+
+@c ---------------------------------------------------------------------
+@c Common macros
+@c ---------------------------------------------------------------------
+
+@macro bulletize{a}
+@item
+\a\
+@end macro
+
+@macro rem{a}
+@r{@i{\a\}}
+@end macro
+
+@macro gnu{}
+@sc{gnu}
+@end macro
+
+@macro lightning{}
+@gnu{} @i{lightning}
+@end macro
+
+@c ---------------------------------------------------------------------
+@c Macros for Texinfo 3.1/4.0 compatibility
+@c ---------------------------------------------------------------------
+
+@c @hlink (macro), @url and @email are used instead of @uref for Texinfo 3.1
+@c compatibility
+@macro hlink{url, link}
+\link\ (\url\)
+@end macro
+
+@c ifhtml can only be true in Texinfo 4.0, which has uref
+@ifhtml
+@unmacro hlink
+
+@macro hlink{url, link}
+@uref{\url\, \link\}
+@end macro
+
+@macro email{mail}
+@uref{mailto:\mail\, , \mail\}
+@end macro
+
+@macro url{url}
+@uref{\url\}
+@end macro
+@end ifhtml
+
+@c ---------------------------------------------------------------------
+@c References to the other half of the manual
+@c ---------------------------------------------------------------------
+
+@macro usingref{node, name}
+@ref{\node\, , \name\}
+@end macro
+
+@c ---------------------------------------------------------------------
+@c End of macro section
+@c ---------------------------------------------------------------------
+
+@set UPDATED 18 June 2018
+@set UPDATED-MONTH June 2018
+@set EDITION 2.1.2
+@set VERSION 2.1.2
+
+@ifnottex
+@dircategory Software development
+@direntry
+* lightning: (lightning).       Library for dynamic code generation.
+@end direntry
+@end ifnottex
+
+@ifnottex
+@node Top
+@top @lightning{}
+
+@iftex
+@macro comma
+@verbatim{|,|}
+@end macro
+@end iftex
+
+@ifnottex
+@macro comma
+@verb{|,|}
+@end macro
+@end ifnottex
+
+This document describes @value{TOPIC} the @lightning{} library for
+dynamic code generation.
+
+@menu
+* Overview::                What GNU lightning is
+* Installation::            Configuring and installing GNU lightning
+* The instruction set::     The RISC instruction set used in GNU lightning
+* GNU lightning examples::  GNU lightning's examples
+* Reentrancy::              Re-entrant usage of GNU lightning
+* Customizations::          Advanced code generation customizations
+* Acknowledgements::        Acknowledgements for GNU lightning
+@end menu
+@end ifnottex
+
+@node Overview
+@chapter Introduction to @lightning{}
+
+@iftex
+This document describes @value{TOPIC} the @lightning{} library for
+dynamic code generation.
+@end iftex
+
+Dynamic code generation is the generation of machine code 
+at runtime. It is typically used to strip a layer of interpretation 
+by allowing compilation to occur at runtime.  One of the most
+well-known applications of dynamic code generation is perhaps that
+of interpreters that compile source code to an intermediate bytecode
+form, which is then recompiled to machine code at run-time: this
+approach effectively combines the portability of bytecode
+representations with the speed of machine code.  Another common
+application of dynamic code generation is in the field of hardware
+simulators and binary emulators, which can use the same techniques
+to translate simulated instructions to the instructions of the 
+underlying machine.
+
+Yet other applications come to mind: for example, windowing
+@dfn{bitblt} operations, matrix manipulations, and network packet
+filters.  Albeit very powerful and relatively well known within the
+compiler community, dynamic code generation techniques are rarely
+exploited to their full potential and, with the exception of the
+two applications described above, have remained curiosities because
+of their portability and functionality barriers: binary instructions
+are generated, so programs using dynamic code generation must be
+retargeted for each machine; in addition, coding a run-time code
+generator is a tedious and error-prone task more than a difficult one.
+
+@lightning{} provides a portable, fast and easily retargetable dynamic
+code generation system. 
+
+To be portable, @lightning{} abstracts over current architectures'
+quirks and unorthogonalities.  The interface that it exposes to is that
+of a standardized RISC architecture loosely based on the SPARC and MIPS
+chips.  There are a few general-purpose registers (six, not including
+those used to receive and pass parameters between subroutines), and
+arithmetic operations involve three operands---either three registers
+or two registers and an arbitrarily sized immediate value.
+
+On one hand, this architecture is general enough that it is possible to
+generate pretty efficient code even on CISC architectures such as the
+Intel x86 or the Motorola 68k families.  On the other hand, it matches
+real architectures closely enough that, most of the time, the
+compiler's constant folding pass ends up generating code which
+assembles machine instructions without further tests.
+
+@node Installation
+@chapter Configuring and installing @lightning{}
+
+The first thing to do to use @lightning{} is to configure the
+program, picking the set of macros to be used on the host
+architecture; this configuration is automatically performed by
+the @file{configure} shell script; to run it, merely type:
+@example
+     ./configure
+@end example
+
+@lightning{} supports the @code{--enable-disassembler} option, that
+enables linking to GNU binutils and optionally print human readable
+disassembly of the jit code. This option can be disabled by the
+@code{--disable-disassembler} option.
+
+Another option that @file{configure} accepts is
+@code{--enable-assertions}, which enables several consistency checks in
+the run-time assemblers.  These are not usually needed, so you can
+decide to simply forget about it; also remember that these consistency
+checks tend to slow down your code generator.
+
+After you've configured @lightning{}, run @file{make} as usual.
+
+@lightning{} has an extensive set of tests to validate it is working
+correctly in the build host. To test it run:
+@example
+    make check
+@end example
+
+The next important step is:
+@example
+    make install
+@end example
+
+This ends the process of installing @lightning{}.
+
+@node The instruction set
+@chapter @lightning{}'s instruction set
+
+@lightning{}'s instruction set was designed by deriving instructions
+that closely match those of most existing RISC architectures, or
+that can be easily syntesized if absent.  Each instruction is composed
+of:
+@itemize @bullet
+@item
+an operation, like @code{sub} or @code{mul}
+
+@item
+most times, a register/immediate flag (@code{r} or @code{i})
+
+@item
+an unsigned modifier (@code{u}), a type identifier or two, when applicable.
+@end itemize
+
+Examples of legal mnemonics are @code{addr} (integer add, with three
+register operands) and @code{muli} (integer multiply, with two
+register operands and an immediate operand).  Each instruction takes
+two or three operands; in most cases, one of them can be an immediate
+value instead of a register.
+
+Most @lightning{} integer operations are signed wordsize operations,
+with the exception of operations that convert types, or load or store
+values to/from memory. When applicable, the types and C types are as
+follow:
+
+@example
+     _c         @r{signed char}
+     _uc        @r{unsigned char}
+     _s         @r{short}
+     _us        @r{unsigned short}
+     _i         @r{int}
+     _ui        @r{unsigned int}
+     _l         @r{long}
+     _f         @r{float}
+     _d         @r{double}
+@end example
+
+Most integer operations do not need a type modifier, and when loading or
+storing values to memory there is an alias to the proper operation
+using wordsize operands, that is, if ommited, the type is @r{int} on
+32-bit architectures and @r{long} on 64-bit architectures.  Note
+that lightning also expects @code{sizeof(void*)} to match the wordsize.
+
+When an unsigned operation result differs from the equivalent signed
+operation, there is a the @code{_u} modifier.
+
+There are at least seven integer registers, of which six are
+general-purpose, while the last is used to contain the frame pointer
+(@code{FP}).  The frame pointer can be used to allocate and access local
+variables on the stack, using the @code{allocai} or @code{allocar}
+instruction.
+
+Of the general-purpose registers, at least three are guaranteed to be
+preserved across function calls (@code{V0}, @code{V1} and
+@code{V2}) and at least three are not (@code{R0}, @code{R1} and
+@code{R2}).  Six registers are not very much, but this
+restriction was forced by the need to target CISC architectures
+which, like the x86, are poor of registers; anyway, backends can
+specify the actual number of available registers with the calls
+@code{JIT_R_NUM} (for caller-save registers) and @code{JIT_V_NUM}
+(for callee-save registers).
+
+There are at least six floating-point registers, named @code{F0} to
+@code{F5}.  These are usually caller-save and are separate from the integer
+registers on the supported architectures; on Intel architectures,
+in 32 bit mode if SSE2 is not available or use of X87 is forced,
+the register stack is mapped to a flat register file.  As for the
+integer registers, the macro @code{JIT_F_NUM} yields the number of
+floating-point registers.
+
+The complete instruction set follows; as you can see, most non-memory
+operations only take integers (either signed or unsigned) as operands;
+this was done in order to reduce the instruction set, and because most
+architectures only provide word and long word operations on registers.
+There are instructions that allow operands to be extended to fit a larger
+data type, both in a signed and in an unsigned way.
+
+@table @b
+@item Binary ALU operations
+These accept three operands; the last one can be an immediate.
+@code{addx} operations must directly follow @code{addc}, and
+@code{subx} must follow @code{subc}; otherwise, results are undefined.
+Most, if not all, architectures do not support @r{float} or @r{double}
+immediate operands; lightning emulates those operations by moving the
+immediate to a temporary register and emiting the call with only
+register operands.
+@example
+addr         _f  _d  O1 = O2 + O3
+addi         _f  _d  O1 = O2 + O3
+addxr                O1 = O2 + (O3 + carry)
+addxi                O1 = O2 + (O3 + carry)
+addcr                O1 = O2 + O3, set carry
+addci                O1 = O2 + O3, set carry
+subr         _f  _d  O1 = O2 - O3
+subi         _f  _d  O1 = O2 - O3
+subxr                O1 = O2 - (O3 + carry)
+subxi                O1 = O2 - (O3 + carry)
+subcr                O1 = O2 - O3, set carry
+subci                O1 = O2 - O3, set carry
+rsbr         _f  _d  O1 = O3 - O1
+rsbi         _f  _d  O1 = O3 - O1
+mulr         _f  _d  O1 = O2 * O3
+muli         _f  _d  O1 = O2 * O3
+divr     _u  _f  _d  O1 = O2 / O3
+divi     _u  _f  _d  O1 = O2 / O3
+remr     _u          O1 = O2 % O3
+remi     _u          O1 = O2 % O3
+andr                 O1 = O2 & O3
+andi                 O1 = O2 & O3
+orr                  O1 = O2 | O3
+ori                  O1 = O2 | O3
+xorr                 O1 = O2 ^ O3
+xori                 O1 = O2 ^ O3
+lshr                 O1 = O2 << O3
+lshi                 O1 = O2 << O3
+rshr     _u          O1 = O2 >> O3@footnote{The sign bit is propagated unless using the @code{_u} modifier.}
+rshi     _u          O1 = O2 >> O3@footnote{The sign bit is propagated unless using the @code{_u} modifier.}
+@end example
+
+@item Four operand binary ALU operations
+These accept two result registers, and two operands; the last one can
+be an immediate. The first two arguments cannot be the same register.
+
+@code{qmul} stores the low word of the result in @code{O1} and the
+high word in @code{O2}. For unsigned multiplication, @code{O2} zero
+means there was no overflow. For signed multiplication, no overflow
+check is based on sign, and can be detected if @code{O2} is zero or
+minus one.
+
+@code{qdiv} stores the quotient in @code{O1} and the remainder in
+@code{O2}. It can be used as quick way to check if a division is
+exact, in which case the remainder is zero.
+
+@example
+qmulr    _u       O1 O2 = O3 * O4
+qmuli    _u       O1 O2 = O3 * O4
+qdivr    _u       O1 O2 = O3 / O4
+qdivi    _u       O1 O2 = O3 / O4
+@end example
+
+@item Unary ALU operations
+These accept two operands, both of which must be registers.
+@example
+negr         _f  _d  O1 = -O2
+comr                 O1 = ~O2
+@end example
+
+These unary ALU operations are only defined for float operands.
+@example
+absr         _f  _d  O1 = fabs(O2)
+sqrtr                O1 = sqrt(O2)
+@end example
+
+Besides requiring the @code{r} modifier, there are no unary operations
+with an immediate operand.
+
+@item Compare instructions
+These accept three operands; again, the last can be an immediate.
+The last two operands are compared, and the first operand, that must be
+an integer register, is set to either 0 or 1, according to whether the
+given condition was met or not.
+
+The conditions given below are for the standard behavior of C,
+where the ``unordered'' comparison result is mapped to false.
+
+@example
+ltr       _u  _f  _d  O1 =  (O2 <  O3)
+lti       _u  _f  _d  O1 =  (O2 <  O3)
+ler       _u  _f  _d  O1 =  (O2 <= O3)
+lei       _u  _f  _d  O1 =  (O2 <= O3)
+gtr       _u  _f  _d  O1 =  (O2 >  O3)
+gti       _u  _f  _d  O1 =  (O2 >  O3)
+ger       _u  _f  _d  O1 =  (O2 >= O3)
+gei       _u  _f  _d  O1 =  (O2 >= O3)
+eqr           _f  _d  O1 =  (O2 == O3)
+eqi           _f  _d  O1 =  (O2 == O3)
+ner           _f  _d  O1 =  (O2 != O3)
+nei           _f  _d  O1 =  (O2 != O3)
+unltr         _f  _d  O1 = !(O2 >= O3)
+unler         _f  _d  O1 = !(O2 >  O3)
+ungtr         _f  _d  O1 = !(O2 <= O3)
+unger         _f  _d  O1 = !(O2 <  O3)
+uneqr         _f  _d  O1 = !(O2 <  O3) && !(O2 >  O3)
+ltgtr         _f  _d  O1 = !(O2 >= O3) || !(O2 <= O3)
+ordr          _f  _d  O1 =  (O2 == O2) &&  (O3 == O3)
+unordr        _f  _d  O1 =  (O2 != O2) ||  (O3 != O3)
+@end example
+
+@item Transfer operations
+These accept two operands; for @code{ext} both of them must be
+registers, while @code{mov} accepts an immediate value as the second
+operand.
+
+Unlike @code{movr} and @code{movi}, the other instructions are used
+to truncate a wordsize operand to a smaller integer data type or to
+convert float data types. You can also use @code{extr} to convert an
+integer to a floating point value: the usual options are @code{extr_f}
+and @code{extr_d}.
+
+@example
+movr                                 _f  _d  O1 = O2
+movi                                 _f  _d  O1 = O2
+extr      _c  _uc  _s  _us  _i  _ui  _f  _d  O1 = O2
+truncr                               _f  _d  O1 = trunc(O2)
+@end example
+
+In 64-bit architectures it may be required to use @code{truncr_f_i},
+@code{truncr_f_l}, @code{truncr_d_i} and @code{truncr_d_l} to match
+the equivalent C code.  Only the @code{_i} modifier is available in
+32-bit architectures.
+
+@example
+truncr_f_i    = <int> O1 = <float> O2
+truncr_f_l    = <long>O1 = <float> O2
+truncr_d_i    = <int> O1 = <double>O2
+truncr_d_l    = <long>O1 = <double>O2
+@end example
+
+The float conversion operations are @emph{destination first,
+source second}, but the order of the types is reversed.  This happens
+for historical reasons.
+
+@example
+extr_f_d    = <double>O1 = <float> O2
+extr_d_f    = <float> O1 = <double>O2
+@end example
+
+@item Network extensions
+These accept two operands, both of which must be registers; these
+two instructions actually perform the same task, yet they are
+assigned to two mnemonics for the sake of convenience and
+completeness.  As usual, the first operand is the destination and
+the second is the source.
+The @code{_ul} variant is only available in 64-bit architectures.
+@example
+htonr    _us _ui _ul @r{Host-to-network (big endian) order}
+ntohr    _us _ui _ul @r{Network-to-host order }
+@end example
+
+@item Load operations
+@code{ld} accepts two operands while @code{ldx} accepts three;
+in both cases, the last can be either a register or an immediate
+value. Values are extended (with or without sign, according to
+the data type specification) to fit a whole register.
+The @code{_ui} and @code{_l} types are only available in 64-bit
+architectures.  For convenience, there is a version without a
+type modifier for integer or pointer operands that uses the
+appropriate wordsize call.
+@example
+ldr     _c  _uc  _s  _us  _i  _ui  _l  _f  _d  O1 = *O2
+ldi     _c  _uc  _s  _us  _i  _ui  _l  _f  _d  O1 = *O2
+ldxr    _c  _uc  _s  _us  _i  _ui  _l  _f  _d  O1 = *(O2+O3)
+ldxi    _c  _uc  _s  _us  _i  _ui  _l  _f  _d  O1 = *(O2+O3)
+@end example
+
+@item Store operations
+@code{st} accepts two operands while @code{stx} accepts three; in
+both cases, the first can be either a register or an immediate
+value. Values are sign-extended to fit a whole register.
+@example
+str     _c  _uc  _s  _us  _i  _ui  _l  _f  _d  *O1 = O2
+sti     _c  _uc  _s  _us  _i  _ui  _l  _f  _d  *O1 = O2
+stxr    _c  _uc  _s  _us  _i  _ui  _l  _f  _d  *(O1+O2) = O3
+stxi    _c  _uc  _s  _us  _i  _ui  _l  _f  _d  *(O1+O2) = O3
+@end example
+As for the load operations, the @code{_ui} and @code{_l} types are
+only available in 64-bit architectures, and for convenience, there
+is a version without a type modifier for integer or pointer operands
+that uses the appropriate wordsize call.
+
+@item Argument management
+These are:
+@example
+prepare     (not specified)
+va_start    (not specified)
+pushargr                                   _f  _d
+pushargi                                   _f  _d
+va_push     (not specified)
+arg         _c  _uc  _s  _us  _i  _ui  _l  _f  _d
+getarg      _c  _uc  _s  _us  _i  _ui  _l  _f  _d
+va_arg                                         _d
+putargr                                    _f  _d
+putargi                                    _f  _d
+ret         (not specified)
+retr                                       _f  _d
+reti                                       _f  _d
+va_end      (not specified)
+retval      _c  _uc  _s  _us  _i  _ui  _l  _f  _d
+epilog      (not specified)
+@end example
+As with other operations that use a type modifier, the @code{_ui} and
+@code{_l} types are only available in 64-bit architectures, but there
+are operations without a type modifier that alias to the appropriate
+integer operation with wordsize operands.
+
+@code{prepare}, @code{pusharg}, and @code{retval} are used by the caller,
+while @code{arg}, @code{getarg} and @code{ret} are used by the callee.
+A code snippet that wants to call another procedure and has to pass
+arguments must, in order: use the @code{prepare} instruction and use
+the @code{pushargr} or @code{pushargi} to push the arguments @strong{in
+left to right order}; and use @code{finish} or @code{call} (explained below)
+to perform the actual call.
+
+@code{va_start} returns a @code{C} compatible @code{va_list}. To fetch
+arguments, use @code{va_arg} for integers and @code{va_arg_d} for doubles.
+@code{va_push} is required when passing a @code{va_list} to another function,
+because not all architectures expect it as a single pointer. Known case
+is DEC Alpha, that requires it as a structure passed by value.
+
+@code{arg}, @code{getarg} and @code{putarg} are used by the callee.
+@code{arg} is different from other instruction in that it does not
+actually generate any code: instead, it is a function which returns
+a value to be passed to @code{getarg} or @code{putarg}. @footnote{``Return
+a value'' means that @lightning{} code that compile these
+instructions return a value when expanded.} You should call
+@code{arg} as soon as possible, before any function call or, more
+easily, right after the @code{prolog} instructions
+(which is treated later).
+
+@code{getarg} accepts a register argument and a value returned by
+@code{arg}, and will move that argument to the register, extending
+it (with or without sign, according to the data type specification)
+to fit a whole register.  These instructions are more intimately
+related to the usage of the @lightning{} instruction set in code
+that generates other code, so they will be treated more
+specifically in @ref{GNU lightning examples, , Generating code at
+run-time}.
+
+@code{putarg} is a mix of @code{getarg} and @code{pusharg} in that
+it accepts as first argument a register or immediate, and as
+second argument a value returned by @code{arg}. It allows changing,
+or restoring an argument to the current function, and is a
+construct required to implement tail call optimization. Note that
+arguments in registers are very cheap, but will be overwritten
+at any moment, including on some operations, for example division,
+that on several ports is implemented as a function call.
+
+Finally, the @code{retval} instruction fetches the return value of a
+called function in a register.  The @code{retval} instruction takes a
+register argument and copies the return value of the previously called
+function in that register.  A function with a return value should use
+@code{retr} or @code{reti} to put the return value in the return register
+before returning.  @xref{Fibonacci, the Fibonacci numbers}, for an example.
+
+@code{epilog} is an optional call, that marks the end of a function
+body. It is automatically generated by @lightning{} if starting a new
+function (what should be done after a @code{ret} call) or finishing
+generating jit.
+It is very important to note that the fact that @code{epilog} being
+optional may cause a common mistake. Consider this:
+@example
+fun1:
+    prolog
+    ...
+    ret
+fun2:
+    prolog
+@end example
+Because @code{epilog} is added when finding a new @code{prolog},
+this will cause the @code{fun2} label to actually be before the
+return from @code{fun1}. Because @lightning{} will actually
+understand it as:
+@example
+fun1:
+    prolog
+    ...
+    ret
+fun2:
+    epilog
+    prolog
+@end example
+
+You should observe a few rules when using these macros.  First of
+all, if calling a varargs function, you should use the @code{ellipsis}
+call to mark the position of the ellipsis in the C prototype.
+
+You should not nest calls to @code{prepare} inside a
+@code{prepare/finish} block.  Doing this will result in undefined
+behavior. Note that for functions with zero arguments you can use
+just @code{call}.
+
+@item Branch instructions
+Like @code{arg}, these also return a value which, in this case,
+is to be used to compile forward branches as explained in
+@ref{Fibonacci, , Fibonacci numbers}.  They accept two operands to be
+compared; of these, the last can be either a register or an immediate.
+They are:
+@example
+bltr      _u  _f  _d  @r{if }(O2 <  O3)@r{ goto }O1
+blti      _u  _f  _d  @r{if }(O2 <  O3)@r{ goto }O1
+bler      _u  _f  _d  @r{if }(O2 <= O3)@r{ goto }O1
+blei      _u  _f  _d  @r{if }(O2 <= O3)@r{ goto }O1
+bgtr      _u  _f  _d  @r{if }(O2 >  O3)@r{ goto }O1
+bgti      _u  _f  _d  @r{if }(O2 >  O3)@r{ goto }O1
+bger      _u  _f  _d  @r{if }(O2 >= O3)@r{ goto }O1
+bgei      _u  _f  _d  @r{if }(O2 >= O3)@r{ goto }O1
+beqr          _f  _d  @r{if }(O2 == O3)@r{ goto }O1
+beqi          _f  _d  @r{if }(O2 == O3)@r{ goto }O1
+bner          _f  _d  @r{if }(O2 != O3)@r{ goto }O1
+bnei          _f  _d  @r{if }(O2 != O3)@r{ goto }O1
+
+bunltr        _f  _d  @r{if }!(O2 >= O3)@r{ goto }O1
+bunler        _f  _d  @r{if }!(O2 >  O3)@r{ goto }O1
+bungtr        _f  _d  @r{if }!(O2 <= O3)@r{ goto }O1
+bunger        _f  _d  @r{if }!(O2 <  O3)@r{ goto }O1
+buneqr        _f  _d  @r{if }!(O2 <  O3) && !(O2 >  O3)@r{ goto }O1
+bltgtr        _f  _d  @r{if }!(O2 >= O3) || !(O2 <= O3)@r{ goto }O1
+bordr         _f  _d  @r{if } (O2 == O2) &&  (O3 == O3)@r{ goto }O1
+bunordr       _f  _d  @r{if }!(O2 != O2) ||  (O3 != O3)@r{ goto }O1
+
+bmsr                  @r{if }O2 &  O3@r{ goto }O1
+bmsi                  @r{if }O2 &  O3@r{ goto }O1
+bmcr                  @r{if }!(O2 & O3)@r{ goto }O1
+bmci                  @r{if }!(O2 & O3)@r{ goto }O1@footnote{These mnemonics mean, respectively, @dfn{branch if mask set} and @dfn{branch if mask cleared}.}
+boaddr    _u          O2 += O3@r{, goto }O1@r{ if overflow}
+boaddi    _u          O2 += O3@r{, goto }O1@r{ if overflow}
+bxaddr    _u          O2 += O3@r{, goto }O1@r{ if no overflow}
+bxaddi    _u          O2 += O3@r{, goto }O1@r{ if no overflow}
+bosubr    _u          O2 -= O3@r{, goto }O1@r{ if overflow}
+bosubi    _u          O2 -= O3@r{, goto }O1@r{ if overflow}
+bxsubr    _u          O2 -= O3@r{, goto }O1@r{ if no overflow}
+bxsubi    _u          O2 -= O3@r{, goto }O1@r{ if no overflow}
+@end example
+
+@item Jump and return operations
+These accept one argument except @code{ret} and @code{jmpi} which
+have none; the difference between @code{finishi} and @code{calli}
+is that the latter does not clean the stack from pushed parameters
+(if any) and the former must @strong{always} follow a @code{prepare}
+instruction.
+@example
+callr     (not specified)                @r{function call to register O1}
+calli     (not specified)                @r{function call to immediate O1}
+finishr   (not specified)                @r{function call to register O1}
+finishi   (not specified)                @r{function call to immediate O1}
+jmpr      (not specified)                @r{unconditional jump to register}
+jmpi      (not specified)                @r{unconditional jump}
+ret       (not specified)                @r{return from subroutine}
+retr      _c _uc _s _us _i _ui _l _f _d
+reti      _c _uc _s _us _i _ui _l _f _d
+retval    _c _uc _s _us _i _ui _l _f _d  @r{move return value}
+                                         @r{to register}
+@end example
+
+Like branch instruction, @code{jmpi} also returns a value which is to
+be used to compile forward branches. @xref{Fibonacci, , Fibonacci
+numbers}.
+
+@item Labels
+There are 3 @lightning{} instructions to create labels:
+@example
+label     (not specified)                @r{simple label}
+forward   (not specified)                @r{forward label}
+indirect  (not specified)                @r{special simple label}
+@end example
+
+@code{label} is normally used as @code{patch_at} argument for backward
+jumps.
+
+@example
+        jit_node_t *jump, *label;
+label = jit_label();
+        ...
+        jump = jit_beqr(JIT_R0, JIT_R1);
+        jit_patch_at(jump, label);
+@end example
+
+@code{forward} is used to patch code generation before the actual
+position of the label is known.
+
+@example
+        jit_node_t *jump, *label;
+label = jit_forward();
+        jump = jit_beqr(JIT_R0, JIT_R1);
+        jit_patch_at(jump, label);
+        ...
+        jit_link(label);
+@end example
+
+@code{indirect} is useful when creating jump tables, and tells
+@lightning{} to not optimize out a label that is not the target of
+any jump, because an indirect jump may land where it is defined.
+
+@example
+        jit_node_t *jump, *label;
+        ...
+        jmpr(JIT_R0);                    @rem{/* may jump to label */}
+        ...
+label = jit_indirect();
+@end example
+
+@code{indirect} is an special case of @code{note} and @code{name}
+because it is a valid argument to @code{address}.
+
+Note that the usual idiom to write the previous example is
+@example
+        jit_node_t *addr, *jump;
+addr  = jit_movi(JIT_R0, 0);             @rem{/* immediate is ignored */}
+        ...
+        jmpr(JIT_R0);
+        ...
+        jit_patch(addr);                 @rem{/* implicit label added */}
+@end example
+
+that automatically binds the implicit label added by @code{patch} with
+the @code{movi}, but on some special conditions it is required to create
+an "unbound" label.
+
+@item Function prolog
+
+These macros are used to set up a function prolog.  The @code{allocai}
+call accept a single integer argument and returns an offset value
+for stack storage access.  The @code{allocar} accepts two registers
+arguments, the first is set to the offset for stack access, and the
+second is the size in bytes argument.
+
+@example
+prolog    (not specified)                @r{function prolog}
+allocai   (not specified)                @r{reserve space on the stack}
+allocar   (not specified)                @r{allocate space on the stack}
+@end example
+
+@code{allocai} receives the number of bytes to allocate and returns
+the offset from the frame pointer register @code{FP} to the base of
+the area.
+
+@code{allocar} receives two register arguments.  The first is where
+to store the offset from the frame pointer register @code{FP} to the
+base of the area.  The second argument is the size in bytes.  Note
+that @code{allocar} is dynamic allocation, and special attention
+should be taken when using it.  If called in a loop, every iteration
+will allocate stack space.  Stack space is aligned from 8 to 64 bytes
+depending on backend requirements, even if allocating only one byte.
+It is advisable to not use it with @code{frame} and @code{tramp}; it
+should work with @code{frame} with special care to call only once,
+but is not supported if used in @code{tramp}, even if called only
+once.
+
+As a small appetizer, here is a small function that adds 1 to the input
+parameter (an @code{int}).  I'm using an assembly-like syntax here which
+is a bit different from the one used when writing real subroutines with
+@lightning{}; the real syntax will be introduced in @xref{GNU lightning
+examples, , Generating code at run-time}.
+
+@example
+incr:
+     prolog
+in = arg                     @rem{! We have an integer argument}
+     getarg    R0, in        @rem{! Move it to R0}
+     addi      R0, R0, 1     @rem{! Add 1}
+     retr      R0            @rem{! And return the result}
+@end example
+
+And here is another function which uses the @code{printf} function from
+the standard C library to write a number in hexadecimal notation:
+
+@example
+printhex:
+     prolog
+in = arg                     @rem{! Same as above}
+     getarg    R0, in
+     prepare                 @rem{! Begin call sequence for printf}
+     pushargi  "%x"          @rem{! Push format string}
+     ellipsis                @rem{! Varargs start here}
+     pushargr  R0            @rem{! Push second argument}
+     finishi   printf        @rem{! Call printf}
+     ret                     @rem{! Return to caller}
+@end example
+
+@item Trampolines, continuations and tail call optimization
+
+Frequently it is required to generate jit code that must jump to
+code generated later, possibly from another @code{jit_context_t}.
+These require compatible stack frames.
+
+@lightning{} provides two primitives from where trampolines,
+continuations and tail call optimization can be implemented.
+
+@example
+frame   (not specified)                  @r{create stack frame}
+tramp   (not specified)                  @r{assume stack frame}
+@end example
+
+@code{frame} receives an integer argument@footnote{It is not
+automatically computed because it does not know about the
+requirement of later generated code.} that defines the size in
+bytes for the stack frame of the current, @code{C} callable,
+jit function. To calculate this value, a good formula is maximum
+number of arguments to any called native function times
+eight@footnote{Times eight so that it works for double arguments.
+And would not need conditionals for ports that pass arguments in
+the stack.}, plus the sum of the arguments to any call to
+@code{jit_allocai}. @lightning{} automatically adjusts this value
+for any backend specific stack memory it may need, or any
+alignment constraint.
+
+@code{frame} also instructs @lightning{} to save all callee
+save registers in the prolog and reload in the epilog.
+
+@example
+main:                        @rem{! jit entry point}
+     prolog                  @rem{! function prolog}
+     frame  256              @rem{! save all callee save registers and}
+                             @rem{! reserve at least 256 bytes in stack}
+main_loop:
+     ...
+     jmpi   handler          @rem{! jumps to external code}
+     ...
+     ret                     @rem{! return to the caller}
+@end example
+
+@code{tramp} differs from @code{frame} only that a prolog and epilog
+will not be generated. Note that @code{prolog} must still be used.
+The code under @code{tramp} must be ready to be entered with a jump
+at the prolog position, and instead of a return, it must end with
+a non conditional jump. @code{tramp} exists solely for the fact
+that it allows optimizing out prolog and epilog code that would
+never be executed.
+
+@example
+handler:                     @rem{! handler entry point}
+     prolog                  @rem{! function prolog}
+     tramp  256              @rem{! assumes all callee save registers}
+                             @rem{! are saved and there is at least}
+                             @rem{! 256 bytes in stack}
+     ...
+     jmpi   main_loop        @rem{! return to the main loop}
+@end example
+
+@lightning{} only supports Tail Call Optimization using the
+@code{tramp} construct. Any other way is not guaranteed to
+work on all ports.
+
+An example of a simple (recursive) tail call optimization:
+
+@example
+factorial:                   @rem{! Entry point of the factorial function}
+     prolog
+in = arg                     @rem{! Receive an integer argument}
+     getarg R0, in           @rem{! Move argument to RO}
+     prepare
+         pushargi 1          @rem{! This is the accumulator}
+         pushargr R0         @rem{! This is the argument}
+     finishi fact            @rem{! Call the tail call optimized function}
+     retval R0               @rem{! Fetch the result}
+     retr R0                 @rem{! Return it}
+     epilog                  @rem{! Epilog *before* label before prolog}
+
+fact:                        @rem{! Entry point of the helper function}
+     prolog
+     frame 16                @rem{! Reserve 16 bytes in the stack}
+fact_entry:                  @rem{! This is the tail call entry point}
+ac = arg                     @rem{! The accumulator is the first argument}
+in = arg                     @rem{! The factorial argument}
+     getarg R0, ac           @rem{! Move the accumulator to R0}
+     getarg R1, in           @rem{! Move the argument to R1}
+     blei fact_out, R1, 1    @rem{! Done if argument is one or less}
+     mulr R0, R0, R1         @rem{! accumulator *= argument}
+     putargr R0, ac          @rem{! Update the accumulator}
+     subi R1, R1, 1          @rem{! argument -= 1}
+     putargr R1, in          @rem{! Update the argument}
+     jmpi fact_entry         @rem{! Tail Call Optimize it!}
+fact_out:
+     retr R0                 @rem{! Return the accumulator}
+@end example
+
+@item Predicates
+@example
+forward_p      (not specified)           @r{forward label predicate}
+indirect_p     (not specified)           @r{indirect label predicate}
+target_p       (not specified)           @r{used label predicate}
+arg_register_p (not specified)           @r{argument kind predicate}
+callee_save_p  (not specified)           @r{callee save predicate}
+pointer_p      (not specified)           @r{pointer predicate}
+@end example
+
+@code{forward_p} expects a @code{jit_node_t*} argument, and
+returns non zero if it is a forward label reference, that is,
+a label returned by @code{forward}, that still needs a
+@code{link} call.
+
+@code{indirect_p} expects a @code{jit_node_t*} argument, and returns
+non zero if it is an indirect label reference, that is, a label that
+was returned by @code{indirect}.
+
+@code{target_p} expects a @code{jit_node_t*} argument, that is any
+kind of label, and will return non zero if there is at least one
+jump or move referencing it.
+
+@code{arg_register_p} expects a @code{jit_node_t*} argument, that must
+have been returned by @code{arg}, @code{arg_f} or @code{arg_d}, and
+will return non zero if the argument lives in a register. This call
+is useful to know the live range of register arguments, as those
+are very fast to read and write, but have volatile values.
+
+@code{callee_save_p} exects a valid @code{JIT_Rn}, @code{JIT_Vn}, or
+@code{JIT_Fn}, and will return non zero if the register is callee
+save. This call is useful because on several ports, the @code{JIT_Rn}
+and @code{JIT_Fn} registers are actually callee save; no need
+to save and load the values when making function calls.
+
+@code{pointer_p} expects a pointer argument, and will return non
+zero if the pointer is inside the generated jit code. Must be
+called after @code{jit_emit} and before @code{jit_destroy_state}.
+@end table
+
+@node GNU lightning examples
+@chapter Generating code at run-time
+
+To use @lightning{}, you should include the @file{lightning.h} file that
+is put in your include directory by the @samp{make install} command.
+
+Each of the instructions above translates to a macro or function call.
+All you have to do is prepend @code{jit_} (lowercase) to opcode names
+and @code{JIT_} (uppercase) to register names.  Of course, parameters
+are to be put between parentheses.
+
+This small tutorial presents three examples:
+
+@iftex
+@itemize @bullet
+@item
+The @code{incr} function found in @ref{The instruction set, ,
+@lightning{}'s instruction set}:
+
+@item
+A simple function call to @code{printf}
+
+@item
+An RPN calculator.
+
+@item
+Fibonacci numbers
+@end itemize
+@end iftex
+@ifnottex
+@menu
+* incr::             A function which increments a number by one
+* printf::           A simple function call to printf
+* RPN calculator::   A more complex example, an RPN calculator
+* Fibonacci::        Calculating Fibonacci numbers
+@end menu
+@end ifnottex
+
+@node incr
+@section A function which increments a number by one
+
+Let's see how to create and use the sample @code{incr} function created
+in @ref{The instruction set, , @lightning{}'s instruction set}:
+
+@example
+#include <stdio.h>
+#include <lightning.h>
+
+static jit_state_t *_jit;
+
+typedef int (*pifi)(int);    @rem{/* Pointer to Int Function of Int */}
+
+int main(int argc, char *argv[])
+@{
+  jit_node_t  *in;
+  pifi         incr;
+
+  init_jit(argv[0]);
+  _jit = jit_new_state();
+
+  jit_prolog();                    @rem{/* @t{     prolog             } */}
+  in = jit_arg();                  @rem{/* @t{     in = arg           } */}
+  jit_getarg(JIT_R0, in);          @rem{/* @t{     getarg R0          } */}
+  jit_addi(JIT_R0, JIT_R0, 1);     @rem{/* @t{     addi   R0@comma{} R0@comma{} 1   } */}
+  jit_retr(JIT_R0);                @rem{/* @t{     retr   R0          } */}
+
+  incr = jit_emit();
+  jit_clear_state();
+
+  @rem{/* call the generated code@comma{} passing 5 as an argument */}
+  printf("%d + 1 = %d\n", 5, incr(5));
+
+  jit_destroy_state();
+  finish_jit();
+  return 0;
+@}
+@end example
+
+Let's examine the code line by line (well, almost@dots{}):
+
+@table @t
+@item #include <lightning.h>
+You already know about this.  It defines all of @lightning{}'s macros.
+
+@item static jit_state_t *_jit;
+You might wonder about what is @code{jit_state_t}.  It is a structure
+that stores jit code generation information.  The name @code{_jit} is
+special, because since multiple jit generators can run at the same
+time, you must either @r{#define _jit my_jit_state} or name it
+@code{_jit}.
+
+@item typedef int (*pifi)(int);
+Just a handy typedef for a pointer to a function that takes an
+@code{int} and returns another.
+
+@item jit_node_t  *in;
+Declares a variable to hold an identifier for a function argument. It
+is an opaque pointer, that will hold the return of a call to @code{arg}
+and be used as argument to @code{getarg}.
+
+@item pifi         incr;
+Declares a function pointer variable to a function that receives an
+@code{int} and returns an @code{int}.
+
+@item init_jit(argv[0]);
+You must call this function before creating a @code{jit_state_t}
+object. This function does global state initialization, and may need
+to detect CPU or Operating System features.  It receives a string
+argument that is later used to read symbols from a shared object using
+GNU binutils if disassembly was enabled at configure time. If no
+disassembly will be performed a NULL pointer can be used as argument.
+
+@item _jit = jit_new_state();
+This call initializes a @lightning{} jit state.
+
+@item jit_prolog();
+Ok, so we start generating code for our beloved function@dots{}
+
+@item in = jit_arg();
+@itemx jit_getarg(JIT_R0, in);
+We retrieve the first (and only) argument, an integer, and store it
+into the general-purpose register @code{R0}.
+
+@item jit_addi(JIT_R0, JIT_R0, 1);
+We add one to the content of the register.
+
+@item jit_retr(JIT_R0);
+This instruction generates a standard function epilog that returns
+the contents of the @code{R0} register.
+
+@item incr = jit_emit();
+This instruction is very important.  It actually translates the
+@lightning{} macros used before to machine code, flushes the generated
+code area out of the processor's instruction cache and return a
+pointer to the start of the code.
+
+@item jit_clear_state();
+This call cleanups any data not required for jit execution. Note
+that it must be called after any call to @code{jit_print} or
+@code{jit_address}, as this call destroy the @lightning{}
+intermediate representation.
+
+@item printf("%d + 1 = %d", 5, incr(5));
+Calling our function is this simple---it is not distinguishable from
+a normal C function call, the only difference being that @code{incr}
+is a variable.
+
+@item jit_destroy_state();
+Releases all memory associated with the jit context. It should be
+called after known the jit will no longer be called.
+
+@item finish_jit();
+This call cleanups any global state hold by @lightning{}, and is
+advisable to call it once jit code will no longer be generated.
+@end table
+
+@lightning{} abstracts two phases of dynamic code generation: selecting
+instructions that map the standard representation, and emitting binary
+code for these instructions.  The client program has the responsibility
+of describing the code to be generated using the standard @lightning{}
+instruction set.
+
+Let's examine the code generated for @code{incr} on the SPARC and x86_64
+architecture (on the right is the code that an assembly-language
+programmer would write):
+
+@table @b
+@item SPARC
+@example
+      save  %sp, -112, %sp
+      mov  %i0, %g2                 retl
+      inc  %g2                      inc %o0
+      mov  %g2, %i0
+      restore 
+      retl 
+      nop 
+@end example
+In this case, @lightning{} introduces overhead to create a register
+window (not knowing that the procedure is a leaf procedure) and to
+move the argument to the general purpose register @code{R0} (which
+maps to @code{%g2} on the SPARC).
+@end table
+
+@table @b
+@item x86_64
+@example
+    sub   $0x30,%rsp
+    mov   %rbp,(%rsp)
+    mov   %rsp,%rbp
+    sub   $0x18,%rsp
+    mov   %rdi,%rax            mov %rdi, %rax
+    add   $0x1,%rax            inc %rax
+    mov   %rbp,%rsp
+    mov   (%rsp),%rbp
+    add   $0x30,%rsp
+    retq                       retq
+@end example
+In this case, the main overhead is due to the function's prolog and
+epilog, and stack alignment after reserving stack space for word
+to/from float conversions or moving data from/to x87 to/from SSE.
+Note that besides allocating space to save callee saved registers,
+no registers are saved/restored because @lightning{} notices those
+registers are not modified. There is currently no logic to detect
+if it needs to allocate stack space for type conversions neither
+proper leaf function detection, but these are subject to change
+(FIXME).
+@end table
+
+@node printf
+@section A simple function call to @code{printf}
+
+Again, here is the code for the example:
+
+@example
+#include <stdio.h>
+#include <lightning.h>
+
+static jit_state_t *_jit;
+
+typedef void (*pvfi)(int);      @rem{/* Pointer to Void Function of Int */}
+
+int main(int argc, char *argv[])
+@{
+  pvfi          myFunction;             @rem{/* ptr to generated code */}
+  jit_node_t    *start, *end;           @rem{/* a couple of labels */}
+  jit_node_t    *in;                    @rem{/* to get the argument */}
+
+  init_jit(argv[0]);
+  _jit = jit_new_state();
+
+  start = jit_note(__FILE__, __LINE__);
+  jit_prolog();
+  in = jit_arg();
+  jit_getarg(JIT_R1, in);
+  jit_pushargi((jit_word_t)"generated %d bytes\n");
+  jit_ellipsis();
+  jit_pushargr(JIT_R1);
+  jit_finishi(printf);
+  jit_ret();
+  jit_epilog();
+  end = jit_note(__FILE__, __LINE__);
+
+  myFunction = jit_emit();
+
+  @rem{/* call the generated code@comma{} passing its size as argument */}
+  myFunction((char*)jit_address(end) - (char*)jit_address(start));
+  jit_clear_state();
+
+  jit_disassemble();
+
+  jit_destroy_state();
+  finish_jit();
+  return 0;
+@}
+@end example
+
+The function shows how many bytes were generated.  Most of the code
+is not very interesting, as it resembles very closely the program
+presented in @ref{incr, , A function which increments a number by one}.
+
+For this reason, we're going to concentrate on just a few statements.
+
+@table @t
+@item start = jit_note(__FILE__, __LINE__);
+@itemx @r{@dots{}}
+@itemx end = jit_note(__FILE__, __LINE__);
+These two instruction call the @code{jit_note} macro, which creates
+a note in the jit code; arguments to @code{jit_note} usually are a
+filename string and line number integer, but using NULL for the
+string argument is perfectly valid if only need to create a simple
+marker in the code.
+
+@item jit_ellipsis();
+@code{ellipsis} usually is only required if calling varargs functions
+with double arguments, but it is a good practice to properly describe
+the @r{@dots{}} in the call sequence.
+
+@item jit_pushargi((jit_word_t)"generated %d bytes\n");
+Note the use of the @code{(jit_word_t)} cast, that is used only
+to avoid a compiler warning, due to using a pointer where a
+wordsize integer type was expected.
+
+@item jit_prepare();
+@itemx @r{@dots{}}
+@itemx jit_finishi(printf);
+Once the arguments to @code{printf} have been pushed, what means
+moving them to stack or register arguments, the @code{printf}
+function is called and the stack cleaned.  Note how @lightning{}
+abstracts the differences between different architectures and
+ABI's -- the client program does not know how parameter passing
+works on the host architecture.
+
+@item jit_epilog();
+Usually it is not required to call @code{epilog}, but because it
+is implicitly called when noticing the end of a function, if the
+@code{end} variable was set with a @code{note} call after the
+@code{ret}, it would not consider the function epilog.
+
+@item myFunction((char*)jit_address(end) - (char*)jit_address(start));
+This calls the generate jit function passing as argument the offset
+difference from the @code{start} and @code{end} notes. The @code{address}
+call must be done after the @code{emit} call or either a fatal error
+will happen (if @lightning{} is built with assertions enable) or an
+undefined value will be returned.
+
+@item jit_clear_state();
+Note that @code{jit_clear_state} was called after executing jit in
+this example. It was done because it must be called after any call
+to @code{jit_address} or @code{jit_print}.
+
+@item jit_disassemble();
+@code{disassemble} will dump the generated code to standard output,
+unless @lightning{} was built with the disassembler disabled, in which
+case no output will be shown.
+@end table
+
+@node RPN calculator
+@section A more complex example, an RPN calculator
+
+We create a small stack-based RPN calculator which applies a series
+of operators to a given parameter and to other numeric operands.
+Unlike previous examples, the code generator is fully parameterized
+and is able to compile different formulas to different functions.
+Here is the code for the expression compiler; a sample usage will
+follow.
+
+Since @lightning{} does not provide push/pop instruction, this
+example uses a stack-allocated area to store the data.  Such an
+area can be allocated using the macro @code{allocai}, which
+receives the number of bytes to allocate and returns the offset
+from the frame pointer register @code{FP} to the base of the
+area.
+
+Usually, you will use the @code{ldxi} and @code{stxi} instruction
+to access stack-allocated variables.  However, it is possible to
+use operations such as @code{add} to compute the address of the
+variables, and pass the address around.
+
+@example
+#include <stdio.h>
+#include <lightning.h>
+
+typedef int (*pifi)(int);       @rem{/* Pointer to Int Function of Int */}
+
+static jit_state_t *_jit;
+
+void stack_push(int reg, int *sp)
+@{
+  jit_stxi_i (*sp, JIT_FP, reg);
+  *sp += sizeof (int);
+@}
+
+void stack_pop(int reg, int *sp)
+@{
+  *sp -= sizeof (int);
+  jit_ldxi_i (reg, JIT_FP, *sp);
+@}
+
+jit_node_t *compile_rpn(char *expr)
+@{
+  jit_node_t *in, *fn;
+  int stack_base, stack_ptr;
+
+  fn = jit_note(NULL, 0);
+  jit_prolog();
+  in = jit_arg();
+  stack_ptr = stack_base = jit_allocai (32 * sizeof (int));
+
+  jit_getarg_i(JIT_R2, in);
+
+  while (*expr) @{
+    char buf[32];
+    int n;
+    if (sscanf(expr, "%[0-9]%n", buf, &n)) @{
+      expr += n - 1;
+      stack_push(JIT_R0, &stack_ptr);
+      jit_movi(JIT_R0, atoi(buf));
+    @} else if (*expr == 'x') @{
+      stack_push(JIT_R0, &stack_ptr);
+      jit_movr(JIT_R0, JIT_R2);
+    @} else if (*expr == '+') @{
+      stack_pop(JIT_R1, &stack_ptr);
+      jit_addr(JIT_R0, JIT_R1, JIT_R0);
+    @} else if (*expr == '-') @{
+      stack_pop(JIT_R1, &stack_ptr);
+      jit_subr(JIT_R0, JIT_R1, JIT_R0);
+    @} else if (*expr == '*') @{
+      stack_pop(JIT_R1, &stack_ptr);
+      jit_mulr(JIT_R0, JIT_R1, JIT_R0);
+    @} else if (*expr == '/') @{
+      stack_pop(JIT_R1, &stack_ptr);
+      jit_divr(JIT_R0, JIT_R1, JIT_R0);
+    @} else @{
+      fprintf(stderr, "cannot compile: %s\n", expr);
+      abort();
+    @}
+    ++expr;
+  @}
+  jit_retr(JIT_R0);
+  jit_epilog();
+  return fn;
+@}
+@end example
+
+The principle on which the calculator is based is easy: the stack top
+is held in R0, while the remaining items of the stack are held in the
+memory area that we allocate with @code{allocai}.  Compiling a numeric
+operand or the argument @code{x} pushes the old stack top onto the
+stack and moves the operand into R0; compiling an operator pops the
+second operand off the stack into R1, and compiles the operation so
+that the result goes into R0, thus becoming the new stack top.
+
+This example allocates a fixed area for 32 @code{int}s.  This is not
+a problem when the function is a leaf like in this case; in a full-blown
+compiler you will want to analyze the input and determine the number
+of needed stack slots---a very simple example of register allocation.
+The area is then managed like a stack using @code{stack_push} and
+@code{stack_pop}.
+
+Source code for the client (which lies in the same source file) follows:
+
+@example
+int main(int argc, char *argv[])
+@{
+  jit_node_t *nc, *nf;
+  pifi c2f, f2c;
+  int i;
+
+  init_jit(argv[0]);
+  _jit = jit_new_state();
+
+  nc = compile_rpn("32x9*5/+");
+  nf = compile_rpn("x32-5*9/");
+  (void)jit_emit();
+  c2f = (pifi)jit_address(nc);
+  f2c = (pifi)jit_address(nf);
+  jit_clear_state();
+
+  printf("\nC:");
+  for (i = 0; i <= 100; i += 10) printf("%3d ", i);
+  printf("\nF:");
+  for (i = 0; i <= 100; i += 10) printf("%3d ", c2f(i));
+  printf("\n");
+
+  printf("\nF:");
+  for (i = 32; i <= 212; i += 18) printf("%3d ", i);
+  printf("\nC:");
+  for (i = 32; i <= 212; i += 18) printf("%3d ", f2c(i));
+  printf("\n");
+
+  jit_destroy_state();
+  finish_jit();
+  return 0;
+@}
+@end example
+
+The client displays a conversion table between Celsius and Fahrenheit
+degrees (both Celsius-to-Fahrenheit and Fahrenheit-to-Celsius). The
+formulas are, @math{F(c) = c*9/5+32} and @math{C(f) = (f-32)*5/9},
+respectively.
+
+Providing the formula as an argument to @code{compile_rpn} effectively
+parameterizes code generation, making it possible to use the same code
+to compile different functions; this is what makes dynamic code
+generation so powerful.
+
+@node Fibonacci
+@section Fibonacci numbers
+
+The code in this section calculates the Fibonacci sequence. That is
+modeled by the recurrence relation:
+@display
+     f(0) = 0
+     f(1) = f(2) = 1
+     f(n) = f(n-1) + f(n-2)
+@end display
+
+The purpose of this example is to introduce branches.  There are two
+kind of branches: backward branches and forward branches.  We'll
+present the calculation in a recursive and iterative form; the
+former only uses forward branches, while the latter uses both.
+
+@example
+#include <stdio.h>
+#include <lightning.h>
+
+static jit_state_t *_jit;
+
+typedef int (*pifi)(int);       @rem{/* Pointer to Int Function of Int */}
+
+int main(int argc, char *argv[])
+@{
+  pifi       fib;
+  jit_node_t *label;
+  jit_node_t *call;
+  jit_node_t *in;                 @rem{/* offset of the argument */}
+  jit_node_t *ref;                @rem{/* to patch the forward reference */}
+  jit_node_t *zero;               @rem{/* to patch the forward reference */}
+
+  init_jit(argv[0]);
+  _jit = jit_new_state();
+
+  label = jit_label();
+        jit_prolog   ();
+  in =  jit_arg      ();
+        jit_getarg   (JIT_V0, in);              @rem{/* R0 = n */}
+ zero = jit_beqi     (JIT_R0, 0);
+        jit_movr     (JIT_V0, JIT_R0);          /* V0 = R0 */
+        jit_movi     (JIT_R0, 1);
+  ref = jit_blei     (JIT_V0, 2);
+        jit_subi     (JIT_V1, JIT_V0, 1);       @rem{/* V1 = n-1 */}
+        jit_subi     (JIT_V2, JIT_V0, 2);       @rem{/* V2 = n-2 */}
+        jit_prepare();
+          jit_pushargr(JIT_V1);
+        call = jit_finishi(NULL);
+        jit_patch_at(call, label);
+        jit_retval(JIT_V1);                     @rem{/* V1 = fib(n-1) */}
+        jit_prepare();
+          jit_pushargr(JIT_V2);
+        call = jit_finishi(NULL);
+        jit_patch_at(call, label);
+        jit_retval(JIT_R0);                     @rem{/* R0 = fib(n-2) */}
+        jit_addr(JIT_R0, JIT_R0, JIT_V1);       @rem{/* R0 = R0 + V1 */}
+
+  jit_patch(ref);                               @rem{/* patch jump */}
+  jit_patch(zero);                              @rem{/* patch jump */}
+        jit_retr(JIT_R0);
+
+  @rem{/* call the generated code@comma{} passing 32 as an argument */}
+  fib = jit_emit();
+  jit_clear_state();
+  printf("fib(%d) = %d\n", 32, fib(32));
+  jit_destroy_state();
+  finish_jit();
+  return 0;
+@}
+@end example
+
+As said above, this is the first example of dynamically compiling
+branches.  Branch instructions have two operands containing the
+values to be compared, and return a @code{jit_note_t *} object
+to be patched.
+
+Because labels final address are only known after calling @code{emit},
+it is required to call @code{patch} or @code{patch_at}, what does
+tell @lightning{} that the target to patch is actually a pointer to
+a @code{jit_node_t *} object, otherwise, it would assume that is
+a pointer to a C function. Note that conditional branches do not
+receive a label argument, so they must be patched.
+
+You need to call @code{patch_at} on the return of value @code{calli},
+@code{finishi}, and @code{calli} if it is actually referencing a label
+in the jit code. All branch instructions do not receive a label
+argument. Note that @code{movi} is an special case, and patching it
+is usually done to get the final address of a label, usually to later
+call @code{jmpr}.
+
+Now, here is the iterative version:
+
+@example
+#include <stdio.h>
+#include <lightning.h>
+
+static jit_state_t *_jit;
+
+typedef int (*pifi)(int);       @rem{/* Pointer to Int Function of Int */}
+
+int main(int argc, char *argv[])
+@{
+  pifi       fib;
+  jit_node_t *in;               @rem{/* offset of the argument */}
+  jit_node_t *ref;              @rem{/* to patch the forward reference */}
+  jit_node_t *zero;             @rem{/* to patch the forward reference */}
+  jit_node_t *jump;             @rem{/* jump to start of loop */}
+  jit_node_t *loop;             @rem{/* start of the loop */}
+
+  init_jit(argv[0]);
+  _jit = jit_new_state();
+
+        jit_prolog   ();
+  in =  jit_arg      ();
+        jit_getarg   (JIT_R0, in);              @rem{/* R0 = n */}
+ zero = jit_beqi     (JIT_R0, 0);
+        jit_movr     (JIT_R1, JIT_R0);
+        jit_movi     (JIT_R0, 1);
+  ref = jit_blti     (JIT_R1, 2);
+        jit_subi     (JIT_R2, JIT_R2, 2);
+        jit_movr     (JIT_R1, JIT_R0);
+
+  loop= jit_label();
+        jit_subi     (JIT_R2, JIT_R2, 1);       @rem{/* decr. counter */}
+        jit_movr     (JIT_V0, JIT_R0);          /* V0 = R0 */
+        jit_addr     (JIT_R0, JIT_R0, JIT_R1);  /* R0 = R0 + R1 */
+        jit_movr     (JIT_R1, JIT_V0);          /* R1 = V0 */
+  jump= jit_bnei     (JIT_R2, 0);               /* if (R2) goto loop; */
+  jit_patch_at(jump, loop);
+
+  jit_patch(ref);                               @rem{/* patch forward jump */}
+  jit_patch(zero);                              @rem{/* patch forward jump */}
+        jit_retr     (JIT_R0);
+
+  @rem{/* call the generated code@comma{} passing 36 as an argument */}
+  fib = jit_emit();
+  jit_clear_state();
+  printf("fib(%d) = %d\n", 36, fib(36));
+  jit_destroy_state();
+  finish_jit();
+  return 0;
+@}
+@end example
+
+This code calculates the recurrence relation using iteration (a
+@code{for} loop in high-level languages).  There are no function
+calls anymore: instead, there is a backward jump (the @code{bnei} at
+the end of the loop).
+
+Note that the program must remember the address for backward jumps;
+for forward jumps it is only required to remember the jump code,
+and call @code{patch} for the implicit label.
+
+@node Reentrancy
+@chapter Re-entrant usage of @lightning{}
+
+@lightning{} uses the special @code{_jit} identifier. To be able
+to be able to use multiple jit generation states at the same
+time, it is required to used code similar to:
+
+@example
+    struct jit_state lightning;
+    #define lightning _jit
+@end example
+
+This will cause the symbol defined to @code{_jit} to be passed as
+the first argument to the underlying @lightning{} implementation,
+that is usually a function with an @code{_} (underscode) prefix
+and with an argument named @code{_jit}, in the pattern:
+
+@example
+    static void _jit_mnemonic(jit_state_t *, jit_gpr_t, jit_gpr_t);
+    #define jit_mnemonic(u, v) _jit_mnemonic(_jit, u, v);
+@end example
+
+The reason for this is to use the same syntax as the initial lightning
+implementation and to avoid needing the user to keep adding an extra
+argument to every call, as multiple jit states generating code in
+paralell should be very uncommon.
+
+@section Registers
+@chapter Accessing the whole register file
+
+As mentioned earlier in this chapter, all @lightning{} back-ends are
+guaranteed to have at least six general-purpose integer registers and
+six floating-point registers, but many back-ends will have more.
+
+To access the entire register files, you can use the
+@code{JIT_R}, @code{JIT_V} and @code{JIT_F} macros.  They
+accept a parameter that identifies the register number, which
+must be strictly less than @code{JIT_R_NUM}, @code{JIT_V_NUM}
+and @code{JIT_F_NUM} respectively; the number need not be
+constant.  Of course, expressions like @code{JIT_R0} and
+@code{JIT_R(0)} denote the same register, and likewise for
+integer callee-saved, or floating-point, registers.
+
+@node Customizations
+@chapter Customizations
+
+Frequently it is desirable to have more control over how code is
+generated or how memory is used during jit generation or execution.
+
+@section Memory functions
+To aid in complete control of memory allocation and deallocation
+@lightning{} provides wrappers that default to standard @code{malloc},
+@code{realloc} and @code{free}. These are loosely based on the
+GNU GMP counterparts, with the difference that they use the same
+prototype of the system allocation functions, that is, no @code{size}
+for @code{free} or @code{old_size} for @code{realloc}.
+
+@deftypefun void jit_set_memory_functions (@* void *(*@var{alloc_func_ptr}) (size_t), @* void *(*@var{realloc_func_ptr}) (void *, size_t), @* void (*@var{free_func_ptr}) (void *))
+@lightning{} guarantees that memory is only allocated or released
+using these wrapped functions, but you must note that if lightning
+was linked to GNU binutils, malloc is probably will be called multiple
+times from there when initializing the disassembler.
+
+Because @code{init_jit} may call memory functions, if you need to call
+@code{jit_set_memory_functions}, it must be called before @code{init_jit},
+otherwise, when calling @code{finish_jit}, a pointer allocated with the
+previous or default wrappers will be passed.
+@end deftypefun
+
+@deftypefun void jit_get_memory_functions (@* void *(**@var{alloc_func_ptr}) (size_t), @* void *(**@var{realloc_func_ptr}) (void *, size_t), @* void (**@var{free_func_ptr}) (void *))
+Get the current memory allocation function. Also, unlike the GNU GMP
+counterpart, it is an error to pass @code{NULL} pointers as arguments.
+@end deftypefun
+
+@section Alternate code buffer
+To instruct @lightning{} to use an alternate code buffer it is required
+to call @code{jit_realize} before @code{jit_emit}, and then query states
+and customize as appropriate.
+
+@deftypefun void jit_realize ()
+Must be called once, before @code{jit_emit}, to instruct @lightning{}
+that no other @code{jit_xyz} call will be made.
+@end deftypefun
+
+@deftypefun jit_pointer_t jit_get_code (jit_word_t *@var{code_size})
+Returns NULL or the previous value set with @code{jit_set_code}, and
+sets the @var{code_size} argument to an appropriate value.
+If @code{jit_get_code} is called before @code{jit_emit}, the
+@var{code_size} argument is set to the expected amount of bytes
+required to generate code.
+If @code{jit_get_code} is called after @code{jit_emit}, the
+@var{code_size} argument is set to the exact amount of bytes used
+by the code.
+@end deftypefun
+
+@deftypefun void jit_set_code (jit_ponter_t @var{code}, jit_word_t @var{size})
+Instructs @lightning{} to output to the @var{code} argument and
+use @var{size} as a guard to not write to invalid memory. If during
+@code{jit_emit} @lightning{} finds out that the code would not fit
+in @var{size} bytes, it halts code emit and returns @code{NULL}.
+@end deftypefun
+
+A simple example of a loop using an alternate buffer is:
+
+@example
+  jit_uint8_t   *code;
+  int           *(func)(int);      @rem{/* function pointer */}
+  jit_word_t     code_size;
+  jit_word_t     real_code_size;
+  @rem{...}
+  jit_realize();                   @rem{/* ready to generate code */}
+  jit_get_code(&code_size);        @rem{/* get expected code size */}
+  code_size = (code_size + 4095) & -4096;
+  do (;;) @{
+    code = mmap(NULL, code_size, PROT_EXEC | PROT_READ | PROT_WRITE,
+                MAP_PRIVATE | MAP_ANON, -1, 0);
+    jit_set_code(code, code_size);
+    if ((func = jit_emit()) == NULL) @{
+      munmap(code, code_size);
+      code_size += 4096;
+    @}
+  @} while (func == NULL);
+  jit_get_code(&real_code_size);   @rem{/* query exact size of the code */}
+@end example
+
+The first call to @code{jit_get_code} should return @code{NULL} and set
+the @code{code_size} argument to the expected amount of bytes required
+to emit code.
+The second call to @code{jit_get_code} is after a successful call to
+@code{jit_emit}, and will return the value previously set with
+@code{jit_set_code} and set the @code{real_code_size} argument to the
+exact amount of bytes used to emit the code.
+
+@section Alternate data buffer
+Sometimes it may be desirable to customize how, or to prevent
+@lightning{} from using an extra buffer for constants or debug
+annotation. Usually when also using an alternate code buffer.
+
+@deftypefun jit_pointer_t jit_get_data (jit_word_t *@var{data_size}, jit_word_t *@var{note_size})
+Returns @code{NULL} or the previous value set with @code{jit_set_data},
+and sets the @var{data_size} argument to how many bytes are required
+for the constants data buffer, and @var{note_size} to how many bytes
+are required to store the debug note information.
+Note that it always preallocate one debug note entry even if
+@code{jit_name} or @code{jit_note} are never called, but will return
+zero in the @var{data_size} argument if no constant is required;
+constants are only used for the @code{float} and @code{double} operations
+that have an immediate argument, and not in all @lightning{} ports.
+@end deftypefun
+
+@deftypefun void jit_set_data (jit_pointer_t @var{data}, jit_word_t @var{size}, jit_word_t @var{flags})
+
+@var{data} can be NULL if disabling constants and annotations, otherwise,
+a valid pointer must be passed. An assertion is done that the data will
+fit in @var{size} bytes (but that is a noop if @lightning{} was built
+with @code{-DNDEBUG}).
+
+@var{size} tells the space in bytes available in @var{data}.
+
+@var{flags} can be zero to tell to just use the alternate data buffer,
+or a composition of @code{JIT_DISABLE_DATA} and @code{JIT_DISABLE_NOTE}
+
+@table @t
+@item JIT_DISABLE_DATA
+@cindex JIT_DISABLE_DATA
+Instructs @lightning{} to not use a constant table, but to use an
+alternate method to synthesize those, usually with a larger code
+sequence using stack space to transfer the value from a GPR to a
+FPR register.
+
+@item JIT_DISABLE_NOTE
+@cindex JIT_DISABLE_NOTE
+Instructs @lightning{} to not store file or function name, and
+line numbers in the constant buffer.
+@end table
+@end deftypefun
+
+A simple example of a preventing usage of a data buffer is:
+
+@example
+  @rem{...}
+  jit_realize();                        @rem{/* ready to generate code */}
+  jit_get_data(NULL, NULL);
+  jit_set_data(NULL, 0, JIT_DISABLE_DATA | JIT_DISABLE_NOTE);
+  @rem{...}
+@end example
+
+Or to only use a data buffer, if required:
+
+@example
+  jit_uint8_t   *data;
+  jit_word_t     data_size;
+  @rem{...}
+  jit_realize();                        @rem{/* ready to generate code */}
+  jit_get_data(&data_size, NULL);
+  if (data_size)
+    data = malloc(data_size);
+  else
+    data = NULL;
+  jit_set_data(data, data_size, JIT_DISABLE_NOTE);
+  @rem{...}
+  if (data)
+    free(data);
+  @rem{...}
+@end example
+
+@node Acknowledgements
+@chapter Acknowledgements
+
+As far as I know, the first general-purpose portable dynamic code
+generator is @sc{dcg}, by Dawson R.@: Engler and T.@: A.@: Proebsting.
+Further work by Dawson R. Engler resulted in the @sc{vcode} system;
+unlike @sc{dcg}, @sc{vcode} used no intermediate representation and
+directly inspired @lightning{}.
+
+Thanks go to Ian Piumarta, who kindly accepted to release his own
+program @sc{ccg} under the GNU General Public License, thereby allowing
+@lightning{} to use the run-time assemblers he had wrote for @sc{ccg}.
+@sc{ccg} provides a way of dynamically assemble programs written in the
+underlying architecture's assembly language.  So it is not portable,
+yet very interesting.
+
+I also thank Steve Byrne for writing GNU Smalltalk, since @lightning{}
+was first developed as a tool to be used in GNU Smalltalk's dynamic
+translator from bytecodes to native code.
+
+@c %**end of header (This is for running Texinfo on a region.)
+
+@c ***********************************************************************
+
+@bye
diff --git a/libguile/lightening/tests/Makefile b/libguile/lightening/tests/Makefile
new file mode 100644
index 000000000..81279720d
--- /dev/null
+++ b/libguile/lightening/tests/Makefile
@@ -0,0 +1,62 @@
+TESTS=$(sort $(basename $(wildcard *.c)))
+TARGETS=native ia32 aarch64 armv7
+
+# Suitable values of cross-compiler variables for Debian:
+#
+#   make test CC_IA32=i668-linux-gnu-gcc CC_AARCH64=aarch64-linux-gnu-gcc
+#
+# The relevant packages that you need to run this:
+#
+#   dpkg --add-architecture i386
+#   dpkg --add-architecture arm64
+#   apt-get update -qq
+#   apt-get install -y \
+#     libc6-dev:amd64 gcc make \
+#     qemu binfmt-support qemu-user-static \
+#     gcc-i686-linux-gnu libc6-dev-i386-cross libc6:i386 \
+#     gcc-aarch64-linux-gnu libc6-dev-arm64-cross libc6:arm64
+#
+CC = gcc
+CC_IA32=guix environment --pure -s i686-linux --ad-hoc gcc-toolchain glibc -- gcc
+CC_AARCH64=guix environment --pure -s aarch64-linux --ad-hoc gcc-toolchain glibc -- gcc
+CC_ARMv7=guix environment --pure -s armhf-linux --ad-hoc gcc-toolchain glibc -- gcc
+CFLAGS = -Wall -O0 -g
+
+all: $(foreach TARGET,$(TARGETS),$(addprefix test-$(TARGET)-,$(TESTS)))
+
+check: $(addprefix test-$(TARGET),$(TARGETS))
+
+test-%: $(addprefix test-%-,$(TESTS))
+	@echo "Running unit tests..."
+	@set -e; for test in $?; do \
+	  echo "Testing: $$test"; \
+	  ./$$test; \
+	done
+	@echo "Success."
+
+.PHONY: test check
+
+lightening-%.o: ../lightening.h ../lightening/*.c
+	$(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o $@ -c ../lightening/lightening.c
+
+test-native-%: %.c lightening-native.o test.h
+	$(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o $@ lightening-native.o $<
+
+test-ia32-%: CC = $(CC_IA32)
+test-ia32-%: %.c lightening-ia32.o test.h
+	$(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o $@ lightening-ia32.o $<
+
+test-aarch64-%: CC = $(CC_AARCH64)
+test-aarch64-%: %.c lightening-aarch64.o test.h
+	$(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o $@ lightening-aarch64.o $<
+
+test-armv7-%: CC = $(CC_ARMv7)
+test-armv7-%: %.c lightening-armv7.o test.h
+	$(CC) $(CFLAGS) $(CPPFLAGS) -I.. -o $@ lightening-armv7.o $<
+
+.PRECIOUS: $(foreach TARGET,$(TARGETS),$(addprefix test-$(TARGET)-,$(TESTS)))
+.PRECIOUS: $(foreach TARGET,$(TARGETS),lightening-$(TARGET).o)
+
+clean:
+	rm -f $(foreach TARGET,$(TARGETS),$(addprefix test-$(TARGET)-,$(TESTS)))
+	rm -f $(foreach TARGET,$(TARGETS),lightening-$(TARGET).o)
diff --git a/libguile/lightening/tests/absr_d.c b/libguile/lightening/tests/absr_d.c
new file mode 100644
index 000000000..00b8fa460
--- /dev/null
+++ b/libguile/lightening/tests/absr_d.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_absr_d(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0.0);
+  ASSERT(f(-0.0) == 0.0);
+  ASSERT(f(0.5) == 0.5);
+  ASSERT(f(-0.5) == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/absr_f.c b/libguile/lightening/tests/absr_f.c
new file mode 100644
index 000000000..e019b5ff3
--- /dev/null
+++ b/libguile/lightening/tests/absr_f.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_absr_f(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0.0);
+  ASSERT(f(-0.0) == 0.0);
+  ASSERT(f(0.5) == 0.5);
+  ASSERT(f(-0.5) == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/addi.c b/libguile/lightening/tests/addi.c
new file mode 100644
index 000000000..756d07061
--- /dev/null
+++ b/libguile/lightening/tests/addi.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_addi(j, JIT_R0, JIT_R0, 69);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  int (*f)(int) = ret;
+  ASSERT(f(42) == 111);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/addr.c b/libguile/lightening/tests/addr.c
new file mode 100644
index 000000000..6ee76e291
--- /dev/null
+++ b/libguile/lightening/tests/addr.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_addr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  int (*f)(int, int) = ret;
+  ASSERT(f(42, 69) == 111);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/addr_d.c b/libguile/lightening/tests/addr_d.c
new file mode 100644
index 000000000..11216202e
--- /dev/null
+++ b/libguile/lightening/tests/addr_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_addr_d(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  double (*f)(double, double) = ret;
+  ASSERT(f(42., 69.) == 111.);
+  ASSERT(f(42.5, 69.5) == 112.);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/addr_f.c b/libguile/lightening/tests/addr_f.c
new file mode 100644
index 000000000..4317dfe3a
--- /dev/null
+++ b/libguile/lightening/tests/addr_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_addr_f(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  float (*f)(float, float) = ret;
+  ASSERT(f(42.f, 69.f) == 111.f);
+  ASSERT(f(42.5f, 69.5f) == 112.f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/addx.c b/libguile/lightening/tests/addx.c
new file mode 100644
index 000000000..417cd1a26
--- /dev/null
+++ b/libguile/lightening/tests/addx.c
@@ -0,0 +1,63 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_movi(j, JIT_R2, 0);
+  jit_addcr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_addxi(j, JIT_R2, JIT_R2, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R2);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0, 0) == 0);
+
+#if __WORDSIZE == 32
+  /* carry */
+  ASSERT(f(0xffffffff, 0xffffffff) == 1);
+  /* overflow */
+  ASSERT(f(0x7fffffff, 1) == 0);
+  /* overflow */
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  /* carry */
+  ASSERT(f(0x7fffffff, 0x80000000) == 0);
+  /* carry+overflow */
+  ASSERT(f(0x80000000, 0x80000000) == 1);
+#else
+  /* nothing */
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  /* nothing */
+  ASSERT(f(0x7fffffff, 1) == 0);
+  /* nothing */
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  /* nothing */
+  ASSERT(f(0x7fffffff, 0x80000000) == 0);
+  /* nothing */
+  ASSERT(f(0x80000000, 0x80000000) == 0);
+  /* carry */
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 1);
+  /* overflow */
+  ASSERT(f(0x7fffffffffffffff, 1) == 0);
+  /* overflow */
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == 0);
+  /* overflow */
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0);
+  /* carry+overflow */
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == 1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/andi.c b/libguile/lightening/tests/andi.c
new file mode 100644
index 000000000..c6f39d7aa
--- /dev/null
+++ b/libguile/lightening/tests/andi.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_andi(j, JIT_R0, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff) == 1);
+  ASSERT(f(0x80000000) == 0);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff) == 1);
+  ASSERT(f(0x8000000000000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/andr.c b/libguile/lightening/tests/andr.c
new file mode 100644
index 000000000..1114ef98f
--- /dev/null
+++ b/libguile/lightening/tests/andr.c
@@ -0,0 +1,48 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_andr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 1);
+  ASSERT(f(1, 0x7fffffff) == 1);
+  ASSERT(f(0x80000000, 1) == 0);
+  ASSERT(f(1, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x7fffffff);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0x7fffffff);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0) == 0);
+  ASSERT(f(0, 0x7fffffff) == 0);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff, 1) == 1);
+  ASSERT(f(1, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0x8000000000000000, 1) == 0);
+  ASSERT(f(1, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0xffffffffffffffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/beqi.c b/libguile/lightening/tests/beqi.c
new file mode 100644
index 000000000..2fb2454c0
--- /dev/null
+++ b/libguile/lightening/tests/beqi.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_beqi(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/beqr.c b/libguile/lightening/tests/beqr.c
new file mode 100644
index 000000000..d1d80b266
--- /dev/null
+++ b/libguile/lightening/tests/beqr.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_beqr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/beqr_d.c b/libguile/lightening/tests/beqr_d.c
new file mode 100644
index 000000000..a84b6a76a
--- /dev/null
+++ b/libguile/lightening/tests/beqr_d.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_beqr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/beqr_f.c b/libguile/lightening/tests/beqr_f.c
new file mode 100644
index 000000000..7b5cc2708
--- /dev/null
+++ b/libguile/lightening/tests/beqr_f.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_beqr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgei.c b/libguile/lightening/tests/bgei.c
new file mode 100644
index 000000000..b9a830b5d
--- /dev/null
+++ b/libguile/lightening/tests/bgei.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bgei(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgei_u.c b/libguile/lightening/tests/bgei_u.c
new file mode 100644
index 000000000..894c275e1
--- /dev/null
+++ b/libguile/lightening/tests/bgei_u.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bgei_u(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bger.c b/libguile/lightening/tests/bger.c
new file mode 100644
index 000000000..daab88c39
--- /dev/null
+++ b/libguile/lightening/tests/bger.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bger(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bger_d.c b/libguile/lightening/tests/bger_d.c
new file mode 100644
index 000000000..712b118ea
--- /dev/null
+++ b/libguile/lightening/tests/bger_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bger_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bger_f.c b/libguile/lightening/tests/bger_f.c
new file mode 100644
index 000000000..b9d547861
--- /dev/null
+++ b/libguile/lightening/tests/bger_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bger_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bger_u.c b/libguile/lightening/tests/bger_u.c
new file mode 100644
index 000000000..5c07f442d
--- /dev/null
+++ b/libguile/lightening/tests/bger_u.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bger_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgti.c b/libguile/lightening/tests/bgti.c
new file mode 100644
index 000000000..4bfd36e1f
--- /dev/null
+++ b/libguile/lightening/tests/bgti.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bgti(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgti_u.c b/libguile/lightening/tests/bgti_u.c
new file mode 100644
index 000000000..b4da14e01
--- /dev/null
+++ b/libguile/lightening/tests/bgti_u.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bgti_u(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgtr.c b/libguile/lightening/tests/bgtr.c
new file mode 100644
index 000000000..dbf5fdd50
--- /dev/null
+++ b/libguile/lightening/tests/bgtr.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bgtr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgtr_d.c b/libguile/lightening/tests/bgtr_d.c
new file mode 100644
index 000000000..d3c24362a
--- /dev/null
+++ b/libguile/lightening/tests/bgtr_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bgtr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgtr_f.c b/libguile/lightening/tests/bgtr_f.c
new file mode 100644
index 000000000..91cb8c046
--- /dev/null
+++ b/libguile/lightening/tests/bgtr_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bgtr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bgtr_u.c b/libguile/lightening/tests/bgtr_u.c
new file mode 100644
index 000000000..2ed4d8eda
--- /dev/null
+++ b/libguile/lightening/tests/bgtr_u.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bgtr_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/blei.c b/libguile/lightening/tests/blei.c
new file mode 100644
index 000000000..cb9eacb9c
--- /dev/null
+++ b/libguile/lightening/tests/blei.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_blei(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/blei_u.c b/libguile/lightening/tests/blei_u.c
new file mode 100644
index 000000000..efe0523c5
--- /dev/null
+++ b/libguile/lightening/tests/blei_u.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_blei_u(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bler.c b/libguile/lightening/tests/bler.c
new file mode 100644
index 000000000..57371fb18
--- /dev/null
+++ b/libguile/lightening/tests/bler.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bler(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bler_d.c b/libguile/lightening/tests/bler_d.c
new file mode 100644
index 000000000..507dac506
--- /dev/null
+++ b/libguile/lightening/tests/bler_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bler_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bler_f.c b/libguile/lightening/tests/bler_f.c
new file mode 100644
index 000000000..191b6492c
--- /dev/null
+++ b/libguile/lightening/tests/bler_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bler_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bler_u.c b/libguile/lightening/tests/bler_u.c
new file mode 100644
index 000000000..4269fee10
--- /dev/null
+++ b/libguile/lightening/tests/bler_u.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bler_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltgtr_d.c b/libguile/lightening/tests/bltgtr_d.c
new file mode 100644
index 000000000..3d8835dbd
--- /dev/null
+++ b/libguile/lightening/tests/bltgtr_d.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bltgtr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltgtr_f.c b/libguile/lightening/tests/bltgtr_f.c
new file mode 100644
index 000000000..fbdbc3b30
--- /dev/null
+++ b/libguile/lightening/tests/bltgtr_f.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bltgtr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/blti.c b/libguile/lightening/tests/blti.c
new file mode 100644
index 000000000..fcdeb15b4
--- /dev/null
+++ b/libguile/lightening/tests/blti.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_blti(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/blti_u.c b/libguile/lightening/tests/blti_u.c
new file mode 100644
index 000000000..e90f1938e
--- /dev/null
+++ b/libguile/lightening/tests/blti_u.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_blti_u(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltr.c b/libguile/lightening/tests/bltr.c
new file mode 100644
index 000000000..901f6c4b4
--- /dev/null
+++ b/libguile/lightening/tests/bltr.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bltr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltr_d.c b/libguile/lightening/tests/bltr_d.c
new file mode 100644
index 000000000..2d6260931
--- /dev/null
+++ b/libguile/lightening/tests/bltr_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bltr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltr_f.c b/libguile/lightening/tests/bltr_f.c
new file mode 100644
index 000000000..eebd3da0c
--- /dev/null
+++ b/libguile/lightening/tests/bltr_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bltr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bltr_u.c b/libguile/lightening/tests/bltr_u.c
new file mode 100644
index 000000000..9df16fc1d
--- /dev/null
+++ b/libguile/lightening/tests/bltr_u.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bltr_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bmci.c b/libguile/lightening/tests/bmci.c
new file mode 100644
index 000000000..608d6667b
--- /dev/null
+++ b/libguile/lightening/tests/bmci.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bmci(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 0);
+  ASSERT(f(-1) == 0);
+  ASSERT(f(2) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bmcr.c b/libguile/lightening/tests/bmcr.c
new file mode 100644
index 000000000..df7e04641
--- /dev/null
+++ b/libguile/lightening/tests/bmcr.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bmcr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 0);
+  ASSERT(f(1, -1) == 0);
+  ASSERT(f(-1, 1) == 0);
+  ASSERT(f(-1, -1) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bmsi.c b/libguile/lightening/tests/bmsi.c
new file mode 100644
index 000000000..82c2ba7ea
--- /dev/null
+++ b/libguile/lightening/tests/bmsi.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bmsi(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 1);
+  ASSERT(f(2) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bmsr.c b/libguile/lightening/tests/bmsr.c
new file mode 100644
index 000000000..8caa7e0e7
--- /dev/null
+++ b/libguile/lightening/tests/bmsr.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bmsr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+  ASSERT(f(1, -1) == 1);
+  ASSERT(f(-1, 1) == 1);
+  ASSERT(f(-1, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bnei.c b/libguile/lightening/tests/bnei.c
new file mode 100644
index 000000000..73e38a7db
--- /dev/null
+++ b/libguile/lightening/tests/bnei.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bnei(j, JIT_R0, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(-1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bner.c b/libguile/lightening/tests/bner.c
new file mode 100644
index 000000000..e6515865e
--- /dev/null
+++ b/libguile/lightening/tests/bner.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bner(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bner_d.c b/libguile/lightening/tests/bner_d.c
new file mode 100644
index 000000000..079fda466
--- /dev/null
+++ b/libguile/lightening/tests/bner_d.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bner_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bner_f.c b/libguile/lightening/tests/bner_f.c
new file mode 100644
index 000000000..011df67b2
--- /dev/null
+++ b/libguile/lightening/tests/bner_f.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bner_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/boaddi.c b/libguile/lightening/tests/boaddi.c
new file mode 100644
index 000000000..1e47297c4
--- /dev/null
+++ b/libguile/lightening/tests/boaddi.c
@@ -0,0 +1,41 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_boaddi(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == 0);
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == overflowed);
+  ASSERT(f(0x80000000) == 0x80000001);
+  ASSERT(f(0xffffffff) == 0);
+#else
+  ASSERT(f(0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/boaddi_u.c b/libguile/lightening/tests/boaddi_u.c
new file mode 100644
index 000000000..21c71dfb9
--- /dev/null
+++ b/libguile/lightening/tests/boaddi_u.c
@@ -0,0 +1,41 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_boaddi_u(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == overflowed);
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == 0x80000000);
+  ASSERT(f(0x80000000) == 0x80000001);
+  ASSERT(f(0xffffffff) == overflowed);
+#else
+  ASSERT(f(0x7fffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/boaddr.c b/libguile/lightening/tests/boaddr.c
new file mode 100644
index 000000000..8bab91ef1
--- /dev/null
+++ b/libguile/lightening/tests/boaddr.c
@@ -0,0 +1,51 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_boaddr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == -2);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == overflowed);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0x80000000) == -1);
+  ASSERT(f(0x80000000, 0x80000000) == overflowed);
+#else
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffffull + 0xffffffffull);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffull + 0x7fffffffull);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == 0x100000000);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == -2);
+  ASSERT(f(0x7fffffffffffffff, 1) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == -1);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/boaddr_u.c b/libguile/lightening/tests/boaddr_u.c
new file mode 100644
index 000000000..f4bacde65
--- /dev/null
+++ b/libguile/lightening/tests/boaddr_u.c
@@ -0,0 +1,51 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_boaddr_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffu + 0x7fffffffu);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == overflowed);
+#else
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffffull + 0xffffffffull);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffull + 0x7fffffffull);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == 0x100000000);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x8000000000000000);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == -2);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == -1);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bordr_d.c b/libguile/lightening/tests/bordr_d.c
new file mode 100644
index 000000000..9227f2223
--- /dev/null
+++ b/libguile/lightening/tests/bordr_d.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bordr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bordr_f.c b/libguile/lightening/tests/bordr_f.c
new file mode 100644
index 000000000..25808e51f
--- /dev/null
+++ b/libguile/lightening/tests/bordr_f.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bordr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 1);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 0);
+  ASSERT(f(0.0/0.0, 0) == 0);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bosubi.c b/libguile/lightening/tests/bosubi.c
new file mode 100644
index 000000000..f10d90a75
--- /dev/null
+++ b/libguile/lightening/tests/bosubi.c
@@ -0,0 +1,41 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bosubi(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == -2);
+  ASSERT(f(0) == -1);
+  ASSERT(f(1) == 0);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == 0x7ffffffe);
+  ASSERT(f(0x80000000) == overflowed);
+  ASSERT(f(0x80000001) == 0x80000000);
+#else
+  ASSERT(f(0x7fffffffffffffff) == 0x7ffffffffffffffe);
+  ASSERT(f(0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000001) == 0x8000000000000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bosubi_u.c b/libguile/lightening/tests/bosubi_u.c
new file mode 100644
index 000000000..50af6ad56
--- /dev/null
+++ b/libguile/lightening/tests/bosubi_u.c
@@ -0,0 +1,37 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bosubi_u(j, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == -2);
+  ASSERT(f(0) == overflowed);
+  ASSERT(f(1) == 0);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000) == 0x7fffffff);
+#else
+  ASSERT(f(0x8000000000000000) == 0x7fffffffffffffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bosubr.c b/libguile/lightening/tests/bosubr.c
new file mode 100644
index 000000000..cf68ad625
--- /dev/null
+++ b/libguile/lightening/tests/bosubr.c
@@ -0,0 +1,48 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bosubr(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == -1);
+  ASSERT(f(1, 1) == 0);
+  ASSERT(f(1, -1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x7ffffffe);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  ASSERT(f(0x80000000, 0x7fffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0x80000000) == overflowed);
+  ASSERT(f(0x80000000, 0x80000000) == 0);
+#else
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bosubr_u.c b/libguile/lightening/tests/bosubr_u.c
new file mode 100644
index 000000000..b5e6b39a0
--- /dev/null
+++ b/libguile/lightening/tests/bosubr_u.c
@@ -0,0 +1,47 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bosubr_u(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+  jit_patch_here(j, r);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 0);
+  ASSERT(f(0, 1) == overflowed);
+  ASSERT(f(1, 0) == 1);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x7ffffffe);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == overflowed);
+  ASSERT(f(0x80000000, 0x80000000) == 0);
+#else
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bswapr_ui.c b/libguile/lightening/tests/bswapr_ui.c
new file mode 100644
index 000000000..c1eb9fdc0
--- /dev/null
+++ b/libguile/lightening/tests/bswapr_ui.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_bswapr_ui(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(0x12345678) == 0x78563412);
+#if __WORDSIZE > 32
+  ASSERT(f(0xff12345678) == 0x78563412);
+  ASSERT(f(0xff00000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bswapr_ul.c b/libguile/lightening/tests/bswapr_ul.c
new file mode 100644
index 000000000..a3a11b31e
--- /dev/null
+++ b/libguile/lightening/tests/bswapr_ul.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_bswapr_ul(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(0x12345678) == 0x7856341200000000);
+  ASSERT(f(0xff12345678) == 0x78563412ff000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bswapr_us.c b/libguile/lightening/tests/bswapr_us.c
new file mode 100644
index 000000000..0ff777e9e
--- /dev/null
+++ b/libguile/lightening/tests/bswapr_us.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_bswapr_us(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(0x12345678) == 0x7856);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/buneqr_d.c b/libguile/lightening/tests/buneqr_d.c
new file mode 100644
index 000000000..1d08e325e
--- /dev/null
+++ b/libguile/lightening/tests/buneqr_d.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_buneqr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/buneqr_f.c b/libguile/lightening/tests/buneqr_f.c
new file mode 100644
index 000000000..49d9062ee
--- /dev/null
+++ b/libguile/lightening/tests/buneqr_f.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_buneqr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunger_d.c b/libguile/lightening/tests/bunger_d.c
new file mode 100644
index 000000000..57888af01
--- /dev/null
+++ b/libguile/lightening/tests/bunger_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bunger_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunger_f.c b/libguile/lightening/tests/bunger_f.c
new file mode 100644
index 000000000..f3103dc9a
--- /dev/null
+++ b/libguile/lightening/tests/bunger_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bunger_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bungtr_d.c b/libguile/lightening/tests/bungtr_d.c
new file mode 100644
index 000000000..649d61f30
--- /dev/null
+++ b/libguile/lightening/tests/bungtr_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bungtr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bungtr_f.c b/libguile/lightening/tests/bungtr_f.c
new file mode 100644
index 000000000..fea66dc60
--- /dev/null
+++ b/libguile/lightening/tests/bungtr_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bungtr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 1);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 1);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunler_d.c b/libguile/lightening/tests/bunler_d.c
new file mode 100644
index 000000000..e59382c5e
--- /dev/null
+++ b/libguile/lightening/tests/bunler_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bunler_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunler_f.c b/libguile/lightening/tests/bunler_f.c
new file mode 100644
index 000000000..fddce6b94
--- /dev/null
+++ b/libguile/lightening/tests/bunler_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bunler_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 1);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunltr_d.c b/libguile/lightening/tests/bunltr_d.c
new file mode 100644
index 000000000..2ab00510b
--- /dev/null
+++ b/libguile/lightening/tests/bunltr_d.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bunltr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunltr_f.c b/libguile/lightening/tests/bunltr_f.c
new file mode 100644
index 000000000..ade228b7b
--- /dev/null
+++ b/libguile/lightening/tests/bunltr_f.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bunltr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 1);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 1);
+  ASSERT(f(0, -1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunordr_d.c b/libguile/lightening/tests/bunordr_d.c
new file mode 100644
index 000000000..6b04f0ee1
--- /dev/null
+++ b/libguile/lightening/tests/bunordr_d.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_reloc_t r = jit_bunordr_d(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(double, double) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bunordr_f.c b/libguile/lightening/tests/bunordr_f.c
new file mode 100644
index 000000000..ce4fc7bea
--- /dev/null
+++ b/libguile/lightening/tests/bunordr_f.c
@@ -0,0 +1,36 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_reloc_t r = jit_bunordr_f(j, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 0);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_reti(j, 1);
+
+  jit_word_t (*f)(float, float) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == 0);
+  ASSERT(f(1, 0) == 0);
+  ASSERT(f(-1, 0) == 0);
+  ASSERT(f(0, -1) == 0);
+  ASSERT(f(1, 1) == 0);
+
+  ASSERT(f(0, 0.0/0.0) == 1);
+  ASSERT(f(0.0/0.0, 0) == 1);
+  ASSERT(f(0.0/0.0, 0.0/0.0) == 1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxaddi.c b/libguile/lightening/tests/bxaddi.c
new file mode 100644
index 000000000..6e872dace
--- /dev/null
+++ b/libguile/lightening/tests/bxaddi.c
@@ -0,0 +1,39 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bxaddi(j, JIT_R0, 1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == 0);
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == overflowed);
+  ASSERT(f(0x80000000) == 0x80000001);
+  ASSERT(f(0xffffffff) == 0);
+#else
+  ASSERT(f(0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxaddi_u.c b/libguile/lightening/tests/bxaddi_u.c
new file mode 100644
index 000000000..e71aeb79d
--- /dev/null
+++ b/libguile/lightening/tests/bxaddi_u.c
@@ -0,0 +1,39 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bxaddi_u(j, JIT_R0, 1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == overflowed);
+  ASSERT(f(0) == 1);
+  ASSERT(f(1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == 0x80000000);
+  ASSERT(f(0x80000000) == 0x80000001);
+  ASSERT(f(0xffffffff) == overflowed);
+#else
+  ASSERT(f(0x7fffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxaddr.c b/libguile/lightening/tests/bxaddr.c
new file mode 100644
index 000000000..c1f6f2393
--- /dev/null
+++ b/libguile/lightening/tests/bxaddr.c
@@ -0,0 +1,49 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bxaddr(j, JIT_R0, JIT_R1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == -2);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == overflowed);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0x80000000) == -1);
+  ASSERT(f(0x80000000, 0x80000000) == overflowed);
+#else
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffffull + 0xffffffffull);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffull + 0x7fffffffull);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == 0x100000000);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == -2);
+  ASSERT(f(0x7fffffffffffffff, 1) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == -1);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxaddr_u.c b/libguile/lightening/tests/bxaddr_u.c
new file mode 100644
index 000000000..d674f8286
--- /dev/null
+++ b/libguile/lightening/tests/bxaddr_u.c
@@ -0,0 +1,49 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bxaddr_u(j, JIT_R0, JIT_R1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffu + 0x7fffffffu);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == overflowed);
+#else
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffffull + 0xffffffffull);
+  ASSERT(f(0x7fffffff, 1) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0x7fffffffull + 0x7fffffffull);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x80000000) == 0x100000000);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == overflowed);
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x8000000000000000);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == -2);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == -1);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == overflowed);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxsubi.c b/libguile/lightening/tests/bxsubi.c
new file mode 100644
index 000000000..1b642c711
--- /dev/null
+++ b/libguile/lightening/tests/bxsubi.c
@@ -0,0 +1,39 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bxsubi(j, JIT_R0, 1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == -2);
+  ASSERT(f(0) == -1);
+  ASSERT(f(1) == 0);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x7fffffff) == 0x7ffffffe);
+  ASSERT(f(0x80000000) == overflowed);
+  ASSERT(f(0x80000001) == 0x80000000);
+#else
+  ASSERT(f(0x7fffffffffffffff) == 0x7ffffffffffffffe);
+  ASSERT(f(0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000001) == 0x8000000000000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxsubi_u.c b/libguile/lightening/tests/bxsubi_u.c
new file mode 100644
index 000000000..1345bd2bf
--- /dev/null
+++ b/libguile/lightening/tests/bxsubi_u.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_reloc_t r = jit_bxsubi_u(j, JIT_R0, 1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(-1) == -2);
+  ASSERT(f(0) == overflowed);
+  ASSERT(f(1) == 0);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000) == 0x7fffffff);
+#else
+  ASSERT(f(0x8000000000000000) == 0x7fffffffffffffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxsubr.c b/libguile/lightening/tests/bxsubr.c
new file mode 100644
index 000000000..d40d1821d
--- /dev/null
+++ b/libguile/lightening/tests/bxsubr.c
@@ -0,0 +1,46 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bxsubr(j, JIT_R0, JIT_R1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(0, 1) == -1);
+  ASSERT(f(1, 1) == 0);
+  ASSERT(f(1, -1) == 2);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x7ffffffe);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  ASSERT(f(0x80000000, 0x7fffffff) == overflowed);
+  ASSERT(f(0x7fffffff, 0x80000000) == overflowed);
+  ASSERT(f(0x80000000, 0x80000000) == 0);
+#else
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/bxsubr_u.c b/libguile/lightening/tests/bxsubr_u.c
new file mode 100644
index 000000000..54a8d2836
--- /dev/null
+++ b/libguile/lightening/tests/bxsubr_u.c
@@ -0,0 +1,45 @@
+#include "test.h"
+
+static const jit_word_t overflowed = 0xcabba9e5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_reloc_t r = jit_bxsubr_u(j, JIT_R0, JIT_R1);
+  jit_movi(j, JIT_R0, overflowed);
+  jit_patch_here(j, r);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0, 0) == 0);
+  ASSERT(f(1, 1) == 0);
+  ASSERT(f(0, 1) == overflowed);
+  ASSERT(f(1, 0) == 1);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0x7fffffff, 1) == 0x7ffffffe);
+  ASSERT(f(0x7fffffff, 0x7fffffff) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == overflowed);
+  ASSERT(f(0x80000000, 0x80000000) == 0);
+#else
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == overflowed);
+  ASSERT(f(0x8000000000000000, 0x8000000000000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/call_10.c b/libguile/lightening/tests/call_10.c
new file mode 100644
index 000000000..d99bcb886
--- /dev/null
+++ b/libguile/lightening/tests/call_10.c
@@ -0,0 +1,54 @@
+#include "test.h"
+
+static int32_t f(int32_t a, int32_t b, int32_t c, int32_t d, int32_t e,
+                 int32_t f, int32_t g, int32_t h, int32_t i, int32_t j) {
+  ASSERT(a == 0);
+  ASSERT(b == 1);
+  ASSERT(c == 2);
+  ASSERT(d == 3);
+  ASSERT(e == 4);
+  ASSERT(f == 5);
+  ASSERT(g == 6);
+  ASSERT(h == 7);
+  ASSERT(i == 8);
+  ASSERT(j == 9);
+  return 42;
+}
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0));
+
+  jit_operand_t args[10] = {
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 0 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 1 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 2 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 3 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 4 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 5 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 6 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 7 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 8 * sizeof(int32_t)),
+    jit_operand_mem(JIT_OPERAND_ABI_INT32, JIT_R0, 9 * sizeof(int32_t))
+  };
+  jit_calli(j, f, 10, args);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  int32_t (*f)(int32_t*) = ret;
+
+  int32_t iargs[10] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
+  ASSERT(f(iargs) == 42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/callee_9.c b/libguile/lightening/tests/callee_9.c
new file mode 100644
index 000000000..b7f1a466c
--- /dev/null
+++ b/libguile/lightening/tests/callee_9.c
@@ -0,0 +1,68 @@
+#include "test.h"
+
+struct args
+{
+  int8_t a;
+  int16_t b;
+  int32_t c;
+  jit_word_t d;
+  uint16_t e;
+  float f;
+  double g;
+  float h;
+};
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 3, 0, 0);
+
+  jit_operand_t args[9] = {
+    jit_operand_gpr(JIT_OPERAND_ABI_POINTER, JIT_R0),
+    jit_operand_gpr(JIT_OPERAND_ABI_INT8, JIT_R1),
+    jit_operand_gpr(JIT_OPERAND_ABI_INT16, JIT_R2),
+    jit_operand_gpr(JIT_OPERAND_ABI_INT32, JIT_V0),
+    jit_operand_gpr(JIT_OPERAND_ABI_WORD, JIT_V1),
+    jit_operand_gpr(JIT_OPERAND_ABI_UINT16, JIT_V2),
+    jit_operand_fpr(JIT_OPERAND_ABI_FLOAT, JIT_F0),
+    jit_operand_fpr(JIT_OPERAND_ABI_DOUBLE, JIT_F1),
+    jit_operand_fpr(JIT_OPERAND_ABI_FLOAT, JIT_F2),
+  };
+  jit_load_args(j, 9, args);
+  jit_stxi_c(j, offsetof(struct args, a), JIT_R0, JIT_R1); // a
+  jit_stxi_s(j, offsetof(struct args, b), JIT_R0, JIT_R2); // b
+  jit_stxi_i(j, offsetof(struct args, c), JIT_R0, JIT_V0); // c
+  jit_stxi(j,   offsetof(struct args, d), JIT_R0, JIT_V1); // d
+  jit_stxi_s(j, offsetof(struct args, e), JIT_R0, JIT_V2); // e
+  jit_stxi_f(j, offsetof(struct args, f), JIT_R0, JIT_F0); // f
+  jit_stxi_d(j, offsetof(struct args, g), JIT_R0, JIT_F1); // g
+  jit_stxi_f(j, offsetof(struct args, h), JIT_R0, JIT_F2); // h
+
+  jit_leave_jit_abi(j, 3, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  struct args* (*f)(struct args*, int8_t, int16_t, int32_t, jit_word_t,
+                    uint16_t, float, double, float) = ret;
+
+  struct args in = { 0, 1, 2, 3, 4, 5, 6, 7 };
+  struct args out;
+  ASSERT(f(&out, in.a, in.b, in.c, in.d, in.e, in.f, in.g, in.h) == &out);
+  ASSERT(in.a == out.a);
+  ASSERT(in.b == out.b);
+  ASSERT(in.c == out.c);
+  ASSERT(in.d == out.d);
+  ASSERT(in.e == out.e);
+  ASSERT(in.f == out.f);
+  ASSERT(in.g == out.g);
+  ASSERT(in.h == out.h);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/comr.c b/libguile/lightening/tests/comr.c
new file mode 100644
index 000000000..c2e7d1883
--- /dev/null
+++ b/libguile/lightening/tests/comr.c
@@ -0,0 +1,41 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_comr(j, JIT_R0, JIT_R0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0) == 0xffffffff);
+  ASSERT(f(1) == 0xfffffffe);
+  ASSERT(f(0xffffffff) == 0);
+  ASSERT(f(0x80000000) == 0x7fffffff);
+  ASSERT(f(0x7fffffff) == 0x80000000);
+  ASSERT(f(0x80000001) == 0x7ffffffe);
+#else
+  ASSERT(f(0) == 0xffffffffffffffff);
+  ASSERT(f(1) == 0xfffffffffffffffe);
+  ASSERT(f(0xffffffff) == 0xffffffff00000000);
+  ASSERT(f(0x80000000) == 0xffffffff7fffffff);
+  ASSERT(f(0x7fffffff) == 0xffffffff80000000);
+  ASSERT(f(0x80000001) == 0xffffffff7ffffffe);
+  ASSERT(f(0xffffffffffffffff) == 0);
+  ASSERT(f(0x8000000000000000) == 0x7fffffffffffffff);
+  ASSERT(f(0x7fffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0x8000000000000001) == 0x7ffffffffffffffe);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/divr.c b/libguile/lightening/tests/divr.c
new file mode 100644
index 000000000..399d70de1
--- /dev/null
+++ b/libguile/lightening/tests/divr.c
@@ -0,0 +1,60 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_divr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0x7fffffff);
+  ASSERT(f(1, 0x7fffffff) == 0);
+  ASSERT(f(0x80000000, 1) == 0x80000000);
+  ASSERT(f(1, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 2) == 0x3fffffff);
+  ASSERT(f(2, 0x7fffffff) == 0);
+  ASSERT(f(2, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0);
+  ASSERT(f(0, 0x7fffffff) == 0);
+  ASSERT(f(0xffffffff, 0xffffffff) == 1);
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000, 2) == 0xc0000000);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x80000001);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0);
+#else
+  ASSERT(f(0x80000000, 2) == 0x40000000);
+  ASSERT(f(0x80000000, 0x7fffffff) == 1);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 2);
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x7fffffffffffffff);
+  ASSERT(f(1, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x8000000000000000, 1) == 0x8000000000000000);
+  ASSERT(f(1, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 2) == 0x3fffffffffffffff);
+  ASSERT(f(2, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x8000000000000000, 2) == 0xc000000000000000);
+  ASSERT(f(2, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/divr_d.c b/libguile/lightening/tests/divr_d.c
new file mode 100644
index 000000000..9d21cb591
--- /dev/null
+++ b/libguile/lightening/tests/divr_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_divr_d(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  double (*f)(double, double) = ret;
+  ASSERT(f(-0.5f, 0.5f) == -1.0f);
+  ASSERT(f(1.25f, 0.5f) == 2.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/divr_f.c b/libguile/lightening/tests/divr_f.c
new file mode 100644
index 000000000..de519dc75
--- /dev/null
+++ b/libguile/lightening/tests/divr_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_divr_f(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  float (*f)(float, float) = ret;
+  ASSERT(f(-0.5f, 0.5f) == -1.0f);
+  ASSERT(f(1.25f, 0.5f) == 2.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/divr_u.c b/libguile/lightening/tests/divr_u.c
new file mode 100644
index 000000000..b8305f781
--- /dev/null
+++ b/libguile/lightening/tests/divr_u.c
@@ -0,0 +1,55 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_divr_u(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0x7fffffff);
+  ASSERT(f(1, 0x7fffffff) == 0);
+  ASSERT(f(0x80000000, 1) == 0x80000000);
+  ASSERT(f(1, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 2) == 0x3fffffff);
+  ASSERT(f(2, 0x7fffffff) == 0);
+  ASSERT(f(0x80000000, 2) == 0x40000000);
+  ASSERT(f(2, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0);
+  ASSERT(f(0x80000000, 0x7fffffff) == 1);
+  ASSERT(f(0, 0x7fffffff) == 0);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 2);
+  ASSERT(f(0xffffffff, 0xffffffff) == 1);
+#if __WORDSIZE != 32
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x7fffffffffffffff);
+  ASSERT(f(1, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x8000000000000000, 1) == 0x8000000000000000);
+  ASSERT(f(1, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 2) == 0x3fffffffffffffff);
+  ASSERT(f(2, 0x7fffffffffffffff) == 0);
+  ASSERT(f(0x8000000000000000, 2) == 0x4000000000000000);
+  ASSERT(f(2, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 2);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_c.c b/libguile/lightening/tests/extr_c.c
new file mode 100644
index 000000000..043068d3f
--- /dev/null
+++ b/libguile/lightening/tests/extr_c.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_c(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xf) == 0xf);
+  ASSERT(f(0xff) == -1);
+  ASSERT(f(0xfff) == -1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_d.c b/libguile/lightening/tests/extr_d.c
new file mode 100644
index 000000000..af0fe9145
--- /dev/null
+++ b/libguile/lightening/tests/extr_d.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_extr_d(j, JIT_F0, JIT_R0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0.0);
+  ASSERT(f(1) == 1.0);
+  ASSERT(f(-100) == -100.0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_d_f.c b/libguile/lightening/tests/extr_d_f.c
new file mode 100644
index 000000000..049eb5fb5
--- /dev/null
+++ b/libguile/lightening/tests/extr_d_f.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_extr_d_f(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0.0f);
+  ASSERT(f(0.5) == 0.5f);
+  ASSERT(f(1.0 / 0.0) == 1.0f / 0.0f);
+  ASSERT(f(1.25) == 1.25f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_f.c b/libguile/lightening/tests/extr_f.c
new file mode 100644
index 000000000..b57830cae
--- /dev/null
+++ b/libguile/lightening/tests/extr_f.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_extr_f(j, JIT_F0, JIT_R0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0.0f);
+  ASSERT(f(1) == 1.0f);
+  ASSERT(f(-100) == -100.0f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_f_d.c b/libguile/lightening/tests/extr_f_d.c
new file mode 100644
index 000000000..5fa500772
--- /dev/null
+++ b/libguile/lightening/tests/extr_f_d.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_extr_f_d(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0f) == 0.0);
+  ASSERT(f(0.5f) == 0.5);
+  ASSERT(f(1.0f / 0.0f) == 1.0 / 0.0);
+  ASSERT(f(1.25f) == 1.25);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_i.c b/libguile/lightening/tests/extr_i.c
new file mode 100644
index 000000000..d26a576b5
--- /dev/null
+++ b/libguile/lightening/tests/extr_i.c
@@ -0,0 +1,30 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_i(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xfffffff) == 0xfffffff);
+  ASSERT(f(0xffffffff) == -1);
+  ASSERT(f(0xfffffffff) == -1);
+  ASSERT(f(0xf00000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_s.c b/libguile/lightening/tests/extr_s.c
new file mode 100644
index 000000000..5b39af392
--- /dev/null
+++ b/libguile/lightening/tests/extr_s.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_s(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xfff) == 0xfff);
+  ASSERT(f(0xffff) == -1);
+  ASSERT(f(0xfffff) == -1);
+  ASSERT(f(0xf0000) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_uc.c b/libguile/lightening/tests/extr_uc.c
new file mode 100644
index 000000000..a42e603a9
--- /dev/null
+++ b/libguile/lightening/tests/extr_uc.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_uc(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xff) == 0xff);
+  ASSERT(f(0xfff) == 0xff);
+  ASSERT(f(0xf00) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_ui.c b/libguile/lightening/tests/extr_ui.c
new file mode 100644
index 000000000..37964da16
--- /dev/null
+++ b/libguile/lightening/tests/extr_ui.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_ui(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xffffffff) == 0xffffffff);
+  ASSERT(f(0xfffffffff) == 0xffffffff);
+  ASSERT(f(0xf00000000) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/extr_us.c b/libguile/lightening/tests/extr_us.c
new file mode 100644
index 000000000..38a7c390a
--- /dev/null
+++ b/libguile/lightening/tests/extr_us.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_extr_us(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+  ASSERT(f(1) == 1);
+  ASSERT(f(0xffff) == 0xffff);
+  ASSERT(f(0xfffff) == 0xffff);
+  ASSERT(f(0xf0000) == 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/jmpi.c b/libguile/lightening/tests/jmpi.c
new file mode 100644
index 000000000..2f9213fec
--- /dev/null
+++ b/libguile/lightening/tests/jmpi.c
@@ -0,0 +1,21 @@
+#include "test.h"
+
+static int tail(void) { return 42; }
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+
+  jit_jmpi(j, tail);
+
+  int (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == 42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/jmpr.c b/libguile/lightening/tests/jmpr.c
new file mode 100644
index 000000000..884089702
--- /dev/null
+++ b/libguile/lightening/tests/jmpr.c
@@ -0,0 +1,23 @@
+#include "test.h"
+
+static int tail(void) { return 42; }
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0));
+  jit_leave_jit_abi(j, 0, 0, align);
+
+  jit_jmpr(j, JIT_R0);
+
+  int (*f)(void*) = jit_end(j, NULL);
+  ASSERT(f(tail) == 42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_c.c b/libguile/lightening/tests/ldi_c.c
new file mode 100644
index 000000000..9d5de8226
--- /dev/null
+++ b/libguile/lightening/tests/ldi_c.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_c(j, JIT_R0, &data[0]);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == -1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_d.c b/libguile/lightening/tests/ldi_d.c
new file mode 100644
index 000000000..b72cdda61
--- /dev/null
+++ b/libguile/lightening/tests/ldi_d.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static double data = -1.5;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_d(j, JIT_F0, &data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == data);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_f.c b/libguile/lightening/tests/ldi_f.c
new file mode 100644
index 000000000..13e5fd427
--- /dev/null
+++ b/libguile/lightening/tests/ldi_f.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static float data = -1.5f;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_f(j, JIT_F0, &data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == data);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_i.c b/libguile/lightening/tests/ldi_i.c
new file mode 100644
index 000000000..e38978802
--- /dev/null
+++ b/libguile/lightening/tests/ldi_i.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static uint32_t data = 0xffffffff;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_i(j, JIT_R0, &data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == -1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_l.c b/libguile/lightening/tests/ldi_l.c
new file mode 100644
index 000000000..f3fa729cb
--- /dev/null
+++ b/libguile/lightening/tests/ldi_l.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data = 0xffffffffffffffff;
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_l(j, JIT_R0, &data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == -1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_s.c b/libguile/lightening/tests/ldi_s.c
new file mode 100644
index 000000000..d9d1c4725
--- /dev/null
+++ b/libguile/lightening/tests/ldi_s.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static uint16_t data = 0xffff;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_s(j, JIT_R0, &data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == -1);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_uc.c b/libguile/lightening/tests/ldi_uc.c
new file mode 100644
index 000000000..12f18bf17
--- /dev/null
+++ b/libguile/lightening/tests/ldi_uc.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_uc(j, JIT_R0, data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == 0xff);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_ui.c b/libguile/lightening/tests/ldi_ui.c
new file mode 100644
index 000000000..d233694c6
--- /dev/null
+++ b/libguile/lightening/tests/ldi_ui.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_ui(j, JIT_R0, data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == data[0]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldi_us.c b/libguile/lightening/tests/ldi_us.c
new file mode 100644
index 000000000..70eb4a093
--- /dev/null
+++ b/libguile/lightening/tests/ldi_us.c
@@ -0,0 +1,24 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_ldi_us(j, JIT_R0, data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == data[0]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_c.c b/libguile/lightening/tests/ldr_c.c
new file mode 100644
index 000000000..07a59314b
--- /dev/null
+++ b/libguile/lightening/tests/ldr_c.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_c(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == -1);
+  ASSERT(f(&data[1]) == 0);
+  ASSERT(f(&data[2]) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_d.c b/libguile/lightening/tests/ldr_d.c
new file mode 100644
index 000000000..37c75f096
--- /dev/null
+++ b/libguile/lightening/tests/ldr_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_d(j, JIT_F0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == data[0]);
+  ASSERT(f(&data[1]) == data[1]);
+  ASSERT(f(&data[2]) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_f.c b/libguile/lightening/tests/ldr_f.c
new file mode 100644
index 000000000..bb6827848
--- /dev/null
+++ b/libguile/lightening/tests/ldr_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_f(j, JIT_F0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == data[0]);
+  ASSERT(f(&data[1]) == data[1]);
+  ASSERT(f(&data[2]) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_i.c b/libguile/lightening/tests/ldr_i.c
new file mode 100644
index 000000000..3de9e5f2c
--- /dev/null
+++ b/libguile/lightening/tests/ldr_i.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_i(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == -1);
+  ASSERT(f(&data[1]) == 0);
+  ASSERT(f(&data[2]) == 0x42424242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_l.c b/libguile/lightening/tests/ldr_l.c
new file mode 100644
index 000000000..15f00801e
--- /dev/null
+++ b/libguile/lightening/tests/ldr_l.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0xffffffffffffffff, 0, 0x4242424212345678 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_l(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == -1);
+  ASSERT(f(&data[1]) == 0);
+  ASSERT(f(&data[2]) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_s.c b/libguile/lightening/tests/ldr_s.c
new file mode 100644
index 000000000..cf668d5b3
--- /dev/null
+++ b/libguile/lightening/tests/ldr_s.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_s(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == -1);
+  ASSERT(f(&data[1]) == 0);
+  ASSERT(f(&data[2]) == 0x4242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_uc.c b/libguile/lightening/tests/ldr_uc.c
new file mode 100644
index 000000000..a48f37056
--- /dev/null
+++ b/libguile/lightening/tests/ldr_uc.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_uc(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == 0xff);
+  ASSERT(f(&data[1]) == 0);
+  ASSERT(f(&data[2]) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_ui.c b/libguile/lightening/tests/ldr_ui.c
new file mode 100644
index 000000000..7668778b5
--- /dev/null
+++ b/libguile/lightening/tests/ldr_ui.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_ui(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == data[0]);
+  ASSERT(f(&data[1]) == data[1]);
+  ASSERT(f(&data[2]) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldr_us.c b/libguile/lightening/tests/ldr_us.c
new file mode 100644
index 000000000..bb9928bf0
--- /dev/null
+++ b/libguile/lightening/tests/ldr_us.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1));
+
+  jit_ldr_us(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*) = jit_end(j, NULL);
+
+  ASSERT(f(&data[0]) == data[0]);
+  ASSERT(f(&data[1]) == data[1]);
+  ASSERT(f(&data[2]) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_c.c b/libguile/lightening/tests/ldxi_c.c
new file mode 100644
index 000000000..4271f9753
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_c.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_c(j, JIT_R0, JIT_R0, (uintptr_t)&data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == -1);
+  ASSERT(f(1) == 0);
+  ASSERT(f(2) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_d.c b/libguile/lightening/tests/ldxi_d.c
new file mode 100644
index 000000000..6bcf632cc
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_d(j, JIT_F0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == data[0]);
+  ASSERT(f(8) == data[1]);
+  ASSERT(f(16) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_f.c b/libguile/lightening/tests/ldxi_f.c
new file mode 100644
index 000000000..9e65321d8
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_f(j, JIT_F0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == data[0]);
+  ASSERT(f(4) == data[1]);
+  ASSERT(f(8) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_i.c b/libguile/lightening/tests/ldxi_i.c
new file mode 100644
index 000000000..d1f7b5605
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_i.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0));
+
+  jit_ldxi_i(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == -1);
+  ASSERT(f(4) == 0);
+  ASSERT(f(8) == 0x42424242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_l.c b/libguile/lightening/tests/ldxi_l.c
new file mode 100644
index 000000000..bb1a8b257
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_l.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0xffffffffffffffff, 0, 0x4242424212345678 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_l(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == -1);
+  ASSERT(f(8) == 0);
+  ASSERT(f(16) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_s.c b/libguile/lightening/tests/ldxi_s.c
new file mode 100644
index 000000000..c9376d0fb
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_s.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_s(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == -1);
+  ASSERT(f(2) == 0);
+  ASSERT(f(4) == 0x4242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_uc.c b/libguile/lightening/tests/ldxi_uc.c
new file mode 100644
index 000000000..31d7b73d3
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_uc.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_uc(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0xff);
+  ASSERT(f(1) == 0);
+  ASSERT(f(2) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_ui.c b/libguile/lightening/tests/ldxi_ui.c
new file mode 100644
index 000000000..4f7e304a6
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_ui.c
@@ -0,0 +1,29 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_ui(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == data[0]);
+  ASSERT(f(4) == data[1]);
+  ASSERT(f(8) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxi_us.c b/libguile/lightening/tests/ldxi_us.c
new file mode 100644
index 000000000..81c984f1f
--- /dev/null
+++ b/libguile/lightening/tests/ldxi_us.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ldxi_us(j, JIT_R0, JIT_R0, (uintptr_t)data);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == data[0]);
+  ASSERT(f(2) == data[1]);
+  ASSERT(f(4) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_c.c b/libguile/lightening/tests/ldxr_c.c
new file mode 100644
index 000000000..366f5b2f3
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_c.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_c(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == -1);
+  ASSERT(f(data, 1) == 0);
+  ASSERT(f(data, 2) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_d.c b/libguile/lightening/tests/ldxr_d.c
new file mode 100644
index 000000000..38a12fdd5
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_d.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_d(j, JIT_F0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == data[0]);
+  ASSERT(f(data, 8) == data[1]);
+  ASSERT(f(data, 16) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_f.c b/libguile/lightening/tests/ldxr_f.c
new file mode 100644
index 000000000..c48b11f8f
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_f.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_f(j, JIT_F0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == data[0]);
+  ASSERT(f(data, 4) == data[1]);
+  ASSERT(f(data, 8) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_i.c b/libguile/lightening/tests/ldxr_i.c
new file mode 100644
index 000000000..e4149aade
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_i.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_i(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == -1);
+  ASSERT(f(data, 4) == 0);
+  ASSERT(f(data, 8) == 0x42424242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_l.c b/libguile/lightening/tests/ldxr_l.c
new file mode 100644
index 000000000..ee9f156a7
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_l.c
@@ -0,0 +1,30 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0xffffffffffffffff, 0, 0x4242424212345678 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_l(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == -1);
+  ASSERT(f(data, 8) == 0);
+  ASSERT(f(data, 16) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_s.c b/libguile/lightening/tests/ldxr_s.c
new file mode 100644
index 000000000..fbb5c090c
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_s.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_s(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == -1);
+  ASSERT(f(data, 2) == 0);
+  ASSERT(f(data, 4) == 0x4242);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_uc.c b/libguile/lightening/tests/ldxr_uc.c
new file mode 100644
index 000000000..846c552c2
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_uc.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static uint8_t data[] = { 0xff, 0x00, 0x42 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_uc(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == 0xff);
+  ASSERT(f(data, 1) == 0);
+  ASSERT(f(data, 2) == 0x42);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_ui.c b/libguile/lightening/tests/ldxr_ui.c
new file mode 100644
index 000000000..cd774d355
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_ui.c
@@ -0,0 +1,30 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint32_t data[] = { 0xffffffff, 0x00000000, 0x42424242 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_ui(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == data[0]);
+  ASSERT(f(data, 4) == data[1]);
+  ASSERT(f(data, 8) == data[2]);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ldxr_us.c b/libguile/lightening/tests/ldxr_us.c
new file mode 100644
index 000000000..b7e408bb9
--- /dev/null
+++ b/libguile/lightening/tests/ldxr_us.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static uint16_t data[] = { 0xffff, 0x0000, 0x4242 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_ldxr_us(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_uword_t (*f)(void*, jit_uword_t) = jit_end(j, NULL);
+
+  ASSERT(f(data, 0) == data[0]);
+  ASSERT(f(data, 2) == data[1]);
+  ASSERT(f(data, 4) == data[2]);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/link-register.c b/libguile/lightening/tests/link-register.c
new file mode 100644
index 000000000..96ee959b1
--- /dev/null
+++ b/libguile/lightening/tests/link-register.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0));
+
+  jit_reloc_t call_tramp = jit_jmp (j);
+
+  void *tramp = jit_address (j);
+  jit_pop_link_register (j);
+  jit_movr (j, JIT_R0, JIT_LR);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr (j, JIT_R0);
+
+  jit_patch_here (j, call_tramp);
+  jit_jmpi_with_link (j, tramp);
+
+  void *expected_link = jit_address_to_function_pointer (jit_address (j));
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  void* (*f)(void) = ret;
+
+  ASSERT(f() == expected_link);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/lshi.c b/libguile/lightening/tests/lshi.c
new file mode 100644
index 000000000..e721af58b
--- /dev/null
+++ b/libguile/lightening/tests/lshi.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_lshi(j, JIT_R0, JIT_R0, 31);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+#if __WORDSIZE == 32
+  ASSERT(f(-0x7f) == 0x80000000);
+#else
+  ASSERT(f(-0x7f) == 0xffffffc080000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/lshr.c b/libguile/lightening/tests/lshr.c
new file mode 100644
index 000000000..f81aa690a
--- /dev/null
+++ b/libguile/lightening/tests/lshr.c
@@ -0,0 +1,69 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_lshr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7f, 1) == 0xfe);
+  ASSERT(f(0x7fff, 2) == 0x1fffc);
+  ASSERT(f(0x81, 16) == 0x810000);
+  ASSERT(f(0xff, 15) == 0x7f8000);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+#if __WORDSIZE == 32
+  ASSERT(f(0xffffffff, 8) == 0xffffff00);
+  ASSERT(f(0x7fffffff, 3) == 0xfffffff8);
+  ASSERT(f(-0x7f, 31) == 0x80000000);
+  ASSERT(f(-0x7fff, 30) == 0x40000000);
+  ASSERT(f(-0x7fffffff, 29) == 0x20000000);
+  ASSERT(f(0x80000001, 28) == 0x10000000);
+  ASSERT(f(0x8001, 17) == 0x20000);
+  ASSERT(f(0x80000001, 18) == 0x40000);
+  ASSERT(f(-0xffff, 24) == 0x1000000);
+#else
+  ASSERT(f(0xffffffff, 8) == 0xffffffff00);
+  ASSERT(f(0x7fffffff, 3) == 0x3fffffff8);
+  ASSERT(f(-0x7f, 31) == 0xffffffc080000000);
+  ASSERT(f(-0x7fff, 30) == 0xffffe00040000000);
+  ASSERT(f(-0x7fffffff, 29) == 0xf000000020000000);
+  ASSERT(f(0x80000001, 28) == 0x800000010000000);
+  ASSERT(f(0x8001, 17) == 0x100020000);
+  ASSERT(f(0x80000001, 18) == 0x2000000040000);
+  ASSERT(f(-0xffff, 24) == 0xffffff0001000000);
+  ASSERT(f(0x7f, 33) == 0xfe00000000);
+  ASSERT(f(0x7ffff, 34) == 0x1ffffc00000000);
+  ASSERT(f(0x7fffffff, 35) == 0xfffffff800000000);
+  ASSERT(f(-0x7f, 63) == 0x8000000000000000);
+  ASSERT(f(-0x7fff, 62) == 0x4000000000000000);
+  ASSERT(f(-0x7fffffff, 61) == 0x2000000000000000);
+  ASSERT(f(0x80000001, 60) == 0x1000000000000000);
+  ASSERT(f(0x81, 48) == 0x81000000000000);
+  ASSERT(f(0x8001, 49) == 0x2000000000000);
+  ASSERT(f(0x80000001, 40) == 0x10000000000);
+  ASSERT(f(0xff, 47) == 0x7f800000000000);
+  ASSERT(f(0xffff0001, 56) == 0x100000000000000);
+  ASSERT(f(0xffffffff, 40) == 0xffffff0000000000);
+  ASSERT(f(0x7fffffffff, 33) == 0xfffffffe00000000);
+  ASSERT(f(-0x7fffffffff, 63) == 0x8000000000000000);
+  ASSERT(f(0x8000000001, 48) == 0x1000000000000);
+  ASSERT(f(0xffffffffff, 47) == 0xffff800000000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/mov_addr.c b/libguile/lightening/tests/mov_addr.c
new file mode 100644
index 000000000..b4a9aaae1
--- /dev/null
+++ b/libguile/lightening/tests/mov_addr.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static uint64_t thing = 0x123456789abcdef0;
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_patch_there(j, jit_mov_addr(j, JIT_R0), &thing);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  void* (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == &thing);
+  ASSERT(*(uint64_t*)f() == thing);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/movi_d.c b/libguile/lightening/tests/movi_d.c
new file mode 100644
index 000000000..cb9e63d47
--- /dev/null
+++ b/libguile/lightening/tests/movi_d.c
@@ -0,0 +1,22 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_movi_d(j, JIT_F0, 3.14159);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == 3.14159);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/movi_f.c b/libguile/lightening/tests/movi_f.c
new file mode 100644
index 000000000..944f61589
--- /dev/null
+++ b/libguile/lightening/tests/movi_f.c
@@ -0,0 +1,22 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+
+  jit_movi_f(j, JIT_F0, 3.14159f);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(void) = jit_end(j, NULL);
+
+  ASSERT(f() == 3.14159f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/mulr.c b/libguile/lightening/tests/mulr.c
new file mode 100644
index 000000000..452e35dcb
--- /dev/null
+++ b/libguile/lightening/tests/mulr.c
@@ -0,0 +1,64 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_mulr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0x7fffffff);
+  ASSERT(f(1, 0x7fffffff) == 0x7fffffff);
+  ASSERT(f(0x80000000, 1) == 0x80000000);
+  ASSERT(f(1, 0x80000000) == 0x80000000);
+  ASSERT(f(0x7fffffff, 2) == 0xfffffffe);
+  ASSERT(f(2, 0x7fffffff) == 0xfffffffe);
+  ASSERT(f(0x7fffffff, 0) == 0);
+  ASSERT(f(0, 0x7fffffff) == 0);
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000, 2) == 0);
+  ASSERT(f(2, 0x80000000) == 0);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0x80000000);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0x80000000);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x80000001);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0x80000001);
+  ASSERT(f(0xffffffff, 0xffffffff) == 1);
+#else
+  ASSERT(f(0x80000000, 2) == 0x100000000);
+  ASSERT(f(2, 0x80000000) == 0x100000000);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0x3fffffff80000000);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0x3fffffff80000000);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x7ffffffe80000001);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0x7ffffffe80000001);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xfffffffe00000001);
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x7fffffffffffffff);
+  ASSERT(f(1, 0x7fffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0x8000000000000000, 1) == 0x8000000000000000);
+  ASSERT(f(1, 0x8000000000000000) == 0x8000000000000000);
+  ASSERT(f(0x7fffffffffffffff, 2) == 0xfffffffffffffffe);
+  ASSERT(f(2, 0x7fffffffffffffff) == 0xfffffffffffffffe);
+  ASSERT(f(0x8000000000000000, 2) == 0);
+  ASSERT(f(2, 0x8000000000000000) == 0);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0x8000000000000000);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0x8000000000000001);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/mulr_d.c b/libguile/lightening/tests/mulr_d.c
new file mode 100644
index 000000000..945f1527d
--- /dev/null
+++ b/libguile/lightening/tests/mulr_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_mulr_d(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  double (*f)(double, double) = ret;
+  ASSERT(f(-0.5, 0.5) == -0.25);
+  ASSERT(f(0.25, 0.75) == 0.1875);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/mulr_f.c b/libguile/lightening/tests/mulr_f.c
new file mode 100644
index 000000000..2d0dd4ffa
--- /dev/null
+++ b/libguile/lightening/tests/mulr_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_mulr_f(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  float (*f)(float, float) = ret;
+  ASSERT(f(-0.5f, 0.5f) == -0.25f);
+  ASSERT(f(0.25f, 0.75f) == 0.1875f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/negr.c b/libguile/lightening/tests/negr.c
new file mode 100644
index 000000000..18e27cbbb
--- /dev/null
+++ b/libguile/lightening/tests/negr.c
@@ -0,0 +1,39 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_negr(j, JIT_R0, JIT_R0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+  ASSERT(f(0) == 0);
+#if __WORDSIZE == 32
+  ASSERT(f(1) == 0xffffffff);
+  ASSERT(f(0xffffffff) == 1);
+  ASSERT(f(0x80000000) == 0x80000000);
+  ASSERT(f(0x7fffffff) == 0x80000001);
+  ASSERT(f(0x80000001) == 0x7fffffff);
+#else
+  ASSERT(f(1) == 0xffffffffffffffff);
+  ASSERT(f(0xffffffff) == 0xffffffff00000001);
+  ASSERT(f(0x80000000) == 0xffffffff80000000);
+  ASSERT(f(0x7fffffff) == 0xffffffff80000001);
+  ASSERT(f(0x80000001) == 0xffffffff7fffffff);
+  ASSERT(f(0xffffffffffffffff) == 1);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000000);
+  ASSERT(f(0x7fffffffffffffff) == 0x8000000000000001);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/negr_d.c b/libguile/lightening/tests/negr_d.c
new file mode 100644
index 000000000..d0e168b8c
--- /dev/null
+++ b/libguile/lightening/tests/negr_d.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_negr_d(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == -0.0);
+  ASSERT(f(0.5) == -0.5);
+  ASSERT(f(1.0 / 0.0) == -1.0 / 0.0);
+  ASSERT(f(-1.25) == 1.25);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/negr_f.c b/libguile/lightening/tests/negr_f.c
new file mode 100644
index 000000000..26110d560
--- /dev/null
+++ b/libguile/lightening/tests/negr_f.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_negr_f(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0f) == -0.0f);
+  ASSERT(f(0.5f) == -0.5f);
+  ASSERT(f(1.0f / 0.0f) == -1.0f / 0.0f);
+  ASSERT(f(-1.25f) == 1.25f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/ori.c b/libguile/lightening/tests/ori.c
new file mode 100644
index 000000000..631018527
--- /dev/null
+++ b/libguile/lightening/tests/ori.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_ori(j, JIT_R0, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff) == 0x7fffffff);
+  ASSERT(f(0x80000000) == 0x80000001);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/orr.c b/libguile/lightening/tests/orr.c
new file mode 100644
index 000000000..5a9087a3d
--- /dev/null
+++ b/libguile/lightening/tests/orr.c
@@ -0,0 +1,48 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_orr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0x7fffffff);
+  ASSERT(f(1, 0x7fffffff) == 0x7fffffff);
+  ASSERT(f(0x80000000, 1) == 0x80000001);
+  ASSERT(f(1, 0x80000000) == 0x80000001);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0xffffffff);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0xffffffff);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0, 0x7fffffff) == 0x7fffffff);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x7fffffffffffffff);
+  ASSERT(f(1, 0x7fffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0x8000000000000000, 1) == 0x8000000000000001);
+  ASSERT(f(1, 0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0xffffffffffffffff);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0xffffffffffffffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/qdivr.c b/libguile/lightening/tests/qdivr.c
new file mode 100644
index 000000000..665053c56
--- /dev/null
+++ b/libguile/lightening/tests/qdivr.c
@@ -0,0 +1,44 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 3, 0, 0);
+
+  jit_operand_t args[] =
+    { jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_V0) };
+  jit_load_args(j, 4, args);
+
+  jit_qdivr(j, JIT_V1, JIT_V2, JIT_R2, JIT_V0);
+  jit_str(j, JIT_R0, JIT_V1);
+  jit_str(j, JIT_R1, JIT_V2);
+
+  jit_leave_jit_abi(j, 3, 0, align);
+
+  jit_ret(j);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  void (*f)(jit_word_t*, jit_word_t*, jit_word_t, jit_word_t) = ret;
+
+#define QDIV(a, b, c, d) \
+  do { \
+    jit_word_t C = 0, D = 0; f(&C, &D, a, b); ASSERT(C == c); ASSERT(D == d); \
+  } while (0)
+  
+  QDIV(10, 3, 3, 1);
+  QDIV(-33, 9, -3, -6);
+  QDIV(-41, -7, 5, -6);
+  QDIV(65536, 4096, 16, 0);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/qdivr_u.c b/libguile/lightening/tests/qdivr_u.c
new file mode 100644
index 000000000..e2601933c
--- /dev/null
+++ b/libguile/lightening/tests/qdivr_u.c
@@ -0,0 +1,42 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+
+  size_t align = jit_enter_jit_abi(j, 3, 0, 0);
+
+  jit_operand_t args[] =
+    { jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_V0) };
+  jit_load_args(j, 4, args);
+
+  jit_qdivr_u(j, JIT_V1, JIT_V2, JIT_R2, JIT_V0);
+  jit_str(j, JIT_R0, JIT_V1);
+  jit_str(j, JIT_R1, JIT_V2);
+
+  jit_leave_jit_abi(j, 3, 0, align);
+
+  jit_ret(j);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  void (*f)(jit_word_t*, jit_word_t*, jit_word_t, jit_word_t) = ret;
+#define QDIV(a, b, c, d) \
+  do { \
+    jit_word_t C = 0, D = 0; f(&C, &D, a, b); ASSERT(C == c); ASSERT(D == d); \
+  } while (0)
+  
+  QDIV(-1, -2, 1, 1);
+  QDIV(-2, -5, 1, 3);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/qmulr.c b/libguile/lightening/tests/qmulr.c
new file mode 100644
index 000000000..1645f5a9f
--- /dev/null
+++ b/libguile/lightening/tests/qmulr.c
@@ -0,0 +1,58 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+
+  size_t align = jit_enter_jit_abi(j, 3, 0, 0);
+
+  jit_operand_t args[] =
+    { jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_V0) };
+  jit_load_args(j, 4, args);
+
+  jit_qmulr(j, JIT_V1, JIT_V2, JIT_R2, JIT_V0);
+  jit_str(j, JIT_R0, JIT_V1);
+  jit_str(j, JIT_R1, JIT_V2);
+
+  jit_leave_jit_abi(j, 3, 0, align);
+
+  jit_ret(j);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  void (*f)(jit_word_t*, jit_word_t*, jit_word_t, jit_word_t) = ret;
+
+#define QMUL(a, b, c, d) \
+  do { \
+    jit_word_t C = 0, D = 0; f(&C, &D, a, b); ASSERT(C == c); ASSERT(D == d); \
+  } while (0)
+  
+  QMUL(-2, -1, 2, 0);
+  QMUL(0, -1, 0, 0);
+  QMUL(-1, 0, 0, 0);
+  QMUL(1, -1, -1, -1);
+#if __WORDSIZE == 32
+  QMUL(0x7ffff, 0x7ffff, 0xfff00001, 0x3f);
+  QMUL(0x80000000, -2, 0, 1);
+  QMUL(0x80000000, 2, 0, -1);
+  QMUL(0x80000001, 3, 0x80000003, -2);
+  QMUL(0x80000001, -3, 0x7ffffffd, 1);
+#else
+  QMUL(0x7ffffffff, 0x7ffffffff, 0xfffffff000000001, 0x3f);
+  QMUL(0x8000000000000000, -2, 0, 1);
+  QMUL(0x8000000000000000, 2, 0, -1);
+  QMUL(0x8000000000000001, 3, 0x8000000000000003, -2);
+  QMUL(0x8000000000000001, -3, 0x7ffffffffffffffd, 1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/qmulr_u.c b/libguile/lightening/tests/qmulr_u.c
new file mode 100644
index 000000000..bb1d50d17
--- /dev/null
+++ b/libguile/lightening/tests/qmulr_u.c
@@ -0,0 +1,46 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+
+  size_t align = jit_enter_jit_abi(j, 3, 0, 0);
+
+  jit_operand_t args[] =
+    { jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+      jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R1),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+      jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_V0) };
+  jit_load_args(j, 4, args);
+
+  jit_qmulr_u(j, JIT_V1, JIT_V2, JIT_R2, JIT_V0);
+  jit_str(j, JIT_R0, JIT_V1);
+  jit_str(j, JIT_R1, JIT_V2);
+
+  jit_leave_jit_abi(j, 3, 0, align);
+
+  jit_ret(j);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  void (*f)(jit_word_t*, jit_word_t*, jit_word_t, jit_word_t) = ret;
+
+#define UQMUL(a, b, c, d) \
+  do { \
+    jit_word_t C = 0, D = 0; f(&C, &D, a, b); ASSERT(C == c); ASSERT(D == d); \
+  } while (0)
+  
+#if __WORDSIZE == 32
+  UQMUL(0xffffff, 0xffffff, 0xfe000001, 0xffff);
+#else
+  UQMUL(0xffffffffff, 0xffffffffff, 0xfffffe0000000001, 0xffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/remr.c b/libguile/lightening/tests/remr.c
new file mode 100644
index 000000000..805d6fbf9
--- /dev/null
+++ b/libguile/lightening/tests/remr.c
@@ -0,0 +1,60 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_remr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0);
+  ASSERT(f(1, 0x7fffffff) == 1);
+  ASSERT(f(0x80000000, 1) == 0);
+  ASSERT(f(1, 0x80000000) == 1);
+  ASSERT(f(0x7fffffff, 2) == 1);
+  ASSERT(f(2, 0x7fffffff) == 2);
+  ASSERT(f(0x80000000, 2) == 0);
+  ASSERT(f(2, 0x80000000) == 2);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0x7fffffff);
+  ASSERT(f(0, 0x7fffffff) == 0);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000, 0x7fffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0xffffffff);
+#else
+  ASSERT(f(0x80000000, 0x7fffffff) == 1);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x7fffffff);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 1);
+  ASSERT(f(0x7fffffffffffffff, 1) == 0);
+  ASSERT(f(1, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0x8000000000000000, 1) == 0);
+  ASSERT(f(1, 0x8000000000000000) == 1);
+  ASSERT(f(0x7fffffffffffffff, 2) == 1);
+  ASSERT(f(2, 0x7fffffffffffffff) == 2);
+  ASSERT(f(0x8000000000000000, 2) == 0);
+  ASSERT(f(2, 0x8000000000000000) == 2);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0x7fffffffffffffff);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/remr_u.c b/libguile/lightening/tests/remr_u.c
new file mode 100644
index 000000000..a9a01789a
--- /dev/null
+++ b/libguile/lightening/tests/remr_u.c
@@ -0,0 +1,56 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_remr_u(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0);
+  ASSERT(f(1, 0x7fffffff) == 1);
+  ASSERT(f(0x80000000, 1) == 0);
+  ASSERT(f(1, 0x80000000) == 1);
+  ASSERT(f(0x7fffffff, 2) == 1);
+  ASSERT(f(2, 0x7fffffff) == 2);
+  ASSERT(f(0x80000000, 2) == 0);
+  ASSERT(f(2, 0x80000000) == 2);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0x7fffffff);
+  ASSERT(f(0x80000000, 0x7fffffff) == 1);
+  ASSERT(f(0, 0x7fffffff) == 0);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x7fffffff);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 1);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+
+#if __WORDSIZE != 32
+  ASSERT(f(0x7fffffffffffffff, 1) == 0);
+  ASSERT(f(1, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0x8000000000000000, 1) == 0);
+  ASSERT(f(1, 0x8000000000000000) == 1);
+  ASSERT(f(0x7fffffffffffffff, 2) == 1);
+  ASSERT(f(2, 0x7fffffffffffffff) == 2);
+  ASSERT(f(0x8000000000000000, 2) == 0);
+  ASSERT(f(2, 0x8000000000000000) == 2);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0x7fffffffffffffff);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0x7fffffffffffffff);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 1);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/rshi.c b/libguile/lightening/tests/rshi.c
new file mode 100644
index 000000000..c536055dc
--- /dev/null
+++ b/libguile/lightening/tests/rshi.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_rshi(j, JIT_R0, JIT_R0, 31);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000) == -1);
+#else
+  ASSERT(f(0x80000000) == 1);
+  ASSERT(f(0x8000000000000000) == 0xffffffff00000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/rshi_u.c b/libguile/lightening/tests/rshi_u.c
new file mode 100644
index 000000000..8f6dbd4e3
--- /dev/null
+++ b/libguile/lightening/tests/rshi_u.c
@@ -0,0 +1,28 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_rshi_u(j, JIT_R0, JIT_R0, 31);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  jit_word_t (*f)(jit_word_t) = jit_end(j, NULL);
+
+#if __WORDSIZE == 32
+  ASSERT(f(0x80000000) == 1);
+#else
+  ASSERT(f(0x80000000) == 1);
+  ASSERT(f(0x8000000000000000) == 0x100000000);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/rshr.c b/libguile/lightening/tests/rshr.c
new file mode 100644
index 000000000..b4b568907
--- /dev/null
+++ b/libguile/lightening/tests/rshr.c
@@ -0,0 +1,63 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_rshr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0xfe, 1) == 0x7f);
+  ASSERT(f(0x1fffc, 2) == 0x7fff);
+  ASSERT(f(0x40000000, 30) == 1);
+  ASSERT(f(0x20000000, 29) == 1);
+  ASSERT(f(0x10000000, 28) == 1);
+  ASSERT(f(0x810000, 16) == 0x81);
+  ASSERT(f(0x20000, 17) == 1);
+  ASSERT(f(0x40000, 18) == 1);
+  ASSERT(f(0x7f8000, 15) == 0xff);
+  ASSERT(f(0x1000000, 24) == 1);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+#if __WORDSIZE == 32
+  ASSERT(f(0xfffffff8, 3) == 0xffffffff);
+  ASSERT(f(0x80000000, 31) == 0xffffffff);
+  ASSERT(f(0xffffff00, 8) == 0xffffffff);
+#else
+  ASSERT(f(0x3fffffff8, 3) == 0x7fffffff);
+  ASSERT(f(0xffffffc080000000, 31) == 0xffffffffffffff81);
+  ASSERT(f(0xffffff00, 8) == 0xffffff);
+  ASSERT(f(0xfe00000000, 33) == 0x7f);
+  ASSERT(f(0x1ffffc00000000, 34) == 0x7ffff);
+  ASSERT(f(0xfffffff800000000, 29) == 0xffffffffffffffc0);
+  ASSERT(f(0x8000000000000000, 63) == 0xffffffffffffffff);
+  ASSERT(f(0x4000000000000000, 62) == 1);
+  ASSERT(f(0x2000000000000000, 61) == 1);
+  ASSERT(f(0x1000000000000000, 60) == 1);
+  ASSERT(f(0x81000000000000, 48) == 0x81);
+  ASSERT(f(0x2000000000000, 49) == 1);
+  ASSERT(f(0x10000000000, 40) == 1);
+  ASSERT(f(0x7f800000000000, 47) == 0xff);
+  ASSERT(f(0x100000000000000, 56) == 1);
+  ASSERT(f(0xffffff0000000000, 40) == 0xffffffffffffffff);
+  ASSERT(f(0xfffffffe00000000, 33) == 0xffffffffffffffff);
+  ASSERT(f(0x8000000000000001, 63) == 0xffffffffffffffff);
+  ASSERT(f(0x1000000000000, 48) == 1);
+  ASSERT(f(0xffff800000000000, 47) == 0xffffffffffffffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/rshr_u.c b/libguile/lightening/tests/rshr_u.c
new file mode 100644
index 000000000..64c59fddb
--- /dev/null
+++ b/libguile/lightening/tests/rshr_u.c
@@ -0,0 +1,62 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_rshr_u(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0xfe, 1) == 0x7f);
+  ASSERT(f(0x1fffc, 2) == 0x7fff);
+  ASSERT(f(0x80000000, 31) == 1);
+  ASSERT(f(0x40000000, 30) == 1);
+  ASSERT(f(0x20000000, 29) == 1);
+  ASSERT(f(0x10000000, 28) == 1);
+  ASSERT(f(0x810000, 16) == 0x81);
+  ASSERT(f(0x20000, 17) == 1);
+  ASSERT(f(0x40000, 18) == 1);
+  ASSERT(f(0x7f8000, 15) == 0xff);
+  ASSERT(f(0x1000000, 24) == 1);
+  ASSERT(f(0xffffff00, 8) == 0xffffff);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+#if __WORDSIZE == 32
+  ASSERT(f(0xfffffff8, 3) == 0x1fffffff);
+#else
+  ASSERT(f(0x3fffffff8, 3) == 0x7fffffff);
+  ASSERT(f(0xffffffc080000000, 31) == 0x1ffffff81);
+  ASSERT(f(0xfe00000000, 33) == 0x7f);
+  ASSERT(f(0x1ffffc00000000, 34) == 0x7ffff);
+  ASSERT(f(0xfffffff800000000, 29) == 0x7ffffffc0);
+  ASSERT(f(0x8000000000000000, 63) == 1);
+  ASSERT(f(0x4000000000000000, 62) == 1);
+  ASSERT(f(0x2000000000000000, 61) == 1);
+  ASSERT(f(0x1000000000000000, 60) == 1);
+  ASSERT(f(0x81000000000000, 48) == 0x81);
+  ASSERT(f(0x2000000000000, 49) == 1);
+  ASSERT(f(0x10000000000, 40) == 1);
+  ASSERT(f(0x7f800000000000, 47) == 0xff);
+  ASSERT(f(0x100000000000000, 56) == 1);
+  ASSERT(f(0xffffff0000000000, 40) == 0xffffff);
+  ASSERT(f(0xfffffffe00000000, 33) == 0x7fffffff);
+  ASSERT(f(0x8000000000000001, 63) == 1);
+  ASSERT(f(0x1000000000000, 48) == 1);
+  ASSERT(f(0xffff800000000000, 47) == 0x1ffff);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sqrtr_d.c b/libguile/lightening/tests/sqrtr_d.c
new file mode 100644
index 000000000..873deb919
--- /dev/null
+++ b/libguile/lightening/tests/sqrtr_d.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_sqrtr_d(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  double (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0.0);
+  ASSERT(f(4.0) == 2.0);
+  ASSERT(f(-4.0) != f(-4.0)); // nan
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sqrtr_f.c b/libguile/lightening/tests/sqrtr_f.c
new file mode 100644
index 000000000..66db83139
--- /dev/null
+++ b/libguile/lightening/tests/sqrtr_f.c
@@ -0,0 +1,25 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_sqrtr_f(j, JIT_F0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  float (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0.0);
+  ASSERT(f(4.0) == 2.0);
+  ASSERT(f(-4.0) != f(-4.0)); // nan
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_c.c b/libguile/lightening/tests/sti_c.c
new file mode 100644
index 000000000..ff6e6d563
--- /dev/null
+++ b/libguile/lightening/tests/sti_c.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static uint8_t data[] = { 0x12, 0x00, 0x34 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_INT8, JIT_R1));
+
+  jit_sti_c(j, &data[1], JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(int8_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34);
+  f(-1);
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0xff);
+  ASSERT(data[2] == 0x34);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_d.c b/libguile/lightening/tests/sti_d.c
new file mode 100644
index 000000000..8a703e6b6
--- /dev/null
+++ b/libguile/lightening/tests/sti_d.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_sti_d(j, &data[1], JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 0.0);
+  ASSERT(data[2] == 0.5);
+  f(42.5);
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 42.5);
+  ASSERT(data[2] == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_f.c b/libguile/lightening/tests/sti_f.c
new file mode 100644
index 000000000..e0271925b
--- /dev/null
+++ b/libguile/lightening/tests/sti_f.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_sti_f(j, &data[1], JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 0.0f);
+  ASSERT(data[2] == 0.5f);
+  f(42.5f);
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 42.5f);
+  ASSERT(data[2] == 0.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_i.c b/libguile/lightening/tests/sti_i.c
new file mode 100644
index 000000000..4a233c657
--- /dev/null
+++ b/libguile/lightening/tests/sti_i.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static uint32_t data[] = { 0x12121212, 0x00000000, 0x34343434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_INT32, JIT_R1));
+
+  jit_sti_i(j, &data[1], JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(int32_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34343434);
+  f(-1);
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0xffffffff);
+  ASSERT(data[2] == 0x34343434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_l.c b/libguile/lightening/tests/sti_l.c
new file mode 100644
index 000000000..fce9180b2
--- /dev/null
+++ b/libguile/lightening/tests/sti_l.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0x1212121212121212, 0, 0x3434343434343434 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_INT64, JIT_R1));
+
+  jit_sti_l(j, &data[1], JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(int64_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x3434343434343434);
+  f(-1);
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0xffffffffffffffff);
+  ASSERT(data[2] == 0x3434343434343434);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/sti_s.c b/libguile/lightening/tests/sti_s.c
new file mode 100644
index 000000000..daab0bda2
--- /dev/null
+++ b/libguile/lightening/tests/sti_s.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static uint16_t data[] = { 0x1212, 0x0000, 0x3434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_INT16, JIT_R1));
+
+  jit_sti_s(j, &data[1], JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(int16_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0);
+  ASSERT(data[2] == 0x3434);
+  f(-1);
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0xffff);
+  ASSERT(data[2] == 0x3434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_c.c b/libguile/lightening/tests/str_c.c
new file mode 100644
index 000000000..b894b8281
--- /dev/null
+++ b/libguile/lightening/tests/str_c.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint8_t data[] = { 0x12, 0x00, 0x34 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT8, JIT_R1));
+
+  jit_str_c(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, int8_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34);
+  f(&data[1], -1);
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0xff);
+  ASSERT(data[2] == 0x34);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_d.c b/libguile/lightening/tests/str_d.c
new file mode 100644
index 000000000..2f992a66a
--- /dev/null
+++ b/libguile/lightening/tests/str_d.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_str_d(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, double) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 0.0);
+  ASSERT(data[2] == 0.5);
+  f(&data[1], 42.5);
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 42.5);
+  ASSERT(data[2] == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_f.c b/libguile/lightening/tests/str_f.c
new file mode 100644
index 000000000..fdad3c244
--- /dev/null
+++ b/libguile/lightening/tests/str_f.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_str_f(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, float) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 0.0f);
+  ASSERT(data[2] == 0.5f);
+  f(&data[1], 42.5f);
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 42.5f);
+  ASSERT(data[2] == 0.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_i.c b/libguile/lightening/tests/str_i.c
new file mode 100644
index 000000000..968f0ce91
--- /dev/null
+++ b/libguile/lightening/tests/str_i.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint32_t data[] = { 0x12121212, 0x00000000, 0x34343434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT32, JIT_R1));
+
+  jit_str_i(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, int32_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34343434);
+  f(&data[1], -1);
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0xffffffff);
+  ASSERT(data[2] == 0x34343434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_l.c b/libguile/lightening/tests/str_l.c
new file mode 100644
index 000000000..450885b39
--- /dev/null
+++ b/libguile/lightening/tests/str_l.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0x1212121212121212, 0, 0x3434343434343434 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT64, JIT_R1));
+
+  jit_str_l(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, int64_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x3434343434343434);
+  f(&data[1], -1);
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0xffffffffffffffff);
+  ASSERT(data[2] == 0x3434343434343434);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/str_s.c b/libguile/lightening/tests/str_s.c
new file mode 100644
index 000000000..3e228edc7
--- /dev/null
+++ b/libguile/lightening/tests/str_s.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint16_t data[] = { 0x1212, 0x0000, 0x3434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT16, JIT_R1));
+
+  jit_str_s(j, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, int16_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0);
+  ASSERT(data[2] == 0x3434);
+  f(&data[1], -1);
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0xffff);
+  ASSERT(data[2] == 0x3434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_c.c b/libguile/lightening/tests/stxi_c.c
new file mode 100644
index 000000000..d76d814f5
--- /dev/null
+++ b/libguile/lightening/tests/stxi_c.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint8_t data[] = { 0x12, 0x00, 0x34 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT8, JIT_R1));
+
+  jit_stxi_c(j, (uintptr_t)data, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, int8_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34);
+  f(1, -1);
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0xff);
+  ASSERT(data[2] == 0x34);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_d.c b/libguile/lightening/tests/stxi_d.c
new file mode 100644
index 000000000..3933c5692
--- /dev/null
+++ b/libguile/lightening/tests/stxi_d.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_stxi_d(j, (uintptr_t)data, JIT_R2, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, double) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 0.0);
+  ASSERT(data[2] == 0.5);
+  f(8, 42.5);
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 42.5);
+  ASSERT(data[2] == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_f.c b/libguile/lightening/tests/stxi_f.c
new file mode 100644
index 000000000..aea6756cc
--- /dev/null
+++ b/libguile/lightening/tests/stxi_f.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_stxi_f(j, (uintptr_t)data, JIT_R2, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, float) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 0.0f);
+  ASSERT(data[2] == 0.5f);
+  f(4, 42.5f);
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 42.5f);
+  ASSERT(data[2] == 0.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_i.c b/libguile/lightening/tests/stxi_i.c
new file mode 100644
index 000000000..79dab03c4
--- /dev/null
+++ b/libguile/lightening/tests/stxi_i.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint32_t data[] = { 0x12121212, 0x00000000, 0x34343434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT32, JIT_R1));
+
+  jit_stxi_i(j, (uintptr_t)data, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, int32_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34343434);
+  f(4, -1);
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0xffffffff);
+  ASSERT(data[2] == 0x34343434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_l.c b/libguile/lightening/tests/stxi_l.c
new file mode 100644
index 000000000..8a6824136
--- /dev/null
+++ b/libguile/lightening/tests/stxi_l.c
@@ -0,0 +1,34 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0x1212121212121212, 0, 0x3434343434343434 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT64, JIT_R1));
+
+  jit_stxi_l(j, (uintptr_t)data, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, int64_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x3434343434343434);
+  f(8, -1);
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0xffffffffffffffff);
+  ASSERT(data[2] == 0x3434343434343434);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxi_s.c b/libguile/lightening/tests/stxi_s.c
new file mode 100644
index 000000000..64bda5d6c
--- /dev/null
+++ b/libguile/lightening/tests/stxi_s.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static uint16_t data[] = { 0x1212, 0x0000, 0x3434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT16, JIT_R1));
+
+  jit_stxi_s(j, (uintptr_t)data, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(jit_word_t, int16_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0);
+  ASSERT(data[2] == 0x3434);
+  f(2, -1);
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0xffff);
+  ASSERT(data[2] == 0x3434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_c.c b/libguile/lightening/tests/stxr_c.c
new file mode 100644
index 000000000..887685542
--- /dev/null
+++ b/libguile/lightening/tests/stxr_c.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static uint8_t data[] = { 0x12, 0x00, 0x34 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT8, JIT_R1));
+
+  jit_stxr_c(j, JIT_R0, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, int8_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34);
+  f(data, 1, -1);
+  ASSERT(data[0] == 0x12);
+  ASSERT(data[1] == 0xff);
+  ASSERT(data[2] == 0x34);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_d.c b/libguile/lightening/tests/stxr_d.c
new file mode 100644
index 000000000..e87688aa1
--- /dev/null
+++ b/libguile/lightening/tests/stxr_d.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static double data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_stxr_d(j, JIT_R0, JIT_R2, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, double) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 0.0);
+  ASSERT(data[2] == 0.5);
+  f(data, 8, 42.5);
+  ASSERT(data[0] == -1.0);
+  ASSERT(data[1] == 42.5);
+  ASSERT(data[2] == 0.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_f.c b/libguile/lightening/tests/stxr_f.c
new file mode 100644
index 000000000..bf0c47625
--- /dev/null
+++ b/libguile/lightening/tests/stxr_f.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static float data[] = { -1.0, 0.0, 0.5 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_stxr_f(j, JIT_R0, JIT_R2, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, float) = jit_end(j, NULL);
+
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 0.0f);
+  ASSERT(data[2] == 0.5f);
+  f(data, 4, 42.5f);
+  ASSERT(data[0] == -1.0f);
+  ASSERT(data[1] == 42.5f);
+  ASSERT(data[2] == 0.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_i.c b/libguile/lightening/tests/stxr_i.c
new file mode 100644
index 000000000..82604627b
--- /dev/null
+++ b/libguile/lightening/tests/stxr_i.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static uint32_t data[] = { 0x12121212, 0x00000000, 0x34343434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT32, JIT_R1));
+
+  jit_stxr_i(j, JIT_R0, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, int32_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x34343434);
+  f(data, 4, -1);
+  ASSERT(data[0] == 0x12121212);
+  ASSERT(data[1] == 0xffffffff);
+  ASSERT(data[2] == 0x34343434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_l.c b/libguile/lightening/tests/stxr_l.c
new file mode 100644
index 000000000..fa6bb1fbb
--- /dev/null
+++ b/libguile/lightening/tests/stxr_l.c
@@ -0,0 +1,35 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  static uint64_t data[] = { 0x1212121212121212, 0, 0x3434343434343434 };
+
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT64, JIT_R1));
+
+  jit_stxr_l(j, JIT_R0, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, int64_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0x00);
+  ASSERT(data[2] == 0x3434343434343434);
+  f(data, 8, -1);
+  ASSERT(data[0] == 0x1212121212121212);
+  ASSERT(data[1] == 0xffffffffffffffff);
+  ASSERT(data[2] == 0x3434343434343434);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/stxr_s.c b/libguile/lightening/tests/stxr_s.c
new file mode 100644
index 000000000..a93ccd9e9
--- /dev/null
+++ b/libguile/lightening/tests/stxr_s.c
@@ -0,0 +1,33 @@
+#include "test.h"
+
+static uint16_t data[] = { 0x1212, 0x0000, 0x3434 };
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_3(j, jit_operand_gpr (JIT_OPERAND_ABI_POINTER, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R2),
+                  jit_operand_gpr (JIT_OPERAND_ABI_INT16, JIT_R1));
+
+  jit_stxr_s(j, JIT_R0, JIT_R2, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_ret(j);
+
+  void (*f)(void*, jit_word_t, int16_t) = jit_end(j, NULL);
+
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0);
+  ASSERT(data[2] == 0x3434);
+  f(data, 2, -1);
+  ASSERT(data[0] == 0x1212);
+  ASSERT(data[1] == 0xffff);
+  ASSERT(data[2] == 0x3434);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/subr.c b/libguile/lightening/tests/subr.c
new file mode 100644
index 000000000..57cf950c7
--- /dev/null
+++ b/libguile/lightening/tests/subr.c
@@ -0,0 +1,26 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_subr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  int (*f)(int, int) = ret;
+  ASSERT(f(42, 69) == -27);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/subr_d.c b/libguile/lightening/tests/subr_d.c
new file mode 100644
index 000000000..bc611c52e
--- /dev/null
+++ b/libguile/lightening/tests/subr_d.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F1));
+
+  jit_subr_d(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_d(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  double (*f)(double, double) = ret;
+  ASSERT(f(42., 69.) == -27.);
+  ASSERT(f(42., 69.5) == -27.5);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/subr_f.c b/libguile/lightening/tests/subr_f.c
new file mode 100644
index 000000000..a7befecfa
--- /dev/null
+++ b/libguile/lightening/tests/subr_f.c
@@ -0,0 +1,27 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0),
+                  jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F1));
+
+  jit_subr_f(j, JIT_F0, JIT_F0, JIT_F1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr_f(j, JIT_F0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  float (*f)(float, float) = ret;
+  ASSERT(f(42.f, 69.f) == -27.f);
+  ASSERT(f(42.0f, 69.5f) == -27.5f);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/subx.c b/libguile/lightening/tests/subx.c
new file mode 100644
index 000000000..b88bcbdb1
--- /dev/null
+++ b/libguile/lightening/tests/subx.c
@@ -0,0 +1,63 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_movi(j, JIT_R2, 0);
+  jit_subcr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_subxi(j, JIT_R2, JIT_R2, 0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R2);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0, 0) == 0);
+
+#if __WORDSIZE == 32
+  /* carry */
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0xffffffff);
+  /* overflow */
+  ASSERT(f(0x80000000, 1) == 0);
+  /* carry */
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  /* overflow */
+  ASSERT(f(0x80000000, 0x7fffffff) == 0);
+  /* carry+overflow */
+  ASSERT(f(1, 0x80000000) == 0xffffffff);
+#else
+  /* carry */
+  ASSERT(f(0x7fffffff, 0xffffffff) == -1);
+  /* nothing */
+  ASSERT(f(0x80000000, 1) == 0);
+  /* carry */
+  ASSERT(f(0x7fffffff, 0x80000000) == -1);
+  /* nothing */
+  ASSERT(f(0x80000000, 0x7fffffff) == 0);
+  /* carry */
+  ASSERT(f(1, 0x80000000) == -1);
+  /* carry */
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == -1);
+  /* overflow */
+  ASSERT(f(0x8000000000000000, 1) == 0);
+  /* carry */
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == -1);
+  /* overflow */
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0);
+  /* carry+overflow */
+  ASSERT(f(1, 0x8000000000000000) == -1);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/test.h b/libguile/lightening/tests/test.h
new file mode 100644
index 000000000..578709f03
--- /dev/null
+++ b/libguile/lightening/tests/test.h
@@ -0,0 +1,42 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/mman.h>
+
+#include <lightening.h>
+
+#define ASSERT(x) \
+  do {                                                                  \
+    if (!(x)) {                                                         \
+      fprintf(stderr, "%s:%d: assertion failed: " #x "\n",              \
+              __FILE__, __LINE__);                                      \
+      abort();                                                          \
+    }                                                                   \
+  } while (0)
+
+static inline int
+main_helper (int argc, char *argv[],
+             void (*run_test)(jit_state_t*, uint8_t*, size_t))
+{
+  ASSERT(init_jit());
+  jit_state_t *j = jit_new_state (NULL, NULL);
+  ASSERT(j);
+
+  const size_t arena_size = 4096;
+  char *arena_base = mmap (NULL, arena_size,
+                           PROT_EXEC | PROT_READ | PROT_WRITE,
+                           MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+
+  if (arena_base == MAP_FAILED)
+    {
+      perror ("allocating JIT code buffer failed");
+      return 1;
+    }
+
+  run_test(j, (uint8_t*)arena_base, arena_size);
+  
+  jit_destroy_state(j);
+
+  munmap(arena_base, arena_size);
+
+  return 0;
+}
diff --git a/libguile/lightening/tests/truncr_d_i.c b/libguile/lightening/tests/truncr_d_i.c
new file mode 100644
index 000000000..b21280f77
--- /dev/null
+++ b/libguile/lightening/tests/truncr_d_i.c
@@ -0,0 +1,30 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_truncr_d_i(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  int (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0);
+  ASSERT(f(-0.0) == 0);
+  ASSERT(f(0.5) == 0);
+  ASSERT(f(-0.5) == 0);
+  ASSERT(f(1.5) == 1);
+  ASSERT(f(-1.5) == -1);
+  ASSERT(f(2.5) == 2);
+  ASSERT(f(-2.5) == -2);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/truncr_d_l.c b/libguile/lightening/tests/truncr_d_l.c
new file mode 100644
index 000000000..189617afb
--- /dev/null
+++ b/libguile/lightening/tests/truncr_d_l.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_DOUBLE, JIT_F0));
+
+  jit_truncr_d_l(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  int64_t (*f)(double) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0);
+  ASSERT(f(-0.0) == 0);
+  ASSERT(f(0.5) == 0);
+  ASSERT(f(-0.5) == 0);
+  ASSERT(f(1.5) == 1);
+  ASSERT(f(-1.5) == -1);
+  ASSERT(f(2.5) == 2);
+  ASSERT(f(-2.5) == -2);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/truncr_f_i.c b/libguile/lightening/tests/truncr_f_i.c
new file mode 100644
index 000000000..3dbf63050
--- /dev/null
+++ b/libguile/lightening/tests/truncr_f_i.c
@@ -0,0 +1,30 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_truncr_f_i(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  int (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0);
+  ASSERT(f(-0.0) == 0);
+  ASSERT(f(0.5) == 0);
+  ASSERT(f(-0.5) == 0);
+  ASSERT(f(1.5) == 1);
+  ASSERT(f(-1.5) == -1);
+  ASSERT(f(2.5) == 2);
+  ASSERT(f(-2.5) == -2);
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/truncr_f_l.c b/libguile/lightening/tests/truncr_f_l.c
new file mode 100644
index 000000000..7369ae3ad
--- /dev/null
+++ b/libguile/lightening/tests/truncr_f_l.c
@@ -0,0 +1,32 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+#if __WORDSIZE > 32
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_fpr (JIT_OPERAND_ABI_FLOAT, JIT_F0));
+
+  jit_truncr_f_l(j, JIT_R0, JIT_F0);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  int64_t (*f)(float) = jit_end(j, NULL);
+
+  ASSERT(f(0.0) == 0);
+  ASSERT(f(-0.0) == 0);
+  ASSERT(f(0.5) == 0);
+  ASSERT(f(-0.5) == 0);
+  ASSERT(f(1.5) == 1);
+  ASSERT(f(-1.5) == -1);
+  ASSERT(f(2.5) == 2);
+  ASSERT(f(-2.5) == -2);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/xori.c b/libguile/lightening/tests/xori.c
new file mode 100644
index 000000000..4bb2ad1d8
--- /dev/null
+++ b/libguile/lightening/tests/xori.c
@@ -0,0 +1,31 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_1(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0));
+
+  jit_xori(j, JIT_R0, JIT_R0, 1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff) == 0x7ffffffe);
+  ASSERT(f(0x80000000) == 0x80000001);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff) == 0x7ffffffffffffffe);
+  ASSERT(f(0x8000000000000000) == 0x8000000000000001);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/lightening/tests/xorr.c b/libguile/lightening/tests/xorr.c
new file mode 100644
index 000000000..dd5a3905c
--- /dev/null
+++ b/libguile/lightening/tests/xorr.c
@@ -0,0 +1,48 @@
+#include "test.h"
+
+static void
+run_test(jit_state_t *j, uint8_t *arena_base, size_t arena_size)
+{
+  jit_begin(j, arena_base, arena_size);
+  size_t align = jit_enter_jit_abi(j, 0, 0, 0);
+  jit_load_args_2(j, jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R0),
+                  jit_operand_gpr (JIT_OPERAND_ABI_WORD, JIT_R1));
+
+  jit_xorr(j, JIT_R0, JIT_R0, JIT_R1);
+  jit_leave_jit_abi(j, 0, 0, align);
+  jit_retr(j, JIT_R0);
+
+  size_t size = 0;
+  void* ret = jit_end(j, &size);
+
+  jit_word_t (*f)(jit_word_t, jit_word_t) = ret;
+
+  ASSERT(f(0x7fffffff, 1) == 0x7ffffffe);
+  ASSERT(f(1, 0x7fffffff) == 0x7ffffffe);
+  ASSERT(f(0x80000000, 1) == 0x80000001);
+  ASSERT(f(1, 0x80000000) == 0x80000001);
+  ASSERT(f(0x7fffffff, 0x80000000) == 0xffffffff);
+  ASSERT(f(0x80000000, 0x7fffffff) == 0xffffffff);
+  ASSERT(f(0x7fffffff, 0xffffffff) == 0x80000000);
+  ASSERT(f(0xffffffff, 0x7fffffff) == 0x80000000);
+  ASSERT(f(0xffffffff, 0xffffffff) == 0);
+  ASSERT(f(0x7fffffff, 0) == 0x7fffffff);
+  ASSERT(f(0, 0x7fffffff) == 0x7fffffff);
+#if __WORDSIZE == 64
+  ASSERT(f(0x7fffffffffffffff, 1) == 0x7ffffffffffffffe);
+  ASSERT(f(1, 0x7fffffffffffffff) == 0x7ffffffffffffffe);
+  ASSERT(f(0x8000000000000000, 1) == 0x8000000000000001);
+  ASSERT(f(1, 0x8000000000000000) == 0x8000000000000001);
+  ASSERT(f(0x7fffffffffffffff, 0x8000000000000000) == 0xffffffffffffffff);
+  ASSERT(f(0x8000000000000000, 0x7fffffffffffffff) == 0xffffffffffffffff);
+  ASSERT(f(0x7fffffffffffffff, 0xffffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0xffffffffffffffff, 0x7fffffffffffffff) == 0x8000000000000000);
+  ASSERT(f(0xffffffffffffffff, 0xffffffffffffffff) == 0);
+#endif
+}
+
+int
+main (int argc, char *argv[])
+{
+  return main_helper(argc, argv, run_test);
+}
diff --git a/libguile/list.c b/libguile/list.c
index 939631531..82aab8a5d 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-1997, 2000, 2001, 2003, 2004, 2008-2011,
- *   2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000-2001,2003-2004,2008-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,16 +23,21 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
+#include <stdarg.h>
 
-#include "libguile/validate.h"
-#include "libguile/list.h"
-#include "libguile/eval.h"
+#include "boolean.h"
+#include "eq.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+
+#include "list.h"
 
-#include <stdarg.h>
 
 
+
 /* creating lists */
 
 #define SCM_I_CONS(cell, x, y)                          \
@@ -1005,11 +1010,5 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
 void
 scm_init_list ()
 {
-#include "libguile/list.x"
+#include "list.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/list.h b/libguile/list.h
index 238926e21..5ebcc8a82 100644
--- a/libguile/list.h
+++ b/libguile/list.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_LIST_H
 #define SCM_LIST_H
 
-/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006,2008,2009
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000-2001,2003-2006,2008-2009,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/error.h"
 
 
 
@@ -71,15 +69,47 @@ SCM_API SCM scm_copy_tree (SCM obj);
 
 
 
+#define SCM_VALIDATE_REST_ARGUMENT(x) \
+  do { \
+    if (SCM_DEBUG_REST_ARGUMENT) { \
+      if (scm_ilength (x) < 0) { \
+        SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL); \
+      } \
+    } \
+  } while (0)
+
+#define SCM_VALIDATE_LIST(pos, lst) \
+  do { \
+    SCM_ASSERT (scm_ilength (lst) >= 0, lst, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_NONEMPTYLIST(pos, lst) \
+  do { \
+    SCM_ASSERT (scm_ilength (lst) > 0, lst, pos, FUNC_NAME); \
+  } while (0)
+
+/* Note: we use (cvar != -1) instead of (cvar >= 0) below
+   in case 'cvar' is of unsigned type. */
+#define SCM_VALIDATE_LIST_COPYLEN(pos, lst, cvar) \
+  do { \
+    cvar = scm_ilength (lst); \
+    SCM_ASSERT (cvar != -1, lst, pos, FUNC_NAME); \
+  } while (0)
+
+/* Note: we use (cvar != -1) instead of (cvar >= 0) below
+   in case 'cvar' is of unsigned type. */
+#define SCM_VALIDATE_NONEMPTYLIST_COPYLEN(pos, lst, cvar) \
+  do { \
+    cvar = scm_ilength (lst); \
+    SCM_ASSERT (cvar != -1, lst, pos, FUNC_NAME); \
+  } while (0)
+
+
+
+
 /* Guile internal functions */
 
 SCM_INTERNAL SCM scm_i_finite_list_copy (SCM /* a list known to be finite */);
 SCM_INTERNAL void scm_init_list (void);
 
 #endif  /* SCM_LIST_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/load.c b/libguile/load.c
index c209812dc..e95c36db1 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1998-2001, 2004, 2006, 2008-2018
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2004,2006,2008-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,29 +24,9 @@
 #  include <config.h>
 #endif
 
+#include <stat-time.h>
 #include <string.h>
 #include <stdio.h>
-
-#include "libguile/_scm.h"
-#include "libguile/alist.h"
-#include "libguile/chars.h"
-#include "libguile/dynwind.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"
-#include "libguile/libpath.h"
-#include "libguile/loader.h"
-#include "libguile/modules.h"
-#include "libguile/read.h"
-#include "libguile/srfi-13.h"
-#include "libguile/strings.h"
-#include "libguile/throw.h"
-
-#include "libguile/validate.h"
-#include "libguile/load.h"
-#include "libguile/fluids.h"
-
-#include "libguile/vm.h" /* for load-compiled/vm */
-
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <unistd.h>
@@ -55,12 +35,40 @@
 #include <pwd.h>
 #endif /* HAVE_PWD_H */
 
+#include "alist.h"
+#include "backtrace.h"
+#include "boolean.h"
+#include "chars.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "eval.h"
+#include "filesys.h"
+#include "fluids.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "libpath.h"
+#include "list.h"
+#include "loader.h"
+#include "modules.h"
+#include "pairs.h"
+#include "procs.h"
+#include "read.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "strports.h"
+#include "symbols.h"
+#include "throw.h"
+#include "variable.h"
+#include "version.h"
+#include "vm.h" /* for load-compiled/vm */
+
+#include "load.h"
+
 #ifndef R_OK
 #define R_OK 4
 #endif
 
-#include <stat-time.h>
-
 
 /* Loading a file, given an absolute filename.  */
 
@@ -1363,7 +1371,7 @@ scm_init_load ()
 
   init_build_info ();
 
-#include "libguile/load.x"
+#include "load.x"
 }
 
 void
@@ -1390,9 +1398,3 @@ scm_init_load_should_auto_compile ()
 }
   
   
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/load.h b/libguile/load.h
index 986948d3f..25f67b87b 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_LOAD_H
 #define SCM_LOAD_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2006,2008-2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 SCM_API SCM scm_parse_path (SCM path, SCM tail);
@@ -47,9 +46,3 @@ SCM_INTERNAL void scm_init_eval_in_scheme (void);
 SCM_INTERNAL char *scm_i_mirror_backslashes (char *path);
 
 #endif  /* SCM_LOAD_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/loader.c b/libguile/loader.c
index 743c8b0cd..bf3f9de36 100644
--- a/libguile/loader.c
+++ b/libguile/loader.c
@@ -1,59 +1,68 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012
- *    2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include <string.h>
+#include <alignof.h>
+#include <assert.h>
+#include <byteswap.h>
+#include <errno.h>
 #include <fcntl.h>
+#include <full-read.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
 #include <unistd.h>
+#include <verify.h>
 
 #ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
 #endif
 
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <assert.h>
-#include <alignof.h>
-#include <byteswap.h>
-#include <verify.h>
-
-#include <full-read.h>
-
-#include "_scm.h"
+#include "boolean.h"
+#include "bytevectors.h"
 #include "elf.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "pairs.h"
 #include "programs.h"
+#include "strings.h"
+#include "threads.h"
+#include "version.h"
+
 #include "loader.h"
 
+
 /* This file contains the loader for Guile's on-disk format: ELF with
    some custom tags in the dynamic segment.  */
 
-#if SIZEOF_SCM_T_BITS == 4
+#if SIZEOF_UINTPTR_T == 4
 #define Elf_Half Elf32_Half
 #define Elf_Word Elf32_Word
 #define Elf_Ehdr Elf32_Ehdr
 #define ELFCLASS ELFCLASS32
 #define Elf_Phdr Elf32_Phdr
 #define Elf_Dyn Elf32_Dyn
-#elif SIZEOF_SCM_T_BITS == 8
+#elif SIZEOF_UINTPTR_T == 8
 #define Elf_Half Elf64_Half
 #define Elf_Word Elf64_Word
 #define Elf_Ehdr Elf64_Ehdr
@@ -87,7 +96,7 @@ static void register_elf (char *data, size_t len, char *frame_maps);
 enum bytecode_kind
   {
     BYTECODE_KIND_NONE,
-    BYTECODE_KIND_GUILE_2_2
+    BYTECODE_KIND_GUILE_3_0
   };
 
 static SCM
@@ -95,9 +104,9 @@ pointer_to_procedure (enum bytecode_kind bytecode_kind, char *ptr)
 {
   switch (bytecode_kind)
     {
-    case BYTECODE_KIND_GUILE_2_2:
+    case BYTECODE_KIND_GUILE_3_0:
       {
-        return scm_i_make_program ((scm_t_uint32 *) ptr);
+        return scm_i_make_program ((uint32_t *) ptr);
       }
     case BYTECODE_KIND_NONE:
     default:
@@ -170,7 +179,7 @@ elf_alignment (const char *data, size_t len)
       Elf_Phdr *phdr;
       const char *phdr_addr = data + header->e_phoff + i * header->e_phentsize;
 
-      if (!IS_ALIGNED ((scm_t_uintptr) phdr_addr, alignof_type (Elf_Phdr)))
+      if (!IS_ALIGNED ((uintptr_t) phdr_addr, alignof_type (Elf_Phdr)))
         return alignment;
       phdr = (Elf_Phdr *) phdr_addr;
 
@@ -212,7 +221,7 @@ alloc_aligned (size_t len, unsigned alignment)
       ret = malloc (len + alignment - 1);
       if (!ret)
         abort ();
-      ret = (char *) ALIGN ((scm_t_uintptr) ret, (scm_t_uintptr) alignment);
+      ret = (char *) ALIGN ((uintptr_t) ret, (uintptr_t) alignment);
     }
 
   return ret;
@@ -256,7 +265,7 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
   Elf_Dyn *dyn = (Elf_Dyn *) dyn_addr;
   size_t i, dyn_size = dyn_phdr->p_memsz / sizeof (Elf_Dyn);
   char *init = 0, *gc_root = 0, *entry = 0, *frame_maps = 0;
-  scm_t_ptrdiff gc_root_size = 0;
+  ptrdiff_t gc_root_size = 0;
   enum bytecode_kind bytecode_kind = BYTECODE_KIND_NONE;
 
   for (i = 0; i < dyn_size; i++)
@@ -290,16 +299,15 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
           if (bytecode_kind != BYTECODE_KIND_NONE)
             return "duplicate DT_GUILE_VM_VERSION";
           {
-            scm_t_uint16 major = dyn[i].d_un.d_val >> 16;
-            scm_t_uint16 minor = dyn[i].d_un.d_val & 0xffff;
+            uint16_t major = dyn[i].d_un.d_val >> 16;
+            uint16_t minor = dyn[i].d_un.d_val & 0xffff;
             switch (major)
               {
-              case 0x0202:
-                bytecode_kind = BYTECODE_KIND_GUILE_2_2;
+              case 0x0300:
+                bytecode_kind = BYTECODE_KIND_GUILE_3_0;
                 if (minor < SCM_OBJCODE_MINIMUM_MINOR_VERSION)
                   return "incompatible bytecode version";
-                /* FIXME for 3.0: Go back to integers.  */
-                if (minor > SCM_OBJCODE_MINOR_VERSION_STRING[0])
+                if (minor > SCM_OBJCODE_MINOR_VERSION)
                   return "incompatible bytecode version";
                 break;
               default:
@@ -320,10 +328,10 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
 
   switch (bytecode_kind)
     {
-    case BYTECODE_KIND_GUILE_2_2:
-      if ((scm_t_uintptr) init % 4)
+    case BYTECODE_KIND_GUILE_3_0:
+      if ((uintptr_t) init % 4)
         return "unaligned DT_INIT";
-      if ((scm_t_uintptr) entry % 4)
+      if ((uintptr_t) entry % 4)
         return "unaligned DT_GUILE_ENTRY";
       break;
     case BYTECODE_KIND_NONE:
@@ -356,6 +364,8 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only)
   SCM init = SCM_BOOL_F, entry = SCM_BOOL_F;
   char *frame_maps = 0;
 
+  errno = 0;
+
   if (len < sizeof *header)
     ABORT ("object file too small");
 
@@ -431,7 +441,7 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only)
      (for the mmap path) that the base _is_ page-aligned, we proceed
      ahead even if the image alignment is greater than the page
      size.  */
-  if (!IS_ALIGNED ((scm_t_uintptr) data, alignment)
+  if (!IS_ALIGNED ((uintptr_t) data, alignment)
       && !IS_ALIGNED (alignment, page_size))
     ABORT ("incorrectly aligned base");
 
@@ -751,27 +761,27 @@ scm_all_mapped_elf_images (void)
 
 struct frame_map_prefix
 {
-  scm_t_uint32 text_offset;
-  scm_t_uint32 maps_offset;
+  uint32_t text_offset;
+  uint32_t maps_offset;
 };
 
 struct frame_map_header
 {
-  scm_t_uint32 addr;
-  scm_t_uint32 map_offset;
+  uint32_t addr;
+  uint32_t map_offset;
 };
 
 verify (sizeof (struct frame_map_prefix) == 8);
 verify (sizeof (struct frame_map_header) == 8);
 
-const scm_t_uint8 *
-scm_find_slot_map_unlocked (const scm_t_uint32 *ip)
+const uint8_t *
+scm_find_slot_map_unlocked (const uint32_t *ip)
 {
   struct mapped_elf_image *image;
   char *base;
   struct frame_map_prefix *prefix;
   struct frame_map_header *headers;
-  scm_t_uintptr addr = (scm_t_uintptr) ip;
+  uintptr_t addr = (uintptr_t) ip;
   size_t start, end;
 
   image = find_mapped_elf_image_unlocked ((char *) ip);
@@ -782,9 +792,9 @@ scm_find_slot_map_unlocked (const scm_t_uint32 *ip)
   prefix = (struct frame_map_prefix *) base;
   headers = (struct frame_map_header *) (base + sizeof (*prefix));
 
-  if (addr < ((scm_t_uintptr) image->start) + prefix->text_offset)
+  if (addr < ((uintptr_t) image->start) + prefix->text_offset)
     return NULL;
-  addr -= ((scm_t_uintptr) image->start) + prefix->text_offset;
+  addr -= ((uintptr_t) image->start) + prefix->text_offset;
 
   start = 0;
   end = (prefix->maps_offset - sizeof (*prefix)) / sizeof (*headers);
@@ -797,7 +807,7 @@ scm_find_slot_map_unlocked (const scm_t_uint32 *ip)
       size_t n = start + (end - start) / 2;
 
       if (addr == headers[n].addr)
-        return (const scm_t_uint8*) (base + headers[n].map_offset);
+        return (const uint8_t*) (base + headers[n].map_offset);
       else if (addr < headers[n].addr)
         end = n;
       else
@@ -825,7 +835,7 @@ void
 scm_init_loader (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/loader.x"
+#include "loader.x"
 #endif
 
   scm_c_define_gsubr ("find-mapped-elf-image", 1, 0, 0,
@@ -833,9 +843,3 @@ scm_init_loader (void)
   scm_c_define_gsubr ("all-mapped-elf-images", 0, 0, 0,
                       (scm_t_subr) scm_all_mapped_elf_images);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/loader.h b/libguile/loader.h
index 5c719cbce..979d56085 100644
--- a/libguile/loader.h
+++ b/libguile/loader.h
@@ -1,39 +1,64 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_LOADER_H_
 #define _SCM_LOADER_H_
 
-#include <libguile.h>
+#include <libguile/scm.h>
+
+#ifdef BUILDING_LIBGUILE
+
+/* The endianness marker in objcode.  */
+#ifdef WORDS_BIGENDIAN
+# define SCM_OBJCODE_ENDIANNESS "BE"
+#else
+# define SCM_OBJCODE_ENDIANNESS "LE"
+#endif
+
+#define _SCM_CPP_STRINGIFY(x)  # x
+#define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)
+
+/* The word size marker in objcode.  */
+#define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)
+
+/* Major and minor versions must be single characters. */
+#define SCM_OBJCODE_MAJOR_VERSION 4
+#define SCM_OBJCODE_MINIMUM_MINOR_VERSION 1
+#define SCM_OBJCODE_MINOR_VERSION 1
+#define SCM_OBJCODE_MAJOR_VERSION_STRING        \
+  SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
+#define SCM_OBJCODE_MINOR_VERSION_STRING        \
+  SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
+#define SCM_OBJCODE_VERSION_STRING                                      \
+  SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
+#define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
+  SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE "-" SCM_OBJCODE_VERSION_STRING
+
+#endif
 
 SCM_API SCM scm_load_thunk_from_file (SCM filename);
 SCM_API SCM scm_load_thunk_from_memory (SCM bv);
 
-SCM_INTERNAL const scm_t_uint8 *
-scm_find_slot_map_unlocked (const scm_t_uint32 *ip);
+SCM_INTERNAL const uint8_t *
+scm_find_slot_map_unlocked (const uint32_t *ip);
 
 SCM_INTERNAL void scm_bootstrap_loader (void);
 SCM_INTERNAL void scm_init_loader (void);
 
 #endif /* _SCM_LOADER_H_ */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/locale-categories.h b/libguile/locale-categories.h
index fb5ac1081..458e862b8 100644
--- a/libguile/locale-categories.h
+++ b/libguile/locale-categories.h
@@ -1,20 +1,21 @@
-/* Copyright (C) 2006, 2008, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2006,2008,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* A list of all available locale categories, not including `ALL'.  */
 
diff --git a/libguile/macros.c b/libguile/macros.c
index 94421c17a..e26ed651c 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2003,2006,2008-2012,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -22,14 +23,19 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/smob.h"
-#include "libguile/validate.h"
-#include "libguile/macros.h"
+#include "boolean.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "ports.h"
+#include "print.h"
+#include "private-options.h"
+#include "procs.h"
+#include "random.h"
+#include "smob.h"
+#include "symbols.h"
+#include "variable.h"
 
-#include "libguile/private-options.h"
+#include "macros.h"
 
 
 static scm_t_bits scm_tc16_macro;
@@ -58,6 +64,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
   return 1;
 }
 
+SCM_SYMBOL (sym_primitive_macro, "primitive-macro");
+
 /* Return a mmacro that is known to be one of guile's built in macros. */
 SCM
 scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn)
@@ -65,7 +73,7 @@ scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn)
   SCM z = scm_words (scm_tc16_macro, 5);
   SCM_SET_SMOB_DATA_N (z, 1, (scm_t_bits)fn);
   SCM_SET_SMOB_OBJECT_N (z, 2, scm_from_utf8_symbol (name));
-  SCM_SET_SMOB_OBJECT_N (z, 3, SCM_BOOL_F);
+  SCM_SET_SMOB_OBJECT_N (z, 3, sym_primitive_macro);
   SCM_SET_SMOB_OBJECT_N (z, 4, SCM_BOOL_F);
   return z;
 }
@@ -213,14 +221,8 @@ scm_init_macros ()
 {
   scm_tc16_macro = scm_make_smob_type ("macro", 0);
   scm_set_smob_print (scm_tc16_macro, macro_print);
-#include "libguile/macros.x"
+#include "macros.x"
 
   syntax_session_id = fresh_syntax_session_id();
   scm_c_define_gsubr ("syntax-session-id", 0, 0, 0, scm_syntax_session_id);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/macros.h b/libguile/macros.h
index de2496e1e..fda7191b8 100644
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_MACROS_H
 #define SCM_MACROS_H
 
-/* Copyright (C) 1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998,2000-2003,2006,2008-2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -45,9 +44,3 @@ SCM_INTERNAL void scm_init_macros (void);
 
 
 #endif  /* SCM_MACROS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/mallocs.c b/libguile/mallocs.c
index 23c1a6079..fefa82925 100644
--- a/libguile/mallocs.c
+++ b/libguile/mallocs.c
@@ -1,22 +1,21 @@
-/* classes: src_files 
- * Copyright (C) 1995,1997,1998,2000,2001, 2006, 2011,
- *   2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2006,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -26,14 +25,12 @@
 #endif
 
 #include <stdlib.h>
+#include <unistd.h>
 
-#include "libguile/_scm.h"
-#include "libguile/ports.h"
-#include "libguile/smob.h"
-
-#include "libguile/mallocs.h"
+#include "ports.h"
+#include "smob.h"
 
-#include <unistd.h>
+#include "mallocs.h"
 
 
 
@@ -68,9 +65,3 @@ scm_init_mallocs ()
   scm_tc16_malloc = scm_make_smob_type ("malloc", 0);
   scm_set_smob_print (scm_tc16_malloc, malloc_print);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/mallocs.h b/libguile/mallocs.h
index 9c797e9f8..beb807380 100644
--- a/libguile/mallocs.h
+++ b/libguile/mallocs.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_MALLOCS_H
 #define SCM_MALLOCS_H
 
-/* Copyright (C) 1995,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,2000,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 SCM_API scm_t_bits scm_tc16_malloc;
@@ -38,9 +37,3 @@ SCM_API SCM scm_malloc_obj (size_t n);
 SCM_INTERNAL void scm_init_mallocs (void);
 
 #endif  /* SCM_MALLOCS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/memmove.c b/libguile/memmove.c
deleted file mode 100644
index a62083f0f..000000000
--- a/libguile/memmove.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/* Wrapper to implement ANSI C's memmove using BSD's bcopy. */
-/* This function is in the public domain.  --Per Bothner. */
-
-
-#include <sys/types.h>
-
-#ifdef __STDC__
-#define PTR void *
-#define CPTR const void *
-PTR memmove (PTR, CPTR, size_t);
-#else
-#define PTR char *
-#define CPTR char *
-PTR memmove ();
-#endif
-
-PTR
-memmove (PTR s1, CPTR s2, size_t n)
-{
-  bcopy (s2, s1, n);
-  return s1;
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 58abeb110..d9e614f62 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -1,22 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,21 +23,32 @@
 #  include <config.h>
 #endif
 
-#include "libguile/__scm.h"
-#include "libguile/_scm.h"
-#include "libguile/continuations.h"
-#include "libguile/eq.h"
-#include "libguile/expand.h"
-#include "libguile/list.h"
-#include "libguile/macros.h"
-#include "libguile/memoize.h"
-#include "libguile/modules.h"
-#include "libguile/srcprop.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/strings.h"
-#include "libguile/throw.h"
-#include "libguile/validate.h"
+#include <string.h>
+#include <stdio.h>
+
+#include "alist.h"
+#include "boolean.h"
+#include "continuations.h"
+#include "dynstack.h"
+#include "eq.h"
+#include "expand.h"
+#include "gsubr.h"
+#include "list.h"
+#include "macros.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "print.h"
+#include "srcprop.h"
+#include "strings.h"
+#include "symbols.h"
+#include "threads.h"
+#include "throw.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "memoize.h"
 
 
 
@@ -88,7 +98,7 @@ do_unwind (void)
 static SCM
 do_push_fluid (SCM fluid, SCM val)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_dynstack_push_fluid (&thread->dynstack, fluid, val,
                            thread->dynamic_state);
   return SCM_UNSPECIFIED;
@@ -97,7 +107,7 @@ do_push_fluid (SCM fluid, SCM val)
 static SCM
 do_pop_fluid (void)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
   return SCM_UNSPECIFIED;
 }
@@ -105,7 +115,7 @@ do_pop_fluid (void)
 static SCM
 do_push_dynamic_state (SCM state)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_dynstack_push_dynamic_state (&thread->dynstack, state,
                                    thread->dynamic_state);
   return SCM_UNSPECIFIED;
@@ -114,7 +124,7 @@ do_push_dynamic_state (SCM state)
 static SCM
 do_pop_dynamic_state (void)
 {
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
   scm_dynstack_unwind_dynamic_state (&thread->dynstack,
                                      thread->dynamic_state);
   return SCM_UNSPECIFIED;
@@ -891,7 +901,7 @@ SCM_DEFINE (scm_sys_resolve_variable, "%resolve-variable", 2, 0, 0,
 void
 scm_init_memoize ()
 {
-#include "libguile/memoize.x"
+#include "memoize.x"
 
   wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind);
   unwind = scm_c_make_gsubr ("unwind", 0, 0, 0, do_unwind);
@@ -904,9 +914,3 @@ scm_init_memoize ()
 
   list_of_guile = scm_list_1 (scm_from_latin1_symbol ("guile"));
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/memoize.h b/libguile/memoize.h
index 23c030674..a68f2b403 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_MEMOIZE_H
 #define SCM_MEMOIZE_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2013,2014
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2002,2004,2008-2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -94,9 +92,3 @@ SCM_INTERNAL void scm_init_memoize (void);
 
 
 #endif  /* SCM_MEMOIZE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/modules.c b/libguile/modules.c
index e4cccd2bc..0e8f083a0 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1998, 2000-2004, 2006-2012, 2018
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998,2000-2004,2006-2012,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,19 +25,25 @@
 
 #include <stdarg.h>
 
-#include "libguile/_scm.h"
-
-#include "libguile/eval.h"
-#include "libguile/smob.h"
-#include "libguile/procprop.h"
-#include "libguile/vectors.h"
-#include "libguile/hashtab.h"
-#include "libguile/struct.h"
-#include "libguile/variable.h"
-#include "libguile/fluids.h"
-#include "libguile/deprecation.h"
+#include "boolean.h"
+#include "deprecation.h"
+#include "eval.h"
+#include "fluids.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "list.h"
+#include "pairs.h"
+#include "procprop.h"
+#include "smob.h"
+#include "struct.h"
+#include "symbols.h"
+#include "threads.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "modules.h"
 
-#include "libguile/modules.h"
 
 int scm_module_system_booted_p = 0;
 
@@ -76,15 +82,21 @@ scm_the_root_module (void)
     return SCM_BOOL_F;
 }
 
+SCM
+scm_i_current_module (scm_thread *thread)
+{
+  if (scm_module_system_booted_p)
+    return scm_i_fluid_ref (thread, the_module);
+  else
+    return SCM_BOOL_F;
+}
+
 SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
 	    (),
 	    "Return the current module.")
 #define FUNC_NAME s_scm_current_module
 {
-  if (scm_module_system_booted_p)
-    return scm_fluid_ref (the_module);
-  else
-    return SCM_BOOL_F;
+  return scm_i_current_module (SCM_I_CURRENT_THREAD);
 }
 #undef FUNC_NAME
 
@@ -178,6 +190,13 @@ scm_resolve_module (SCM name)
 }
 
 SCM
+scm_maybe_resolve_module (SCM name)
+{
+  return scm_call_3 (SCM_VARIABLE_REF (resolve_module_var), name,
+                     k_ensure, SCM_BOOL_F);
+}
+
+SCM
 scm_c_define_module (const char *name,
 		     void (*init)(void *), void *data)
 {
@@ -651,8 +670,7 @@ scm_public_variable (SCM module_name, SCM name)
 {
   SCM mod, iface;
   
-  mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
-                    k_ensure, SCM_BOOL_F);
+  mod = scm_maybe_resolve_module (module_name);
 
   if (scm_is_false (mod))
     scm_misc_error ("public-lookup", "Module named ~s does not exist",
@@ -672,8 +690,7 @@ scm_private_variable (SCM module_name, SCM name)
 {
   SCM mod;
   
-  mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
-                    k_ensure, SCM_BOOL_F);
+  mod = scm_maybe_resolve_module (module_name);
 
   if (scm_is_false (mod))
     scm_misc_error ("private-lookup", "Module named ~s does not exist",
@@ -883,7 +900,7 @@ scm_modules_prehistory ()
 void
 scm_init_modules ()
 {
-#include "libguile/modules.x"
+#include "modules.x"
   module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
 					    SCM_UNDEFINED);
   the_module = scm_make_fluid ();
@@ -893,7 +910,7 @@ static void
 scm_post_boot_init_modules ()
 {
   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
-  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
+  scm_module_tag = SCM_UNPACK (module_type) + scm_tc3_struct;
 
   resolve_module_var = scm_c_lookup ("resolve-module");
   define_module_star_var = scm_c_lookup ("define-module*");
@@ -907,9 +924,3 @@ scm_post_boot_init_modules ()
 
   scm_module_system_booted_p = 1;
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/modules.h b/libguile/modules.h
index 28df6c6ea..34edb328d 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -1,31 +1,29 @@
-/* classes: h_files */
-
 #ifndef SCM_MODULES_H
 #define SCM_MODULES_H
 
-/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008, 2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1998,2000-2003,2006-2008,2011-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/gc.h"
 
-#include "libguile/validate.h"
 
 
 
@@ -67,6 +65,7 @@ SCM_API scm_t_bits scm_module_tag;
 
 
 SCM_API SCM scm_current_module (void);
+SCM_INTERNAL SCM scm_i_current_module (scm_thread *thread);
 SCM_API SCM scm_the_root_module (void);
 SCM_API SCM scm_interaction_environment (void);
 SCM_API SCM scm_set_current_module (SCM module);
@@ -108,6 +107,7 @@ SCM_API SCM scm_c_private_ref (const char *module_name, const char *name);
 
 SCM_API SCM scm_c_resolve_module (const char *name);
 SCM_API SCM scm_resolve_module (SCM name);
+SCM_API SCM scm_maybe_resolve_module (SCM name);
 SCM_API SCM scm_c_define_module (const char *name,
 				 void (*init)(void *), void *data);
 SCM_API void scm_c_use_module (const char *name);
@@ -123,9 +123,3 @@ SCM_INTERNAL void scm_modules_prehistory (void);
 SCM_INTERNAL void scm_init_modules (void);
 
 #endif  /* SCM_MODULES_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/net_db.c b/libguile/net_db.c
index 98c6feddd..dfb61e8d0 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -1,22 +1,22 @@
 /* "net_db.c" network database support
- * Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009,
- *   2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+   Copyright 1995-2001,2006,2009-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -45,15 +45,21 @@
 #include <netinet/in.h>
 #include <arpa/inet.h>
 
-#include "libguile/_scm.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "feature.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "socket.h"
+#include "strings.h"
+#include "symbols.h"
+#include "throw.h"
+#include "vectors.h"
 
-#include "libguile/validate.h"
-#include "libguile/net_db.h"
-#include "libguile/socket.h"
+#include "net_db.h"
 
 
 #if defined (HAVE_H_ERRNO)
@@ -722,11 +728,5 @@ void
 scm_init_net_db ()
 {
   scm_add_feature ("net-db");
-#include "libguile/net_db.x"
+#include "net_db.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/net_db.h b/libguile/net_db.h
index 68b2a8b0c..08b882003 100644
--- a/libguile/net_db.h
+++ b/libguile/net_db.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_NET_DB_H
 #define SCM_NET_DB_H
 
-/* Copyright (C) 1995,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,2000-2001,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -40,9 +39,3 @@ SCM_API SCM scm_gai_strerror (SCM);
 SCM_INTERNAL void scm_init_net_db (void);
 
 #endif  /* SCM_NET_DB_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/null-threads.c b/libguile/null-threads.c
index 28eff2c61..fd9f189b1 100644
--- a/libguile/null-threads.c
+++ b/libguile/null-threads.c
@@ -1,31 +1,31 @@
-/* Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2002,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <stdlib.h>
-#include "libguile/_scm.h"
 
-#if SCM_USE_NULL_THREADS
 
-#include "libguile/null-threads.h"
+#if SCM_USE_NULL_THREADS
+#include "null-threads.h"
 
 static scm_i_pthread_key_t *all_keys = NULL;
 
@@ -64,10 +64,3 @@ scm_i_pthread_key_create (scm_i_pthread_key_t *key,
 }
 
 #endif /* SCM_USE_NULL_THREADS */
-
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/null-threads.h b/libguile/null-threads.h
index dcb14e6a7..a15bd21fb 100644
--- a/libguile/null-threads.h
+++ b/libguile/null-threads.h
@@ -1,25 +1,24 @@
-/* classes: h_files */
-
 #ifndef SCM_NULL_THREADS_H
 #define SCM_NULL_THREADS_H
 
-/* Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2005-2006,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -223,9 +222,3 @@ SCM_API int scm_i_pthread_key_create (scm_i_pthread_key_t *key,
 
 
 #endif  /* SCM_NULL_THREADS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 13223f8cb..d1b463358 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1,24 +1,24 @@
-/* Copyright (C) 1995-2016, 2018, 2019 Free Software Foundation, Inc.
- *
- * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
- * and Bellcore.  See scm_divide.
- *
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2016,2018-2019
+     Free Software Foundation, Inc.
+
+   Portions Copyright 1990-1993 by AT&T Bell Laboratories and Bellcore.
+   See scm_divide.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 /* General assumptions:
@@ -42,35 +42,37 @@
  */
 
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
-#include <verify.h>
 #include <assert.h>
-
 #include <math.h>
+#include <stdarg.h>
 #include <string.h>
 #include <unicase.h>
 #include <unictype.h>
+#include <verify.h>
 
 #if HAVE_COMPLEX_H
 #include <complex.h>
 #endif
 
-#include <stdarg.h>
-
-#include "libguile/_scm.h"
-#include "libguile/feature.h"
-#include "libguile/ports.h"
-#include "libguile/smob.h"
-#include "libguile/strings.h"
-#include "libguile/bdw-gc.h"
-
-#include "libguile/validate.h"
-#include "libguile/numbers.h"
-#include "libguile/deprecation.h"
-
-#include "libguile/eq.h"
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "deprecation.h"
+#include "eq.h"
+#include "feature.h"
+#include "finalizers.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "strings.h"
+#include "values.h"
+
+#include "numbers.h"
 
 /* values per glibc, if not already defined */
 #ifndef M_LOG10E
@@ -1510,7 +1512,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_floor_divide, "floor/", 2, 0, 0,
   SCM q, r;
 
   scm_floor_divide(x, y, &q, &r);
-  return scm_values (scm_list_2 (q, r));
+  return scm_values_2 (q, r);
 }
 #undef FUNC_NAME
 
@@ -2048,7 +2050,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_ceiling_divide, "ceiling/", 2, 0, 0,
   SCM q, r;
 
   scm_ceiling_divide(x, y, &q, &r);
-  return scm_values (scm_list_2 (q, r));
+  return scm_values_2 (q, r);
 }
 #undef FUNC_NAME
 
@@ -2539,7 +2541,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_truncate_divide, "truncate/", 2, 0, 0,
   SCM q, r;
 
   scm_truncate_divide(x, y, &q, &r);
-  return scm_values (scm_list_2 (q, r));
+  return scm_values_2 (q, r);
 }
 #undef FUNC_NAME
 
@@ -3150,7 +3152,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_centered_divide, "centered/", 2, 0, 0,
   SCM q, r;
 
   scm_centered_divide(x, y, &q, &r);
-  return scm_values (scm_list_2 (q, r));
+  return scm_values_2 (q, r);
 }
 #undef FUNC_NAME
 
@@ -3825,7 +3827,7 @@ SCM_PRIMITIVE_GENERIC (scm_i_round_divide, "round/", 2, 0, 0,
   SCM q, r;
 
   scm_round_divide(x, y, &q, &r);
-  return scm_values (scm_list_2 (q, r));
+  return scm_values_2 (q, r);
 }
 #undef FUNC_NAME
 
@@ -5165,6 +5167,8 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
 #undef FUNC_NAME
 
 
+#define MIN(A, B) ((A) <= (B) ? (A) : (B))
+
 SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
             (SCM n, SCM start, SCM end),
 	    "Return the integer composed of the @var{start} (inclusive)\n"
@@ -5193,7 +5197,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
 
       /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to
          SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */
-      in = SCM_SRS (in, min (istart, SCM_I_FIXNUM_BIT-1));
+      in = SCM_SRS (in, MIN (istart, SCM_I_FIXNUM_BIT-1));
 
       if (in < 0 && bits >= SCM_I_FIXNUM_BIT)
 	{
@@ -5208,7 +5212,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
 	}
 
       /* mask down to requisite bits */
-      bits = min (bits, SCM_I_FIXNUM_BIT);
+      bits = MIN (bits, SCM_I_FIXNUM_BIT);
       return SCM_I_MAKINUM (in & ((1L << bits) - 1));
     }
   else if (SCM_BIGP (n))
@@ -5601,12 +5605,12 @@ iflo2str (SCM flt, char *str, int radix)
   return i;
 }
 
-/* convert a scm_t_intmax to a string (unterminated).  returns the number of
+/* convert a intmax_t to a string (unterminated).  returns the number of
    characters in the result. 
    rad is output base
    p is destination: worst case (base 2) is SCM_INTBUFLEN  */
 size_t
-scm_iint2str (scm_t_intmax num, int rad, char *p)
+scm_iint2str (intmax_t num, int rad, char *p)
 {
   if (num < 0)
     {
@@ -5617,16 +5621,16 @@ scm_iint2str (scm_t_intmax num, int rad, char *p)
     return scm_iuint2str (num, rad, p);
 }
 
-/* convert a scm_t_intmax to a string (unterminated).  returns the number of
+/* convert a intmax_t to a string (unterminated).  returns the number of
    characters in the result. 
    rad is output base
    p is destination: worst case (base 2) is SCM_INTBUFLEN  */
 size_t
-scm_iuint2str (scm_t_uintmax num, int rad, char *p)
+scm_iuint2str (uintmax_t num, int rad, char *p)
 {
   size_t j = 1;
   size_t i;
-  scm_t_uintmax n = num;
+  uintmax_t n = num;
 
   if (rad < 2 || rad > 36)
     scm_out_of_range ("scm_iuint2str", scm_from_int (rad));
@@ -5815,10 +5819,10 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT};
 /* Caller is responsible for checking that the return value is in range
    for the given radix, which should be <= 36. */
 static unsigned int
-char_decimal_value (scm_t_uint32 c)
+char_decimal_value (uint32_t c)
 {
-  if (c >= (scm_t_uint32) '0' && c <= (scm_t_uint32) '9')
-    return c - (scm_t_uint32) '0';
+  if (c >= (uint32_t) '0' && c <= (uint32_t) '9')
+    return c - (uint32_t) '0';
   else
     {
       /* uc_decimal_value returns -1 on error. When cast to an unsigned int,
@@ -5831,8 +5835,8 @@ char_decimal_value (scm_t_uint32 c)
       if (d >= 10U)
         {
           c = uc_tolower (c);
-          if (c >= (scm_t_uint32) 'a')
-            d = c - (scm_t_uint32)'a' + 10U;
+          if (c >= (uint32_t) 'a')
+            d = c - (uint32_t)'a' + 10U;
         }
       return d;
     }
@@ -5944,7 +5948,7 @@ mem2decimal_from_point (SCM result, SCM mem,
       while (idx != len)
 	{
 	  scm_t_wchar c = scm_i_string_ref (mem, idx);
-	  if (uc_is_property_decimal_digit ((scm_t_uint32) c))
+	  if (uc_is_property_decimal_digit ((uint32_t) c))
 	    {
 	      if (x == INEXACT)
 		return SCM_BOOL_F;
@@ -6034,7 +6038,7 @@ mem2decimal_from_point (SCM result, SCM mem,
 	  else
 	    sign = 1;
 
-	  if (!uc_is_property_decimal_digit ((scm_t_uint32) c))
+	  if (!uc_is_property_decimal_digit ((uint32_t) c))
 	    return SCM_BOOL_F;
 
 	  idx++;
@@ -6042,7 +6046,7 @@ mem2decimal_from_point (SCM result, SCM mem,
 	  while (idx != len)
 	    {
 	      scm_t_wchar c = scm_i_string_ref (mem, idx);
-	      if (uc_is_property_decimal_digit ((scm_t_uint32) c))
+	      if (uc_is_property_decimal_digit ((uint32_t) c))
 		{
 		  idx++;
 		  if (exponent <= SCM_MAXEXP)
@@ -6134,14 +6138,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
                     idx += 4;
                     if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x),
                                     SCM_INUM0))
-                      {
-#if SCM_ENABLE_DEPRECATED == 1
-                        scm_c_issue_deprecation_warning
-                          ("Non-zero suffixes to `+nan.' are deprecated.  Use `+nan.0'.");
-#else
-                        return SCM_BOOL_F;
-#endif
-                      }
+                      return SCM_BOOL_F;
           
                     *p_idx = idx;
                     return scm_nan ();
@@ -6156,7 +6153,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
 	return SCM_BOOL_F;
       else if (idx + 1 == len)
 	return SCM_BOOL_F;
-      else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref (mem, idx+1)))
+      else if (!uc_is_property_decimal_digit ((uint32_t) scm_i_string_ref (mem, idx+1)))
 	return SCM_BOOL_F;
       else
 	result = mem2decimal_from_point (SCM_INUM0, mem,
@@ -8069,7 +8066,7 @@ scm_product (SCM x, SCM y)
 	{
 	  scm_t_inum yy = SCM_I_INUM (y);
 #if SCM_I_FIXNUM_BIT < 32 && SCM_HAVE_T_INT64
-          scm_t_int64 kk = xx * (scm_t_int64) yy;
+          int64_t kk = xx * (int64_t) yy;
           if (SCM_FIXABLE (kk))
             return SCM_I_MAKINUM (kk);
 #else
@@ -9660,7 +9657,7 @@ scm_is_exact_integer (SCM val)
 }
 
 int
-scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
+scm_is_signed_integer (SCM val, intmax_t min, intmax_t max)
 {
   if (SCM_I_INUMP (val))
     {
@@ -9683,15 +9680,15 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
 	}
       else
 	{
-	  scm_t_uintmax abs_n;
-	  scm_t_intmax n;
+	  uintmax_t abs_n;
+	  intmax_t n;
 	  size_t count;
 
 	  if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) 
-	      > CHAR_BIT*sizeof (scm_t_uintmax))
+	      > CHAR_BIT*sizeof (uintmax_t))
 	    return 0;
 	  
-	  mpz_export (&abs_n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
+	  mpz_export (&abs_n, &count, 1, sizeof (uintmax_t), 0, 0,
 		      SCM_I_BIG_MPZ (val));
 
 	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
@@ -9705,7 +9702,7 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
 	    {
 	      /* Carefully avoid signed integer overflow. */
 	      if (min < 0 && abs_n - 1 <= -(min + 1))
-		n = -1 - (scm_t_intmax)(abs_n - 1);
+		n = -1 - (intmax_t)(abs_n - 1);
 	      else
 		return 0;
 	    }
@@ -9718,12 +9715,12 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
 }
 
 int
-scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max)
+scm_is_unsigned_integer (SCM val, uintmax_t min, uintmax_t max)
 {
   if (SCM_I_INUMP (val))
     {
       scm_t_signed_bits n = SCM_I_INUM (val);
-      return n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max;
+      return n >= 0 && ((uintmax_t)n) >= min && ((uintmax_t)n) <= max;
     }
   else if (SCM_BIGP (val))
     {
@@ -9741,17 +9738,17 @@ scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max)
 	}
       else
 	{
-	  scm_t_uintmax n;
+	  uintmax_t n;
 	  size_t count;
 
 	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0)
 	    return 0;
 
 	  if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
-	      > CHAR_BIT*sizeof (scm_t_uintmax))
+	      > CHAR_BIT*sizeof (uintmax_t))
 	    return 0;
 	  
-	  mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
+	  mpz_export (&n, &count, 1, sizeof (uintmax_t), 0, 0,
 		      SCM_I_BIG_MPZ (val));
 
 	  return n >= min && n <= max;
@@ -9771,93 +9768,93 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
              scm_list_1 (bad_val));
 }
 
-#define TYPE                     scm_t_intmax
+#define TYPE                     intmax_t
 #define TYPE_MIN                 min
 #define TYPE_MAX                 max
 #define SIZEOF_TYPE              0
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_signed_integer (arg, scm_t_intmax min, scm_t_intmax max)
+#define SCM_TO_TYPE_PROTO(arg)   scm_to_signed_integer (arg, intmax_t min, intmax_t max)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_signed_integer (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_uintmax
+#define TYPE                     uintmax_t
 #define TYPE_MIN                 min
 #define TYPE_MAX                 max
 #define SIZEOF_TYPE              0
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_unsigned_integer (arg, scm_t_uintmax min, scm_t_uintmax max)
+#define SCM_TO_TYPE_PROTO(arg)   scm_to_unsigned_integer (arg, uintmax_t min, uintmax_t max)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_unsigned_integer (arg)
-#include "libguile/conv-uinteger.i.c"
+#include "conv-uinteger.i.c"
 
-#define TYPE                     scm_t_int8
-#define TYPE_MIN                 SCM_T_INT8_MIN
-#define TYPE_MAX                 SCM_T_INT8_MAX
+#define TYPE                     int8_t
+#define TYPE_MIN                 INT8_MIN
+#define TYPE_MAX                 INT8_MAX
 #define SIZEOF_TYPE              1
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_int8 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_int8 (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_uint8
+#define TYPE                     uint8_t
 #define TYPE_MIN                 0
-#define TYPE_MAX                 SCM_T_UINT8_MAX
+#define TYPE_MAX                 UINT8_MAX
 #define SIZEOF_TYPE              1
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_uint8 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint8 (arg)
-#include "libguile/conv-uinteger.i.c"
+#include "conv-uinteger.i.c"
 
-#define TYPE                     scm_t_int16
-#define TYPE_MIN                 SCM_T_INT16_MIN
-#define TYPE_MAX                 SCM_T_INT16_MAX
+#define TYPE                     int16_t
+#define TYPE_MIN                 INT16_MIN
+#define TYPE_MAX                 INT16_MAX
 #define SIZEOF_TYPE              2
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_int16 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_int16 (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_uint16
+#define TYPE                     uint16_t
 #define TYPE_MIN                 0
-#define TYPE_MAX                 SCM_T_UINT16_MAX
+#define TYPE_MAX                 UINT16_MAX
 #define SIZEOF_TYPE              2
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_uint16 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint16 (arg)
-#include "libguile/conv-uinteger.i.c"
+#include "conv-uinteger.i.c"
 
-#define TYPE                     scm_t_int32
-#define TYPE_MIN                 SCM_T_INT32_MIN
-#define TYPE_MAX                 SCM_T_INT32_MAX
+#define TYPE                     int32_t
+#define TYPE_MIN                 INT32_MIN
+#define TYPE_MAX                 INT32_MAX
 #define SIZEOF_TYPE              4
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_int32 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_int32 (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_uint32
+#define TYPE                     uint32_t
 #define TYPE_MIN                 0
-#define TYPE_MAX                 SCM_T_UINT32_MAX
+#define TYPE_MAX                 UINT32_MAX
 #define SIZEOF_TYPE              4
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_uint32 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg)
-#include "libguile/conv-uinteger.i.c"
+#include "conv-uinteger.i.c"
 
 #define TYPE                     scm_t_wchar
-#define TYPE_MIN                 (scm_t_int32)-1
-#define TYPE_MAX                 (scm_t_int32)0x10ffff
+#define TYPE_MIN                 (int32_t)-1
+#define TYPE_MAX                 (int32_t)0x10ffff
 #define SIZEOF_TYPE              4
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_wchar (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_wchar (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_int64
-#define TYPE_MIN                 SCM_T_INT64_MIN
-#define TYPE_MAX                 SCM_T_INT64_MAX
+#define TYPE                     int64_t
+#define TYPE_MIN                 INT64_MIN
+#define TYPE_MAX                 INT64_MAX
 #define SIZEOF_TYPE              8
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_int64 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_int64 (arg)
-#include "libguile/conv-integer.i.c"
+#include "conv-integer.i.c"
 
-#define TYPE                     scm_t_uint64
+#define TYPE                     uint64_t
 #define TYPE_MIN                 0
-#define TYPE_MAX                 SCM_T_UINT64_MAX
+#define TYPE_MAX                 UINT64_MAX
 #define SIZEOF_TYPE              8
 #define SCM_TO_TYPE_PROTO(arg)   scm_to_uint64 (arg)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint64 (arg)
-#include "libguile/conv-uinteger.i.c"
+#include "conv-uinteger.i.c"
 
 void
 scm_to_mpz (SCM val, mpz_t rop)
@@ -10146,7 +10143,7 @@ SCM_DEFINE (scm_i_exact_integer_sqrt, "exact-integer-sqrt", 1, 0, 0,
   SCM s, r;
 
   scm_exact_integer_sqrt (k, &s, &r);
-  return scm_values (scm_list_2 (s, r));
+  return scm_values_2 (s, r);
 }
 #undef FUNC_NAME
 
@@ -10427,11 +10424,5 @@ scm_init_numbers ()
                   DBL_MANT_DIG - 1);
   }
 
-#include "libguile/numbers.x"
+#include "numbers.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/numbers.h b/libguile/numbers.h
index d2799b1c6..b472ab8cd 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -1,39 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_NUMBERS_H
 #define SCM_NUMBERS_H
 
-/* Copyright (C) 1995, 1996, 1998, 2000-2006, 2008-2011, 2013, 2014,
- *   2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2006,2008-2011,2013-2014,2016-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
 #include <gmp.h>
 
-#include "libguile/__scm.h"
+#include "libguile/error.h"
+#include "libguile/gc.h"
 #include "libguile/print.h"
 
-#ifndef SCM_T_WCHAR_DEFINED
-typedef scm_t_int32 scm_t_wchar;
-#define SCM_T_WCHAR_DEFINED
-#endif /* SCM_T_WCHAR_DEFINED */
-
 
 
 /* Immediate Numbers, also known as fixnums
@@ -124,11 +118,11 @@ typedef long scm_t_inum;
 
 
 /* SCM_INTBUFLEN is the maximum number of characters neccessary for
- * the printed or scm_string representation of an scm_t_intmax in
+ * the printed or scm_string representation of an intmax_t in
  * radix 2.  The buffer passed to scm_iint2str and scm_iuint2str must
  * be of this size, for example.
  */
-#define SCM_INTBUFLEN (5 + SCM_CHAR_BIT*sizeof(scm_t_intmax))
+#define SCM_INTBUFLEN (5 + SCM_CHAR_BIT*sizeof(intmax_t))
 
 
 
@@ -172,14 +166,18 @@ typedef long scm_t_inum;
 typedef struct scm_t_double
 {
   SCM type;
+#if SCM_SIZEOF_UINTPTR_T != 8
   SCM pad;
+#endif
   double real;
 } scm_t_double;
 
 typedef struct scm_t_complex
 {
   SCM type;
+#if SCM_SIZEOF_UINTPTR_T != 8
   SCM pad;
+#endif
   double real;
   double imag;
 } scm_t_complex;
@@ -247,8 +245,8 @@ SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest);
 SCM_INTERNAL SCM scm_i_logior (SCM x, SCM y, SCM rest);
 SCM_INTERNAL SCM scm_i_logxor (SCM x, SCM y, SCM rest);
 
-SCM_API size_t scm_iint2str (scm_t_intmax num, int rad, char *p);
-SCM_API size_t scm_iuint2str (scm_t_uintmax num, int rad, char *p);
+SCM_API size_t scm_iint2str (intmax_t num, int rad, char *p);
+SCM_API size_t scm_iuint2str (uintmax_t num, int rad, char *p);
 SCM_API SCM scm_number_to_string (SCM x, SCM radix);
 SCM_API int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
 SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
@@ -260,6 +258,7 @@ SCM_API SCM scm_string_to_number (SCM str, SCM radix);
 SCM_API SCM scm_bigequal (SCM x, SCM y);
 SCM_API SCM scm_real_equalp (SCM x, SCM y);
 SCM_API SCM scm_complex_equalp (SCM x, SCM y);
+SCM_INTERNAL int scm_i_heap_numbers_equal_p (SCM x, SCM y);
 SCM_API SCM scm_number_p (SCM x);
 SCM_API SCM scm_complex_p (SCM x);
 SCM_API SCM scm_real_p (SCM x);
@@ -356,46 +355,46 @@ SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port);
 SCM_API int scm_is_integer (SCM val);
 SCM_API int scm_is_exact_integer (SCM val);
 SCM_API int scm_is_signed_integer (SCM val,
-				   scm_t_intmax min, scm_t_intmax max);
+				   intmax_t min, intmax_t max);
 SCM_API int scm_is_unsigned_integer (SCM val,
-				     scm_t_uintmax min, scm_t_uintmax max);
+				     uintmax_t min, uintmax_t max);
 
-SCM_API SCM scm_from_signed_integer (scm_t_intmax val);
-SCM_API SCM scm_from_unsigned_integer (scm_t_uintmax val);
+SCM_API SCM scm_from_signed_integer (intmax_t val);
+SCM_API SCM scm_from_unsigned_integer (uintmax_t val);
 
-SCM_API scm_t_intmax scm_to_signed_integer (SCM val,
-					    scm_t_intmax min,
-					    scm_t_intmax max);
-SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val,
-					       scm_t_uintmax min,
-					       scm_t_uintmax max);
+SCM_API intmax_t scm_to_signed_integer (SCM val,
+					    intmax_t min,
+					    intmax_t max);
+SCM_API uintmax_t scm_to_unsigned_integer (SCM val,
+					       uintmax_t min,
+					       uintmax_t max);
 
-SCM_API scm_t_int8   scm_to_int8     (SCM x);
-SCM_API SCM          scm_from_int8   (scm_t_int8 x);
+SCM_API int8_t   scm_to_int8     (SCM x);
+SCM_API SCM          scm_from_int8   (int8_t x);
 
-SCM_API scm_t_uint8  scm_to_uint8    (SCM x);
-SCM_API SCM          scm_from_uint8  (scm_t_uint8 x);
+SCM_API uint8_t      scm_to_uint8    (SCM x);
+SCM_API SCM          scm_from_uint8  (uint8_t x);
 
-SCM_API scm_t_int16  scm_to_int16    (SCM x);
-SCM_API SCM          scm_from_int16  (scm_t_int16 x);
+SCM_API int16_t      scm_to_int16    (SCM x);
+SCM_API SCM          scm_from_int16  (int16_t x);
 
-SCM_API scm_t_uint16 scm_to_uint16   (SCM x);
-SCM_API SCM          scm_from_uint16 (scm_t_uint16 x);
+SCM_API uint16_t     scm_to_uint16   (SCM x);
+SCM_API SCM          scm_from_uint16 (uint16_t x);
 
-SCM_API scm_t_int32  scm_to_int32    (SCM x);
-SCM_API SCM          scm_from_int32  (scm_t_int32 x);
+SCM_API int32_t      scm_to_int32    (SCM x);
+SCM_API SCM          scm_from_int32  (int32_t x);
 
-SCM_API scm_t_uint32 scm_to_uint32   (SCM x);
-SCM_API SCM          scm_from_uint32 (scm_t_uint32 x);
+SCM_API uint32_t     scm_to_uint32   (SCM x);
+SCM_API SCM          scm_from_uint32 (uint32_t x);
 
 SCM_API scm_t_wchar  scm_to_wchar    (SCM x);
 SCM_API SCM          scm_from_wchar  (scm_t_wchar x);
 
-SCM_API scm_t_int64  scm_to_int64    (SCM x);
-SCM_API SCM          scm_from_int64  (scm_t_int64 x);
+SCM_API int64_t      scm_to_int64    (SCM x);
+SCM_API SCM          scm_from_int64  (int64_t x);
 
-SCM_API scm_t_uint64 scm_to_uint64   (SCM x);
-SCM_API SCM          scm_from_uint64 (scm_t_uint64 x);
+SCM_API uint64_t     scm_to_uint64   (SCM x);
+SCM_API SCM          scm_from_uint64 (uint64_t x);
 
 SCM_API void scm_to_mpz (SCM x, mpz_t rop);
 SCM_API SCM  scm_from_mpz (mpz_t rop);
@@ -495,7 +494,7 @@ SCM_API SCM  scm_from_mpz (mpz_t rop);
 #define scm_to_uintmax   scm_to_uint64
 #define scm_from_uintmax scm_from_uint64
 #else
-#error sizeof(scm_t_intmax) is not 4 or 8.
+#error sizeof(intmax_t) is not 4 or 8.
 #endif
 #endif
 
@@ -535,7 +534,7 @@ SCM_API SCM  scm_from_mpz (mpz_t rop);
 #define scm_to_ptrdiff_t    scm_to_int64
 #define scm_from_ptrdiff_t  scm_from_int64
 #else
-#error sizeof(scm_t_ptrdiff) is not 4 or 8.
+#error sizeof(ptrdiff_t) is not 4 or 8.
 #endif
 #endif
 
@@ -591,10 +590,135 @@ SCM_API int scm_install_gmp_memory_functions;
 
 SCM_INTERNAL void scm_init_numbers (void);
 
-#endif  /* SCM_NUMBERS_H */
+
 
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
+
+#define SCM_NUM2SIZE_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_size_t (arg))
+
+#define SCM_NUM2PTRDIFF(pos, arg) (scm_to_ssize_t (arg))
+
+#define SCM_NUM2PTRDIFF_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_ssize_t (arg))
+
+#define SCM_NUM2SHORT(pos, arg) (scm_to_short (arg))
+
+#define SCM_NUM2SHORT_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_short (arg))
+
+#define SCM_NUM2USHORT(pos, arg) (scm_to_ushort (arg))
+
+#define SCM_NUM2USHORT_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_ushort (arg))
+
+#define SCM_NUM2INT(pos, arg) (scm_to_int (arg))
+
+#define SCM_NUM2INT_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_int (arg))
+
+#define SCM_NUM2UINT(pos, arg) (scm_to_uint (arg))
+
+#define SCM_NUM2UINT_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_uint (arg))
+
+#define SCM_NUM2ULONG(pos, arg) (scm_to_ulong (arg))
+
+#define SCM_NUM2ULONG_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_ulong (arg))
+
+#define SCM_NUM2LONG(pos, arg) (scm_to_long (arg))
+
+#define SCM_NUM2LONG_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_long (arg))
+
+#define SCM_NUM2LONG_LONG(pos, arg) (scm_to_long_long (arg))
+
+#define SCM_NUM2LONG_LONG_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_long_long (arg))
+
+#define SCM_NUM2ULONG_LONG(pos, arg) (scm_to_ulong_long (arg))
+
+#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
+  (SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg))
+
+#define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
+
+#define SCM_NUM2FLOAT(pos, arg) ((float) scm_to_double (arg))
+
+#define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
+
+#define SCM_OUT_OF_RANGE(pos, arg) \
+  do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0)
+
+#define SCM_ASSERT_RANGE(pos, arg, f)					\
+  do { if (SCM_UNLIKELY (!(f)))					\
+         scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); }	\
+  while (0)
+
+#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real")
+
+#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, NUMBERP, "number")
+
+#define SCM_VALIDATE_USHORT_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2USHORT (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_SHORT_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2SHORT (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_UINT_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2UINT (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_INT_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2INT (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_ULONG_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2ULONG (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_LONG_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2LONG (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_SIZE_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2SIZE (pos, k);              \
+  } while (0)
+
+#define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2FLOAT (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_DOUBLE_COPY(pos, k, cvar) \
+  do { \
+    cvar = SCM_NUM2DOUBLE (pos, k); \
+  } while (0)
+
+#define SCM_VALIDATE_DOUBLE_DEF_COPY(pos, k, default, cvar) \
+  do { \
+    if (SCM_UNBNDP (k)) \
+      { \
+        k = scm_make_real (default); \
+        cvar = default; \
+      } \
+    else \
+      { \
+        cvar = SCM_NUM2DOUBLE (pos, k); \
+      } \
+  } while (0)
+
+
+
+
+#endif  /* SCM_NUMBERS_H */
diff --git a/libguile/objprop.c b/libguile/objprop.c
index e9ddbe4d9..0fffec75d 100644
--- a/libguile/objprop.c
+++ b/libguile/objprop.c
@@ -1,33 +1,39 @@
-/*	Copyright (C) 1995,1996, 2000, 2001, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2003,2006,2008-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/hashtab.h"
-#include "libguile/alist.h"
+#include "alist.h"
+#include "async.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "pairs.h"
+#include "weak-table.h"
+
+#include "objprop.h"
+
 
-#include "libguile/objprop.h"
 
 
 /* {Object Properties}
@@ -94,12 +100,6 @@ void
 scm_init_objprop ()
 {
   object_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
-#include "libguile/objprop.x"
+#include "objprop.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/objprop.h b/libguile/objprop.h
index f9a2e945d..a40c9d370 100644
--- a/libguile/objprop.h
+++ b/libguile/objprop.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_OBJPROP_H
 #define SCM_OBJPROP_H
 
-/* Copyright (C) 1995,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -34,9 +33,3 @@ SCM_API SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
 SCM_INTERNAL void scm_init_objprop (void);
 
 #endif  /* SCM_OBJPROP_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/options.c b/libguile/options.c
index 2d7e18f65..8241ad8ec 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -1,31 +1,38 @@
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2006,2008-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/mallocs.h"
-#include "libguile/strings.h"
+#include "boolean.h"
+#include "list.h"
+#include "mallocs.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "strings.h"
+#include "symbols.h"
+
+#include "options.h"
+
 
-#include "libguile/options.h"
 
 
 /* {Run-time options}
@@ -274,11 +281,5 @@ scm_init_opts (SCM (*func) (SCM), scm_t_option options[])
 void
 scm_init_options ()
 {
-#include "libguile/options.x"
+#include "options.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/options.h b/libguile/options.h
index 8ea960b3c..64224b0fc 100644
--- a/libguile/options.h
+++ b/libguile/options.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_OPTIONS_H
 #define SCM_OPTIONS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -47,9 +46,3 @@ SCM_API void scm_init_opts (SCM (*) (SCM), scm_t_option []);
 SCM_INTERNAL void scm_init_options (void);
 
 #endif  /* SCM_OPTIONS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/pairs.c b/libguile/pairs.c
index 92f9cfa38..64222b424 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 2000, 2001, 2004-2006, 2008-2013,
- *   2017, 2018 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2004-2006,2008-2013,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,12 +23,12 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
+#include <verify.h>
 
-#include "libguile/pairs.h"
+#include "boolean.h"
+#include "gsubr.h"
 
-#include "verify.h"
+#include "pairs.h"
 
 
 
@@ -41,7 +41,7 @@
  * which is defined in terms of the SCM_MATCHES_BITS_IN_COMMON macro.
  *
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information.
  */
 verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
         (SCM_ELISP_NIL_BITS, SCM_EOL_BITS));
@@ -49,8 +49,8 @@ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION		\
 
 #if (SCM_DEBUG_PAIR_ACCESSES == 1)
 
-#include "libguile/ports.h"
-#include "libguile/strings.h"
+#include "ports.h"
+#include "strings.h"
 
 void scm_error_pair_access (SCM non_pair)
 {
@@ -120,7 +120,7 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
 
 /* The compiler should unroll this. */
 #define CHASE_PAIRS(tree, FUNC_NAME, pattern)                           \
-  scm_t_uint32 pattern_var = pattern;                                   \
+  uint32_t pattern_var = pattern;                                   \
   do                                                                    \
     {                                                                   \
       if (!scm_is_pair (tree))                                          \
@@ -334,15 +334,9 @@ SCM_DEFINE (scm_caaaar, "caaaar", 1, 0, 0, (SCM x), "")
 void
 scm_init_pairs ()
 {
-#include "libguile/pairs.x"
+#include "pairs.x"
   scm_c_define_gsubr ("cons", 2, 0, 0, scm_cons);
   scm_c_define_gsubr ("car", 1, 0, 0, scm_car);
   scm_c_define_gsubr ("cdr", 1, 0, 0, scm_cdr);
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 121a76518..617b4c229 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -1,40 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_PAIRS_H
 #define SCM_PAIRS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2004,2006,2008-2010,2012,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
 
-#include "libguile/__scm.h"
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-#include "libguile/gc.h"
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#if (SCM_DEBUG_PAIR_ACCESSES == 1)
-# define SCM_VALIDATE_PAIR(cell, expr) \
-    ((!scm_is_pair (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
-#else
-# define SCM_VALIDATE_PAIR(cell, expr) (expr)
-#endif
+#include "libguile/error.h"
+#include "libguile/gc.h"
+#include "libguile/inline.h"
+
+
+
 
 /*
  * Use scm_is_null_and_not_nil if it's important (for correctness)
@@ -51,8 +44,8 @@
 
 /*
  * See the comments preceeding the definitions of SCM_BOOL_F and
- * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on
- * how the following macro works.
+ * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information on how the
+ * following macro works.
  */
 #define scm_is_null_or_nil(x)  \
   (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_EOL))
@@ -111,6 +104,36 @@
 #define SCM_CADDDR(OBJ)		SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
 #define SCM_CDDDDR(OBJ)		SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
 
+
+
+
+#define SCM_VALIDATE_NULL(pos, scm) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_null, "empty list")
+
+#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) \
+  SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "empty list")
+
+#define SCM_VALIDATE_CONS(pos, scm) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair")
+
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+# define SCM_VALIDATE_PAIR(cell, expr) \
+    ((!scm_is_pair (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
+#else
+# define SCM_VALIDATE_PAIR(cell, expr) (expr)
+#endif
+
+#ifdef BUILDING_LIBGUILE
+#define SCM_VALIDATE_MUTABLE_PAIR(pos, scm) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_mutable_pair, "mutable pair")
+#endif /* BUILDING_LIBGUILE */
+
+#define SCM_VALIDATE_NULLORCONS(pos, env) \
+  do { \
+    SCM_ASSERT (scm_is_null (env) || scm_is_pair (env), env, pos, FUNC_NAME); \
+  } while (0)
+
+
 
 
 #if (SCM_DEBUG_PAIR_ACCESSES == 1)
@@ -237,9 +260,3 @@ SCM_API SCM scm_caaaar (SCM x);
 SCM_INTERNAL void scm_init_pairs (void);
 
 #endif  /* SCM_PAIRS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/poll.c b/libguile/poll.c
index a17ca4148..82281fff0 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2010, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,16 +26,23 @@
 #  include <config.h>
 #endif
 
+#include <errno.h>
 #include <poll.h>
 
-#include "libguile/_scm.h"
-#include "libguile/bytevectors.h"
-#include "libguile/error.h"
-#include "libguile/numbers.h"
-#include "libguile/ports-internal.h"
-#include "libguile/validate.h"
+#include "async.h"
+#include "bytevectors.h"
+#include "error.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "numbers.h"
+#include "ports-internal.h"
+#include "syscalls.h"
+#include "vectors.h"
+#include "version.h"
+
+#include "poll.h"
 
-#include "libguile/poll.h"
 
 
 
@@ -219,9 +227,3 @@ scm_register_poll (void)
 			    (scm_t_extension_init_func) scm_init_poll,
 			    NULL);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/poll.h b/libguile/poll.h
index ab3195008..c1b5be81b 100644
--- a/libguile/poll.h
+++ b/libguile/poll.h
@@ -1,38 +1,31 @@
-/* classes: h_files */
-
 #ifndef SCM_POLL_H
 #define SCM_POLL_H
 
-/* Copyright (C) 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
 SCM_INTERNAL void scm_register_poll (void);
 
 #endif  /* SCM_POLL_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index be7ba60f5..4e0a72f95 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -1,32 +1,36 @@
-/*
- * ports-internal.h - internal-only declarations for ports.
- *
- * Copyright (C) 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* ports-internal.h - internal-only declarations for ports.
+
+   Copyright 2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef SCM_PORTS_INTERNAL
 #define SCM_PORTS_INTERNAL
 
 #include <assert.h>
 #include <iconv.h>
+#include <string.h>
 
-#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/list.h"
+#include "libguile/pairs.h"
 #include "libguile/ports.h"
+#include "libguile/vectors.h"
 
 typedef enum scm_t_port_type_flags {
   /* Indicates that the port should be closed if it is garbage collected
@@ -256,22 +260,22 @@ scm_port_buffer_did_put (SCM buf, size_t prev_end, size_t count)
   scm_port_buffer_set_end (buf, SCM_I_MAKINUM (prev_end + count));
 }
 
-static inline const scm_t_uint8 *
+static inline const uint8_t *
 scm_port_buffer_take_pointer (SCM buf, size_t cur)
 {
   signed char *ret = SCM_BYTEVECTOR_CONTENTS (scm_port_buffer_bytevector (buf));
-  return ((scm_t_uint8 *) ret) + cur;
+  return ((uint8_t *) ret) + cur;
 }
 
-static inline scm_t_uint8 *
+static inline uint8_t *
 scm_port_buffer_put_pointer (SCM buf, size_t end)
 {
   signed char *ret = SCM_BYTEVECTOR_CONTENTS (scm_port_buffer_bytevector (buf));
-  return ((scm_t_uint8 *) ret) + end;
+  return ((uint8_t *) ret) + end;
 }
 
 static inline size_t
-scm_port_buffer_take (SCM buf, scm_t_uint8 *dst, size_t count,
+scm_port_buffer_take (SCM buf, uint8_t *dst, size_t count,
                       size_t cur, size_t avail)
 {
   if (avail < count)
@@ -283,7 +287,7 @@ scm_port_buffer_take (SCM buf, scm_t_uint8 *dst, size_t count,
 }
 
 static inline size_t
-scm_port_buffer_put (SCM buf, const scm_t_uint8 *src, size_t count,
+scm_port_buffer_put (SCM buf, const uint8_t *src, size_t count,
                      size_t end, size_t avail)
 {
   if (avail < count)
@@ -295,7 +299,7 @@ scm_port_buffer_put (SCM buf, const scm_t_uint8 *src, size_t count,
 }
 
 static inline void
-scm_port_buffer_putback (SCM buf, const scm_t_uint8 *src, size_t count,
+scm_port_buffer_putback (SCM buf, const uint8_t *src, size_t count,
                          size_t cur)
 {
   assert (count <= cur);
@@ -333,14 +337,14 @@ struct scm_t_port
      a refcount which is positive if close has not yet been called.
      Reading, writing, and the like temporarily increments this
      refcount, provided it was nonzero to start with.  */
-  scm_t_uint32 refcount;
+  uint32_t refcount;
 
   /* True if the port is random access.  Implies that the buffers must
      be flushed before switching between reading and writing, seeking,
      and so on.  */
-  scm_t_uint32 rw_random : 1;
-  scm_t_uint32 at_stream_start_for_bom_read  : 1;
-  scm_t_uint32 at_stream_start_for_bom_write : 1;
+  uint32_t rw_random : 1;
+  uint32_t at_stream_start_for_bom_read  : 1;
+  uint32_t at_stream_start_for_bom_write : 1;
 
   /* Character encoding support.  */
   SCM encoding;  /* A symbol of upper-case ASCII.  */
diff --git a/libguile/ports.c b/libguile/ports.c
index 900de67e3..f64152bf7 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,25 +1,24 @@
-/* Copyright (C) 1995-2001, 2003-2004, 2006-2017, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2003-2004,2006-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-/* Headers.  */
 
 #define _LARGEFILE64_SOURCE      /* ask for stat64 etc */
 
@@ -28,54 +27,62 @@
 #endif
 
 #include <assert.h>
-#include <stdio.h>
+#include <assert.h>
 #include <errno.h>
 #include <fcntl.h>  /* for chsize on mingw */
-#include <assert.h>
 #include <iconv.h>
 #include <poll.h>
-#include <uniconv.h>
-#include <unistr.h>
+#include <stdio.h>
 #include <striconveh.h>
-
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/atomics-internal.h"
-#include "libguile/deprecation.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"  /* direct access for seek and truncate */
-#include "libguile/goops.h"
-#include "libguile/smob.h"
-#include "libguile/chars.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/keywords.h"
-#include "libguile/hashtab.h"
-#include "libguile/strings.h"
-#include "libguile/mallocs.h"
-#include "libguile/validate.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/vectors.h"
-#include "libguile/weak-set.h"
-#include "libguile/fluids.h"
-#include "libguile/eq.h"
-#include "libguile/alist.h"
-
-#ifdef HAVE_STRING_H
 #include <string.h>
-#endif
+#include <uniconv.h>
+#include <unistd.h>
+#include <unistr.h>
 
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
 
-#include <unistd.h>
-
 #ifdef HAVE_SYS_IOCTL_H
 #include <sys/ioctl.h>
 #endif
 
+#include "alist.h"
+#include "async.h"
+#include "atomics-internal.h"
+#include "boolean.h"
+#include "chars.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "eval.h"
+#include "extensions.h"
+#include "finalizers.h"
+#include "fluids.h"
+#include "fports.h"  /* direct access for seek and truncate */
+#include "goops.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "mallocs.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "private-options.h"
+#include "procs.h"
+#include "smob.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "variable.h"
+#include "vectors.h"
+#include "version.h"
+#include "weak-set.h"
+
+#include "ports.h"
+
+
 /* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
    already, but have this code here in case that wasn't so in past versions,
    or perhaps to help other minimal DOS environments.
@@ -142,7 +149,7 @@ release_port (SCM port)
      Otherwise if the refcount is higher we just subtract 1 and we're
      done.  However if the current refcount is 0 then the port has been
      closed or is closing and we just return.  */
-  scm_t_uint32 cur = 1, next = 0;
+  uint32_t cur = 1, next = 0;
   while (!scm_atomic_compare_and_swap_uint32 (&pt->refcount, &cur, next))
     {
       if (cur == 0)
@@ -181,7 +188,7 @@ scm_dynwind_acquire_port (SCM port)
      there is someone else using it; that's fine, we just add our
      refcount.  However if the current refcount is 0 then the port has
      been closed or is closing and we must throw an error.  */
-  scm_t_uint32 cur = 1, next = 2;
+  uint32_t cur = 1, next = 2;
   while (!scm_atomic_compare_and_swap_uint32 (&pt->refcount, &cur, next))
     {
       if (cur == 0)
@@ -1473,7 +1480,7 @@ get_byte_or_eof (SCM port)
       && SCM_LIKELY (cur < SCM_I_INUM (buf_end))
       && SCM_LIKELY (cur < SCM_BYTEVECTOR_LENGTH (buf_bv)))
     {
-      scm_t_uint8 ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
+      uint8_t ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
       scm_port_buffer_set_cur (buf, SCM_I_MAKINUM (cur + 1));
       return ret;
     }
@@ -1482,7 +1489,7 @@ get_byte_or_eof (SCM port)
   buf_bv = scm_port_buffer_bytevector (buf);
   if (avail > 0)
     {
-      scm_t_uint8 ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
+      uint8_t ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
       scm_port_buffer_set_cur (buf, SCM_I_MAKINUM (cur + 1));
       return ret;
     }
@@ -1510,7 +1517,7 @@ peek_byte_or_eof (SCM port, SCM *buf_out, size_t *cur_out)
       && SCM_LIKELY (cur < SCM_I_INUM (buf_end))
       && SCM_LIKELY (cur < SCM_BYTEVECTOR_LENGTH (buf_bv)))
     {
-      scm_t_uint8 ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
+      uint8_t ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
       *buf_out = buf;
       *cur_out = cur;
       return ret;
@@ -1522,7 +1529,7 @@ peek_byte_or_eof (SCM port, SCM *buf_out, size_t *cur_out)
   *cur_out = cur;
   if (avail > 0)
     {
-      scm_t_uint8 ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
+      uint8_t ret = SCM_BYTEVECTOR_CONTENTS (buf_bv)[cur];
       return ret;
     }
 
@@ -1590,7 +1597,7 @@ scm_c_read_bytes (SCM port, SCM dst, size_t start, size_t count)
   size_t to_read = count;
   scm_t_port *pt;
   SCM read_buf;
-  scm_t_uint8 *dst_ptr = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
+  uint8_t *dst_ptr = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
 
   SCM_VALIDATE_OPINPORT (1, port);
 
@@ -1660,7 +1667,7 @@ scm_c_read (SCM port, void *buffer, size_t size)
   size_t copied = 0;
   scm_t_port *pt;
   SCM read_buf;
-  scm_t_uint8 *dst = buffer;
+  uint8_t *dst = buffer;
 
   SCM_VALIDATE_OPINPORT (1, port);
 
@@ -1727,7 +1734,7 @@ update_port_position (SCM position, scm_t_wchar c)
 /* Convert the SIZE-byte UTF-8 sequence in UTF8_BUF to a codepoint.
    UTF8_BUF is assumed to contain a valid UTF-8 sequence.  */
 static scm_t_wchar
-utf8_to_codepoint (const scm_t_uint8 *utf8_buf, size_t size)
+utf8_to_codepoint (const uint8_t *utf8_buf, size_t size)
 {
   scm_t_wchar codepoint;
 
@@ -1778,7 +1785,7 @@ peek_utf8_codepoint (SCM port, SCM *buf_out, size_t *cur_out, size_t *len_out)
   SCM buf;
   size_t cur, avail;
   int first_byte;
-  const scm_t_uint8 *ptr;
+  const uint8_t *ptr;
 
   first_byte = peek_byte_or_eof (port, &buf, &cur);
   if (first_byte == EOF)
@@ -1869,7 +1876,7 @@ SCM_DEFINE (scm_port_decode_char, "port-decode-char", 4, 0, 0,
 #define FUNC_NAME s_scm_port_decode_char
 {
   char *input, *output;
-  scm_t_uint8 utf8_buf[UTF8_BUFFER_SIZE];
+  uint8_t utf8_buf[UTF8_BUFFER_SIZE];
   iconv_t input_cd;
   size_t c_start, c_count;
   size_t input_left, output_left, done;
@@ -2038,7 +2045,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 
 
 void
-scm_unget_bytes (const scm_t_uint8 *buf, size_t len, SCM port)
+scm_unget_bytes (const uint8_t *buf, size_t len, SCM port)
 #define FUNC_NAME "scm_unget_bytes"
 {
   scm_t_port *pt = SCM_PORT (port);
@@ -2062,7 +2069,7 @@ scm_unget_bytes (const scm_t_uint8 *buf, size_t len, SCM port)
         {
           /* But they would fit if we shift the not-yet-read bytes from
              the read_buf right.  Let's do that.  */
-          const scm_t_uint8 *to_shift = scm_port_buffer_take_pointer (read_buf, cur);
+          const uint8_t *to_shift = scm_port_buffer_take_pointer (read_buf, cur);
           scm_port_buffer_reset_end (read_buf);
           scm_port_buffer_putback (read_buf, to_shift, buffered, size);
         }
@@ -2361,7 +2368,7 @@ scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
   SCM read_buf = SCM_PORT (port)->read_buf;
   size_t cur, avail;
   avail = scm_port_buffer_can_take (read_buf, &cur);
-  return scm_port_buffer_take (read_buf, (scm_t_uint8 *) dest, read_len,
+  return scm_port_buffer_take (read_buf, (uint8_t *) dest, read_len,
                                cur, avail);
 }
 
@@ -2392,7 +2399,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 
   if (avail)
     {
-      const scm_t_uint8 *ptr = scm_port_buffer_take_pointer (read_buf, cur);
+      const uint8_t *ptr = scm_port_buffer_take_pointer (read_buf, cur);
       result = scm_from_port_stringn ((const char *) ptr, avail, port);
       scm_port_buffer_did_take (read_buf, cur, avail);
     }
@@ -2462,7 +2469,7 @@ static size_t
 maybe_consume_bom (SCM port, const unsigned char *bom, size_t bom_len)
 {
   SCM read_buf;
-  const scm_t_uint8 *buf;
+  const uint8_t *buf;
   size_t cur, avail;
 
   if (peek_byte_or_eof (port, &read_buf, &cur) != bom[0])
@@ -2672,7 +2679,7 @@ scm_fill_input (SCM port, size_t minimum_size, size_t *cur_out,
     scm_port_buffer_reset (read_buf);
   else
     {
-      const scm_t_uint8 *to_shift;
+      const uint8_t *to_shift;
       to_shift = scm_port_buffer_take_pointer (read_buf, cur);
       scm_port_buffer_reset (read_buf);
       memmove (scm_port_buffer_put_pointer (read_buf, 0), to_shift, buffered);
@@ -2957,7 +2964,7 @@ scm_c_write_bytes (SCM port, SCM src, size_t start, size_t count)
 
       {
         signed char *src_ptr = SCM_BYTEVECTOR_CONTENTS (src) + start;
-        scm_port_buffer_put (write_buf, (scm_t_uint8 *) src_ptr, count,
+        scm_port_buffer_put (write_buf, (uint8_t *) src_ptr, count,
                              end, count);
       }
 
@@ -2989,7 +2996,7 @@ scm_c_write (SCM port, const void *ptr, size_t size)
   SCM write_buf;
   size_t end, avail, written = 0;
   int using_aux_buffer = 0;
-  const scm_t_uint8 *src = ptr;
+  const uint8_t *src = ptr;
 
   SCM_VALIDATE_OPOUTPORT (1, port);
 
@@ -3049,7 +3056,7 @@ scm_c_write (SCM port, const void *ptr, size_t size)
    ASCII (so also valid ISO-8859-1 and UTF-8).  Return the number of
    bytes written.  */
 static size_t
-encode_escape_sequence (scm_t_wchar ch, scm_t_uint8 buf[ESCAPE_BUFFER_SIZE])
+encode_escape_sequence (scm_t_wchar ch, uint8_t buf[ESCAPE_BUFFER_SIZE])
 {
   /* Represent CH using the in-string escape syntax.  */
   static const char hex[] = "0123456789abcdef";
@@ -3106,7 +3113,7 @@ encode_escape_sequence (scm_t_wchar ch, scm_t_uint8 buf[ESCAPE_BUFFER_SIZE])
 void
 scm_c_put_escaped_char (SCM port, scm_t_wchar ch)
 {
-  scm_t_uint8 escape[ESCAPE_BUFFER_SIZE];
+  uint8_t escape[ESCAPE_BUFFER_SIZE];
   size_t len = encode_escape_sequence (ch, escape);
   scm_c_put_latin1_chars (port, escape, len);
 }
@@ -3114,7 +3121,7 @@ scm_c_put_escaped_char (SCM port, scm_t_wchar ch)
 /* Convert CODEPOINT to UTF-8 and store the result in UTF8.  Return the
    number of bytes of the UTF-8-encoded string.  */
 static size_t
-codepoint_to_utf8 (scm_t_uint32 codepoint, scm_t_uint8 utf8[UTF8_BUFFER_SIZE])
+codepoint_to_utf8 (uint32_t codepoint, uint8_t utf8[UTF8_BUFFER_SIZE])
 {
   size_t len;
 
@@ -3149,13 +3156,13 @@ codepoint_to_utf8 (scm_t_uint32 codepoint, scm_t_uint8 utf8[UTF8_BUFFER_SIZE])
 }
 
 static size_t
-try_encode_char_to_iconv_buf (SCM port, SCM buf, scm_t_uint32 ch)
+try_encode_char_to_iconv_buf (SCM port, SCM buf, uint32_t ch)
 {
-  scm_t_uint8 utf8[UTF8_BUFFER_SIZE];
+  uint8_t utf8[UTF8_BUFFER_SIZE];
   size_t utf8_len = codepoint_to_utf8 (ch, utf8);
   size_t end;
   size_t can_put = scm_port_buffer_can_put (buf, &end);
-  scm_t_uint8 *aux = scm_port_buffer_put_pointer (buf, end);
+  uint8_t *aux = scm_port_buffer_put_pointer (buf, end);
   iconv_t output_cd;
   int saved_errno;
 
@@ -3197,7 +3204,7 @@ try_encode_char_to_iconv_buf (SCM port, SCM buf, scm_t_uint32 ch)
 
   if (scm_is_eq (SCM_PORT (port)->conversion_strategy, sym_escape))
     {
-      scm_t_uint8 escape[ESCAPE_BUFFER_SIZE];
+      uint8_t escape[ESCAPE_BUFFER_SIZE];
       input = (char *) escape;
       input_left = encode_escape_sequence (ch, escape);
       scm_port_acquire_iconv_descriptors (port, NULL, &output_cd);
@@ -3208,7 +3215,7 @@ try_encode_char_to_iconv_buf (SCM port, SCM buf, scm_t_uint32 ch)
     }
   else if (scm_is_eq (SCM_PORT (port)->conversion_strategy, sym_substitute))
     {
-      scm_t_uint8 substitute[2] = "?";
+      uint8_t substitute[2] = "?";
       input = (char *) substitute;
       input_left = 1;
       scm_port_acquire_iconv_descriptors (port, NULL, &output_cd);
@@ -3232,7 +3239,7 @@ try_encode_char_to_iconv_buf (SCM port, SCM buf, scm_t_uint32 ch)
 
 static size_t
 encode_latin1_chars_to_latin1_buf (SCM port, SCM buf,
-                                   const scm_t_uint8 *chars, size_t count)
+                                   const uint8_t *chars, size_t count)
 {
   size_t end;
   size_t avail = scm_port_buffer_can_put (buf, &end);
@@ -3241,11 +3248,11 @@ encode_latin1_chars_to_latin1_buf (SCM port, SCM buf,
 
 static size_t
 encode_latin1_chars_to_utf8_buf (SCM port, SCM buf,
-                                 const scm_t_uint8 *chars, size_t count)
+                                 const uint8_t *chars, size_t count)
 {
   size_t end;
   size_t buf_size = scm_port_buffer_can_put (buf, &end);
-  scm_t_uint8 *dst = scm_port_buffer_put_pointer (buf, end);
+  uint8_t *dst = scm_port_buffer_put_pointer (buf, end);
   size_t read, written;
   for (read = 0, written = 0;
        read < count && written + UTF8_BUFFER_SIZE < buf_size;
@@ -3257,7 +3264,7 @@ encode_latin1_chars_to_utf8_buf (SCM port, SCM buf,
 
 static size_t
 encode_latin1_chars_to_iconv_buf (SCM port, SCM buf,
-                                  const scm_t_uint8 *chars, size_t count)
+                                  const uint8_t *chars, size_t count)
 {
   size_t read;
   for (read = 0; read < count; read++)
@@ -3267,7 +3274,7 @@ encode_latin1_chars_to_iconv_buf (SCM port, SCM buf,
 }
 
 static size_t
-encode_latin1_chars (SCM port, SCM buf, const scm_t_uint8 *chars, size_t count)
+encode_latin1_chars (SCM port, SCM buf, const uint8_t *chars, size_t count)
 {
   scm_t_port *pt = SCM_PORT (port);
   SCM position;
@@ -3294,23 +3301,23 @@ encode_latin1_chars (SCM port, SCM buf, const scm_t_uint8 *chars, size_t count)
 
 static size_t
 encode_utf32_chars_to_latin1_buf (SCM port, SCM buf,
-                                  const scm_t_uint32 *chars, size_t count)
+                                  const uint32_t *chars, size_t count)
 {
   scm_t_port *pt = SCM_PORT (port);
   size_t end;
   size_t buf_size = scm_port_buffer_can_put (buf, &end);
-  scm_t_uint8 *dst = scm_port_buffer_put_pointer (buf, end);
+  uint8_t *dst = scm_port_buffer_put_pointer (buf, end);
   size_t read, written;
   for (read = 0, written = 0; read < count && written < buf_size; read++)
     {
-      scm_t_uint32 ch = chars[read];
+      uint32_t ch = chars[read];
       if (ch <= 0xff)
         dst[written++] = ch;
       else if (scm_is_eq (pt->conversion_strategy, sym_substitute))
         dst[written++] = '?';
       else if (scm_is_eq (pt->conversion_strategy, sym_escape))
         {
-          scm_t_uint8 escape[ESCAPE_BUFFER_SIZE];
+          uint8_t escape[ESCAPE_BUFFER_SIZE];
           size_t escape_len = encode_escape_sequence (ch, escape);
           if (escape_len > buf_size - written)
             break;
@@ -3325,12 +3332,12 @@ encode_utf32_chars_to_latin1_buf (SCM port, SCM buf,
 }
 
 static size_t
-encode_utf32_chars_to_utf8_buf (SCM port, SCM buf, const scm_t_uint32 *chars,
+encode_utf32_chars_to_utf8_buf (SCM port, SCM buf, const uint32_t *chars,
                                 size_t count)
 {
   size_t end;
   size_t buf_size = scm_port_buffer_can_put (buf, &end);
-  scm_t_uint8 *dst = scm_port_buffer_put_pointer (buf, end);
+  uint8_t *dst = scm_port_buffer_put_pointer (buf, end);
   size_t read, written;
   for (read = 0, written = 0;
        read < count && written + UTF8_BUFFER_SIZE < buf_size;
@@ -3341,7 +3348,7 @@ encode_utf32_chars_to_utf8_buf (SCM port, SCM buf, const scm_t_uint32 *chars,
 }
 
 static size_t
-encode_utf32_chars_to_iconv_buf (SCM port, SCM buf, const scm_t_uint32 *chars,
+encode_utf32_chars_to_iconv_buf (SCM port, SCM buf, const uint32_t *chars,
                                  size_t count)
 {
   size_t read;
@@ -3352,7 +3359,7 @@ encode_utf32_chars_to_iconv_buf (SCM port, SCM buf, const scm_t_uint32 *chars,
 }
 
 static size_t
-encode_utf32_chars (SCM port, SCM buf, const scm_t_uint32 *chars, size_t count)
+encode_utf32_chars (SCM port, SCM buf, const uint32_t *chars, size_t count)
 {
   scm_t_port *pt = SCM_PORT (port);
   SCM position;
@@ -3387,14 +3394,14 @@ port_encode_chars (SCM port, SCM buf, SCM str, size_t start, size_t count)
     {
       const char *chars = scm_i_string_chars (str);
       return encode_latin1_chars (port, buf,
-                                  ((const scm_t_uint8 *) chars) + start,
+                                  ((const uint8_t *) chars) + start,
                                   count);
     }
   else
     {
       const scm_t_wchar *chars = scm_i_string_wide_chars (str);
       return encode_utf32_chars (port, buf,
-                                 ((const scm_t_uint32 *) chars) + start,
+                                 ((const uint32_t *) chars) + start,
                                  count);
     }
 }
@@ -3428,7 +3435,7 @@ SCM_DEFINE (scm_port_encode_char, "port-encode-char", 3, 0, 0,
             "")
 #define FUNC_NAME s_scm_port_encode_char
 {
-  scm_t_uint32 codepoint;
+  uint32_t codepoint;
 
   SCM_VALIDATE_OPOUTPORT (1, port);
   SCM_VALIDATE_VECTOR (2, buf);
@@ -3442,7 +3449,7 @@ SCM_DEFINE (scm_port_encode_char, "port-encode-char", 3, 0, 0,
 #undef FUNC_NAME
 
 void
-scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *chars, size_t len)
+scm_c_put_latin1_chars (SCM port, const uint8_t *chars, size_t len)
 {
   SCM aux_buf = scm_port_auxiliary_write_buffer (port);
   SCM aux_bv = scm_port_buffer_bytevector (aux_buf);
@@ -3469,7 +3476,7 @@ scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *chars, size_t len)
 }
 
 void
-scm_c_put_utf32_chars (SCM port, const scm_t_uint32 *chars, size_t len)
+scm_c_put_utf32_chars (SCM port, const uint32_t *chars, size_t len)
 {
   SCM aux_buf = scm_port_auxiliary_write_buffer (port);
   SCM aux_bv = scm_port_buffer_bytevector (aux_buf);
@@ -3500,12 +3507,12 @@ scm_c_put_char (SCM port, scm_t_wchar ch)
 {
   if (ch <= 0xff)
     {
-      scm_t_uint8 narrow_ch = ch;
+      uint8_t narrow_ch = ch;
       scm_c_put_latin1_chars (port, &narrow_ch, 1);
     }
   else
     {
-      scm_t_uint32 wide_ch = ch;
+      uint32_t wide_ch = ch;
       scm_c_put_utf32_chars (port, &wide_ch, 1);
     }
 }
@@ -3529,7 +3536,7 @@ scm_c_can_put_char (SCM port, scm_t_wchar ch)
 
   {
     SCM bv = scm_port_buffer_bytevector (scm_port_auxiliary_write_buffer (port));
-    scm_t_uint8 buf[UTF8_BUFFER_SIZE];
+    uint8_t buf[UTF8_BUFFER_SIZE];
     char *input = (char *) buf;
     size_t input_len;
     char *output = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
@@ -3555,12 +3562,12 @@ scm_c_put_string (SCM port, SCM string, size_t start, size_t count)
   if (scm_i_is_narrow_string (string))
     {
       const char *ptr = scm_i_string_chars (string);
-      scm_c_put_latin1_chars (port, ((const scm_t_uint8 *) ptr) + start, count);
+      scm_c_put_latin1_chars (port, ((const uint8_t *) ptr) + start, count);
     }
   else
     {
       const scm_t_wchar *ptr = scm_i_string_wide_chars (string);
-      scm_c_put_utf32_chars (port, ((const scm_t_uint32 *) ptr) + start, count);
+      scm_c_put_utf32_chars (port, ((const uint32_t *) ptr) + start, count);
     }
 }
 
@@ -3609,14 +3616,14 @@ void
 scm_putc (char c, SCM port)
 {
   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
-  scm_c_put_char (port, (scm_t_uint8) c);
+  scm_c_put_char (port, (uint8_t) c);
 }
 
 void
 scm_puts (const char *s, SCM port)
 {
   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
-  scm_c_put_latin1_chars (port, (const scm_t_uint8 *) s, strlen (s));
+  scm_c_put_latin1_chars (port, (const uint8_t *) s, strlen (s));
 }
 
 /* scm_lfwrite
@@ -3626,7 +3633,7 @@ scm_puts (const char *s, SCM port)
 void
 scm_lfwrite (const char *ptr, size_t size, SCM port)
 {
-  scm_c_put_latin1_chars (port, (const scm_t_uint8 *) ptr, size);
+  scm_c_put_latin1_chars (port, (const uint8_t *) ptr, size);
 }
 
 /* Write STR to PORT from START inclusive to END exclusive.  */
@@ -4142,7 +4149,7 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
 static void
 scm_init_ice_9_ports (void)
 {
-#include "libguile/ports.x"
+#include "ports.x"
 
   scm_c_define ("the-eof-object", SCM_EOF_VAL);
 
@@ -4228,9 +4235,3 @@ scm_init_ports (void)
   scm_c_define_gsubr (s_scm_current_warning_port, 0, 0, 0,
                       (scm_t_subr) scm_current_warning_port);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/ports.h b/libguile/ports.h
index d131db5be..44ef29d87 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -1,43 +1,31 @@
-/* classes: h_files */
-
 #ifndef SCM_PORTS_H
 #define SCM_PORTS_H
 
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- *   2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2003-2004,2006,2008-2014,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
 
-#include "libguile/__scm.h"
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-#include "libguile/bytevectors.h"
 #include "libguile/gc.h"
-#include "libguile/tags.h"
 #include "libguile/error.h"
 #include "libguile/print.h"
-#include "libguile/struct.h"
-#include "libguile/threads.h"
 #include "libguile/strings.h"
-#include "libguile/vectors.h"
 
 
 
@@ -87,6 +75,30 @@ typedef struct scm_t_port scm_t_port;
 #define SCM_PORT_TYPE(port) ((scm_t_port_type *) SCM_CELL_WORD_3 (port))
 
 
+#define SCM_VALIDATE_PORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port")
+
+#define SCM_VALIDATE_INPUT_PORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port")
+
+#define SCM_VALIDATE_OUTPUT_PORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port")
+
+#define SCM_VALIDATE_OPINPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port")
+
+#define SCM_VALIDATE_OPENPORT(pos, port) \
+  do { \
+    SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \
+                port, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_OPPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port")
+
+#define SCM_VALIDATE_OPOUTPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port")
+
 
 
 /* Port types, and their vtables.  */
@@ -220,9 +232,9 @@ SCM_INTERNAL SCM scm_port_auxiliary_write_buffer (SCM port);
 /* Output.  */
 SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
 SCM_API void scm_c_write_bytes (SCM port, SCM src, size_t start, size_t count);
-SCM_API void scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *buf,
+SCM_API void scm_c_put_latin1_chars (SCM port, const uint8_t *buf,
                                      size_t len);
-SCM_API void scm_c_put_utf32_chars (SCM port, const scm_t_uint32 *buf,
+SCM_API void scm_c_put_utf32_chars (SCM port, const uint32_t *buf,
                                     size_t len);
 SCM_API void scm_c_put_string (SCM port, SCM str, size_t start, size_t count);
 SCM_API SCM scm_put_string (SCM port, SCM str, SCM start, SCM count);
@@ -269,9 +281,3 @@ SCM_INTERNAL void scm_init_ports (void);
 
 
 #endif  /* SCM_PORTS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/posix-w32.c b/libguile/posix-w32.c
index 1f00ec168..e4a03eb6a 100644
--- a/libguile/posix-w32.c
+++ b/libguile/posix-w32.c
@@ -1,27 +1,26 @@
-/* Copyright (C) 2001, 2006, 2008, 2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2008,2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/__scm.h"
-
 # define WIN32_LEAN_AND_MEAN
 #include <windows.h>
 #include <c-strcase.h>
@@ -34,9 +33,10 @@
 #include <io.h>
 #include <fcntl.h>
 
+#include "gc.h"        /* for scm_*alloc, scm_strdup */
+#include "threads.h"   /* for scm_i_scm_pthread_mutex_lock */
+
 #include "posix-w32.h"
-#include "libguile/gc.h"        /* for scm_*alloc, scm_strdup */
-#include "libguile/threads.h"   /* for scm_i_scm_pthread_mutex_lock */
 
 /*
  * Get name and information about current kernel.
diff --git a/libguile/posix-w32.h b/libguile/posix-w32.h
index f11a25e49..8fe4f1c65 100644
--- a/libguile/posix-w32.h
+++ b/libguile/posix-w32.h
@@ -1,25 +1,24 @@
-/* classes: h_files */
-
 #ifndef SCM_POSIX_W32_H
 #define SCM_POSIX_W32_H
 
-/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #include <string.h>
 
diff --git a/libguile/posix.c b/libguile/posix.c
index 7ede7b756..728b18b67 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995-2014, 2016-2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2014,2016-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -22,18 +23,20 @@
 #  include <config.h>
 #endif
 
-#include <stdlib.h>
-#include <stdio.h>
 #include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
 #include <uniconv.h>
+#include <unistd.h>
 
 #ifdef HAVE_SCHED_H
 # include <sched.h>
 #endif
 
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
 #ifdef TIME_WITH_SYS_TIME
 # include <sys/time.h>
 # include <time.h>
@@ -45,44 +48,47 @@
 # endif
 #endif
 
-#include <unistd.h>
-
 #ifdef LIBC_H_WITH_UNISTD_H
-#include <libc.h>
+# include <libc.h>
 #endif
 
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-
 #ifdef HAVE_PWD_H
-#include <pwd.h>
+# include <pwd.h>
 #endif
 #ifdef HAVE_IO_H
-#include <io.h>
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/fports.h"
-#include "libguile/scmsigs.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
-#include "libguile/vectors.h"
-#include "libguile/values.h"
-
-#include "libguile/validate.h"
-#include "libguile/posix.h"
-#include "libguile/gettext.h"
-#include "libguile/threads.h"
-
+# include <io.h>
+#endif
 
 #ifdef __MINGW32__
 # include "posix-w32.h"
 #endif
 
+#include "async.h"
+#include "bitvectors.h"
+#include "dynwind.h"
+#include "extensions.h"
+#include "feature.h"
+#include "finalizers.h"
+#include "fports.h"
+#include "gettext.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "scmsigs.h"
+#include "srfi-13.h"
+#include "srfi-14.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "threads.h"
+#include "values.h"
+#include "vectors.h"
+#include "version.h"
+
+#include "posix.h"
+
 #if HAVE_SYS_WAIT_H
 # include <sys/wait.h>
 #endif
@@ -594,10 +600,10 @@ SCM_DEFINE (scm_getrlimit, "getrlimit", 1, 0, 0,
   if (getrlimit (iresource, &lim) != 0)
     scm_syserror (FUNC_NAME);
 
-  return scm_values (scm_list_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F
-                                 : scm_from_long (lim.rlim_cur),
-                                 (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F
-                                 : scm_from_long (lim.rlim_max)));
+  return scm_values_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F
+                       : scm_from_long (lim.rlim_cur),
+                       (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F
+                       : scm_from_long (lim.rlim_max));
 }
 #undef FUNC_NAME
 
@@ -1430,9 +1436,7 @@ scm_open_process (SCM mode, SCM prog, SCM args)
                                        SCM_FPORT_OPTION_NOT_SEEKABLE);
     }
 
-  return scm_values (scm_list_3 (read_port,
-                                 write_port,
-                                 scm_from_int (pid)));
+  return scm_values_3 (read_port, write_port, scm_from_int (pid));
 }
 #undef FUNC_NAME
 
@@ -1488,11 +1492,11 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
   scm_dynwind_begin (0);
   /* Make sure the child can't kill us (as per normal system call).  */
   scm_dynwind_sigaction (SIGINT,
-                         scm_from_uintptr_t ((scm_t_uintptr) SIG_IGN),
+                         scm_from_uintptr_t ((uintptr_t) SIG_IGN),
                          SCM_UNDEFINED);
 #ifdef SIGQUIT
   scm_dynwind_sigaction (SIGQUIT,
-                         scm_from_uintptr_t ((scm_t_uintptr) SIG_IGN),
+                         scm_from_uintptr_t ((uintptr_t) SIG_IGN),
                          SCM_UNDEFINED);
 #endif
 
@@ -2131,7 +2135,7 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
 {
   cpu_set_t cs;
   scm_t_array_handle handle;
-  const scm_t_uint32 *c_mask;
+  const uint32_t *c_mask;
   size_t len, off, cpu;
   ssize_t inc;
   int err;
@@ -2447,8 +2451,8 @@ scm_init_posix ()
   scm_c_define ("AT_EMPTY_PATH", scm_from_int (AT_EMPTY_PATH));
 #endif
 
-#include "libguile/cpp-SIG.c"
-#include "libguile/posix.x"
+#include "cpp-SIG.c"
+#include "posix.x"
 
 #ifdef HAVE_FORK
   scm_add_feature ("fork");
@@ -2461,9 +2465,3 @@ scm_init_posix ()
 			    NULL);
 #endif /* HAVE_START_CHILD */
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/posix.h b/libguile/posix.h
index 078edf5eb..1d2e1835e 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -1,30 +1,27 @@
-/* classes: h_files */
-
 #ifndef SCM_POSIX_H
 #define SCM_POSIX_H
 
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2006, 2008,
- *   2009, 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/threads.h"
 
 
@@ -98,9 +95,3 @@ SCM_INTERNAL void scm_init_posix (void);
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex;
 
 #endif  /* SCM_POSIX_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/print.c b/libguile/print.c
index 722caf593..b10f0f8a8 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995-2004, 2006, 2008-2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2004,2006,2008-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -29,31 +30,48 @@
 #include <uniconv.h>
 #include <unictype.h>
 
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/continuations.h"
-#include "libguile/smob.h"
-#include "libguile/control.h"
-#include "libguile/eval.h"
-#include "libguile/macros.h"
-#include "libguile/procprop.h"
-#include "libguile/read.h"
-#include "libguile/programs.h"
-#include "libguile/alist.h"
-#include "libguile/struct.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/strings.h"
-#include "libguile/strports.h"
-#include "libguile/syntax.h"
-#include "libguile/vectors.h"
-#include "libguile/numbers.h"
-#include "libguile/vm.h"
-
-#include "libguile/validate.h"
-#include "libguile/print.h"
-
-#include "libguile/private-options.h"
+#include "alist.h"
+#include "arrays.h"
+#include "atomic.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "chars.h"
+#include "continuations.h"
+#include "control.h"
+#include "eval.h"
+#include "fluids.h"
+#include "foreign.h"
+#include "frames.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "macros.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "private-options.h"
+#include "procprop.h"
+#include "programs.h"
+#include "read.h"
+#include "smob.h"
+#include "strings.h"
+#include "strports.h"
+#include "struct.h"
+#include "symbols.h"
+#include "syntax.h"
+#include "threads.h"
+#include "values.h"
+#include "variable.h"
+#include "vectors.h"
+#include "vm.h"
+#include "weak-set.h"
+#include "weak-table.h"
+#include "weak-vector.h"
+
+#include "print.h"
+
 
 
 
@@ -69,7 +87,7 @@ static void write_character (scm_t_wchar, SCM);
  * This table must agree with the declarations in scm.h: {Immediate Symbols}.
  */
 
-/* This table must agree with the list of flags in tags.h.  */
+/* This table must agree with the list of flags in scm.h.  */
 static const char *iflagnames[] =
 {
   "#f",
@@ -251,8 +269,8 @@ scm_i_port_with_print_state (SCM port, SCM print_state)
     }
   else
     port = SCM_COERCE_OUTPORT (port);
-  SCM_RETURN_NEWSMOB (scm_tc16_port_with_ps,
-		      SCM_UNPACK (scm_cons (port, print_state)));
+  return scm_new_double_smob (scm_tc16_port_with_ps,
+                              SCM_UNPACK (port), SCM_UNPACK (print_state), 0);
 }
 
 static void
@@ -422,12 +440,12 @@ print_normal_symbol (SCM sym, SCM port)
   if (scm_i_is_narrow_symbol (sym))
     {
       const char *ptr = scm_i_symbol_chars (sym);
-      scm_c_put_latin1_chars (port, (const scm_t_uint8 *) ptr, len);
+      scm_c_put_latin1_chars (port, (const uint8_t *) ptr, len);
     }
   else
     {
       const scm_t_wchar *ptr = scm_i_symbol_wide_chars (sym);
-      scm_c_put_utf32_chars (port, (const scm_t_uint32 *) ptr, len);
+      scm_c_put_utf32_chars (port, (const uint32_t *) ptr, len);
     }
 }
 
@@ -688,6 +706,12 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_variable:
 	  scm_i_variable_print (exp, port, pstate);
 	  break;
+        case scm_tc7_values:
+          scm_puts ("#<values (", port);
+          print_vector_or_weak_vector (exp, scm_i_nvalues (exp),
+                                       scm_c_value_ref, port, pstate);
+          scm_puts (">", port);
+          break;
 	case scm_tc7_program:
 	  scm_i_program_print (exp, port, pstate);
 	  break;
@@ -833,7 +857,7 @@ write_string (const void *str, int narrow_p, size_t len, SCM port)
 {
   size_t i;
 
-  scm_c_put_char (port, (scm_t_uint8) '"');
+  scm_c_put_char (port, (uint8_t) '"');
 
   for (i = 0; i < len; ++i)
     {
@@ -847,11 +871,11 @@ write_string (const void *str, int narrow_p, size_t len, SCM port)
          representable in PORT's encoding.  If CH needs to be escaped,
          it is escaped using the in-string escape syntax.  */
       if (ch == '"')
-        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\\"", 2);
+        scm_c_put_latin1_chars (port, (const uint8_t *) "\\\"", 2);
       else if (ch == '\\')
-        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\\\", 2);
+        scm_c_put_latin1_chars (port, (const uint8_t *) "\\\\", 2);
       else if (ch == '\n' && SCM_PRINT_ESCAPE_NEWLINES_P)
-        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\n", 2);
+        scm_c_put_latin1_chars (port, (const uint8_t *) "\\n", 2);
       else if (ch == ' ' || ch == '\n'
                || (uc_is_general_category_withtable (ch,
                                                      UC_CATEGORY_MASK_L |
@@ -865,7 +889,7 @@ write_string (const void *str, int narrow_p, size_t len, SCM port)
         scm_c_put_escaped_char (port, ch);
     }
 
-  scm_c_put_char (port, (scm_t_uint8) '"');
+  scm_c_put_char (port, (uint8_t) '"');
 }
 
 /* Write CH to PORT, escaping it if it's non-graphic or not
@@ -918,14 +942,14 @@ write_character (scm_t_wchar ch, SCM port)
  */
 
 void 
-scm_intprint (scm_t_intmax n, int radix, SCM port)
+scm_intprint (intmax_t n, int radix, SCM port)
 {
   char num_buf[SCM_INTBUFLEN];
   scm_lfwrite (num_buf, scm_iint2str (n, radix, num_buf), port);
 }
 
 void 
-scm_uintprint (scm_t_uintmax n, int radix, SCM port)
+scm_uintprint (uintmax_t n, int radix, SCM port)
 {
   char num_buf[SCM_INTBUFLEN];
   scm_lfwrite (num_buf, scm_iuint2str (n, radix, num_buf), port);
@@ -1298,7 +1322,7 @@ scm_init_print ()
   scm_tc16_port_with_ps = scm_make_smob_type (0, 0);
   scm_set_smob_print (scm_tc16_port_with_ps, port_with_ps_print);
 
-#include "libguile/print.x"
+#include "print.x"
 
   scm_init_opts (scm_print_options, scm_print_opts);
   scm_print_opts[SCM_PRINT_HIGHLIGHT_PREFIX_I].val =
@@ -1307,9 +1331,3 @@ scm_init_print ()
     SCM_UNPACK (scm_from_utf8_string ("}"));
   scm_print_opts[SCM_PRINT_KEYWORD_STYLE_I].val = SCM_UNPACK (sym_reader);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/print.h b/libguile/print.h
index 11f533c79..b9cc20a6b 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -1,33 +1,32 @@
-/* classes: h_files */
-
 #ifndef SCM_PRINT_H
 #define SCM_PRINT_H
 
-/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2004, 2006, 2008,
- *   2010, 2012, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2003-2004,2006,2008,2010,2012,2017-2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
 
-#include "libguile/__scm.h"
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
 #include "libguile/chars.h" 
+#include <libguile/error.h>
+#include <libguile/gc.h>
 #include "libguile/options.h"
+
 
 
 /* State information passed around during printing.
@@ -47,13 +46,21 @@ do { \
 #define SCM_SET_WRITINGP(pstate, x) { (pstate)->writingp = (x); }
 
 #define SCM_PORT_WITH_PS_P(p)    SCM_TYP16_PREDICATE (scm_tc16_port_with_ps, p)
-#define SCM_PORT_WITH_PS_PORT(p) SCM_CAR (SCM_CELL_OBJECT_1 (p))
-#define SCM_PORT_WITH_PS_PS(p)   SCM_CDR (SCM_CELL_OBJECT_1 (p))
+#define SCM_PORT_WITH_PS_PORT(p) SCM_CELL_OBJECT_1 (p)
+#define SCM_PORT_WITH_PS_PS(p)   SCM_CELL_OBJECT_2 (p)
 
 #define SCM_COERCE_OUTPORT(p) \
   (SCM_PORT_WITH_PS_P (p) ? SCM_PORT_WITH_PS_PORT (p) : p)
 
-#define SCM_PRINT_STATE_LAYOUT "pruwuwuwuwuwpwuwuwurprpw"
+#define SCM_VALIDATE_OPORT_VALUE(pos, port) \
+  do { \
+    SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_PRINTSTATE(pos, a) \
+  SCM_MAKE_VALIDATE_MSG(pos, a, PRINT_STATE_P, "print-state")
+
+#define SCM_PRINT_STATE_LAYOUT "pwuwuwuwuwuwpwuwuwuwpwpw"
 typedef struct scm_print_state {
   SCM handle;			/* Struct handle */
   int revealed;                 /* Has the state escaped to Scheme? */
@@ -79,8 +86,8 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
-SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
-SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
+SCM_API void scm_intprint (intmax_t n, int radix, SCM port);
+SCM_API void scm_uintprint (uintmax_t n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
 SCM_API void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate);
 SCM_API void scm_print_symbol_name (const char *str, size_t len, SCM port);
@@ -102,9 +109,3 @@ SCM_API SCM scm_current_pstate (void);
 #endif 
 
 #endif  /* SCM_PRINT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/private-options.h b/libguile/private-options.h
index a3a0c2b94..3580c5367 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -1,26 +1,21 @@
-/*
- * private-options.h - private declarations for option handling
- *
- * We put this in a private header, since layout of data structures
- * is an implementation detail that we want to hide.
- * 
- * Copyright (C) 2007, 2009, 2010, 2011, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2007,2009-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef PRIVATE_OPTIONS
 #define PRIVATE_OPTIONS
diff --git a/libguile/procprop.c b/libguile/procprop.c
index ad56bd5ba..89cc6c2f7 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -1,41 +1,48 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2003-2004,2006,2008-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
+#include "alist.h"
+#include "boolean.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+#include "programs.h"
+#include "smob.h"
+#include "symbols.h"
+#include "threads.h"
+#include "vectors.h"
+#include "vm-builtins.h"
+#include "weak-table.h"
+
+#include "procprop.h"
 
-#include "libguile/alist.h"
-#include "libguile/eval.h"
-#include "libguile/procs.h"
-#include "libguile/gsubr.h"
-#include "libguile/smob.h"
-#include "libguile/vectors.h"
-#include "libguile/weak-table.h"
-#include "libguile/programs.h"
-#include "libguile/vm-builtins.h"
 
-#include "libguile/validate.h"
-#include "libguile/procprop.h"
 
 
 SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
@@ -334,13 +341,7 @@ scm_init_procprop ()
 {
   overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
   arity_overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
-#include "libguile/procprop.x"
+#include "procprop.x"
   scm_init_vm_builtin_properties ();
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/procprop.h b/libguile/procprop.h
index 41d0753e3..14de247cd 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_PROCPROP_H
 #define SCM_PROCPROP_H
 
-/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000,2006,2008-2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -47,9 +46,3 @@ SCM_API SCM scm_procedure_documentation (SCM proc);
 SCM_INTERNAL void scm_init_procprop (void);
 
 #endif  /* SCM_PROCPROP_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/procs.c b/libguile/procs.c
index 2329f4a1b..1b5aff430 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2006,2008-2013,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,20 +23,22 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
+#include "deprecation.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "loader.h"
+#include "procprop.h"
+#include "programs.h"
+#include "smob.h"
+#include "strings.h"
+#include "struct.h"
+#include "symbols.h"
+#include "vectors.h"
 
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/smob.h"
-#include "libguile/deprecation.h"
+#include "procs.h"
 
-#include "libguile/validate.h"
-#include "libguile/procs.h"
-#include "libguile/procprop.h"
-#include "libguile/loader.h"
-#include "libguile/programs.h"
-
 
+
 
 /* {Procedures}
  */
@@ -130,11 +132,5 @@ scm_init_procs ()
                        1,
                        SCM_UNPACK (scm_from_latin1_symbol ("pwpw")));
 
-#include "libguile/procs.x"
+#include "procs.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/procs.h b/libguile/procs.h
index c4c78f23e..11c3f1aaf 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -1,33 +1,42 @@
-/* classes: h_files */
-
 #ifndef SCM_PROCS_H
 #define SCM_PROCS_H
 
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
- *   2012, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2006,2008-2009,2012-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/boolean.h"
+#include <libguile/error.h>
 
 
 
+#define SCM_VALIDATE_THUNK(pos, thunk) \
+  do { \
+    SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_PROC(pos, proc) \
+  do { \
+    SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
+  } while (0)
+
 SCM_API SCM scm_procedure_p (SCM obj);
 SCM_API SCM scm_thunk_p (SCM obj);
 SCM_API SCM scm_procedure_with_setter_p (SCM obj);
@@ -37,9 +46,3 @@ SCM_API SCM scm_setter (SCM proc);
 SCM_INTERNAL void scm_init_procs (void);
 
 #endif  /* SCM_PROCS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/programs.c b/libguile/programs.c
index 237d282ec..81495a5b1 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -1,33 +1,45 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2014,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
 #include <string.h>
-#include "_scm.h"
+
+#include "alist.h"
+#include "boolean.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
 #include "instructions.h"
 #include "modules.h"
-#include "programs.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
 #include "procprop.h" /* scm_sym_name */
+#include "variable.h"
+#include "version.h"
 #include "vm.h"
 
+#include "programs.h"
+
 
 static SCM write_program = SCM_BOOL_F;
 
@@ -38,7 +50,7 @@ SCM_DEFINE (scm_program_code, "program-code", 1, 0, 0,
 {
   SCM_VALIDATE_PROGRAM (1, program);
 
-  return scm_from_uintptr_t ((scm_t_uintptr) SCM_PROGRAM_CODE (program));
+  return scm_from_uintptr_t ((uintptr_t) SCM_PROGRAM_CODE (program));
 }
 #undef FUNC_NAME
 
@@ -48,7 +60,7 @@ scm_i_program_name (SCM program)
   static SCM program_name = SCM_BOOL_F;
 
   if (SCM_PRIMITIVE_P (program))
-    return SCM_SUBR_NAME (program);
+    return scm_i_primitive_name (SCM_PROGRAM_CODE (program));
 
   if (scm_is_false (program_name) && scm_module_system_booted_p)
     program_name =
@@ -120,7 +132,7 @@ scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
       scm_puts ("#<program ", port);
       scm_uintprint (SCM_UNPACK (program), 16, port);
       scm_putc (' ', port);
-      scm_uintprint ((scm_t_uintptr) SCM_PROGRAM_CODE (program), 16, port);
+      scm_uintprint ((uintptr_t) SCM_PROGRAM_CODE (program), 16, port);
       scm_putc ('>', port);
     }
   else
@@ -150,7 +162,7 @@ SCM_DEFINE (scm_primitive_code_p, "primitive-code?", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_primitive_code_p
 {
-  const scm_t_uint32 * ptr = (const scm_t_uint32 *) scm_to_uintptr_t (code);
+  const uint32_t * ptr = (const uint32_t *) scm_to_uintptr_t (code);
 
   return scm_from_bool (scm_i_primitive_code_p (ptr));
 }
@@ -161,9 +173,26 @@ SCM_DEFINE (scm_primitive_call_ip, "primitive-call-ip", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_primitive_call_ip
 {
+  uintptr_t ip;
+
   SCM_MAKE_VALIDATE (1, prim, PRIMITIVE_P);
 
-  return scm_from_uintptr_t (scm_i_primitive_call_ip (prim));
+  ip = scm_i_primitive_call_ip (prim);
+  return ip ? scm_from_uintptr_t (ip) : SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_primitive_code_name, "primitive-code-name", 1, 0, 0,
+	    (SCM code),
+	    "")
+#define FUNC_NAME s_scm_primitive_code_name
+{
+  const uint32_t * ptr = (const uint32_t *) scm_to_uintptr_t (code);
+
+  if (scm_i_primitive_code_p (ptr))
+    return scm_i_primitive_name (ptr);
+
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -241,8 +270,11 @@ SCM_DEFINE (scm_program_free_variable_set_x, "program-free-variable-set!", 3, 0,
 static int
 try_parse_arity (SCM program, int *req, int *opt, int *rest)
 {
-  scm_t_uint32 *code = SCM_PROGRAM_CODE (program);
-  scm_t_uint32 slots, min;
+  uint32_t *code = SCM_PROGRAM_CODE (program);
+  uint32_t slots, min;
+
+  if ((code[0] & 0xff) == scm_op_instrument_entry)
+    code += 2;
 
   switch (code[0] & 0xff) {
   case scm_op_assert_nargs_ee:
@@ -263,6 +295,12 @@ try_parse_arity (SCM program, int *req, int *opt, int *rest)
     *opt = slots - 1;
     *rest = 0;
     return 1;
+  case scm_op_bind_optionals:
+    slots = code[0] >> 8;
+    *req = 0;
+    *opt = slots - 1;
+    *rest = ((code[1] & 0xff) == scm_op_bind_rest);
+    return 1;
   case scm_op_bind_rest:
     slots = code[0] >> 8;
     *req = 0;
@@ -278,17 +316,30 @@ try_parse_arity (SCM program, int *req, int *opt, int *rest)
       *opt = slots - 1 - *req;
       *rest = 0;
       return 1;
+    case scm_op_bind_optionals:
+      slots = code[1] >> 8;
+      *req = min - 1;
+      *opt = slots - 1 - *req;
+      *rest = ((code[2] & 0xff) == scm_op_bind_rest);
+      return 1;
     case scm_op_bind_rest:
       slots = code[1] >> 8;
       *req = min - 1;
       *opt = slots - min;
       *rest = 1;
       return 1;
+    case scm_op_shuffle_down:
+    case scm_op_abort:
+      *req = min - 1;
+      *opt = 0;
+      *rest = 1;
+      return 1;
     default:
       return 0;
     }
   case scm_op_continuation_call:
   case scm_op_compose_continuation:
+  case scm_op_shuffle_down:
     *req = 0;
     *opt = 0;
     *rest = 1;
@@ -336,12 +387,6 @@ void
 scm_init_programs (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/programs.x"
+#include "programs.x"
 #endif
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/programs.h b/libguile/programs.h
index c962995eb..fb5921362 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -1,32 +1,33 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_PROGRAMS_H_
 #define _SCM_PROGRAMS_H_
 
-#include <libguile.h>
+#include <libguile/gc.h>
 
 /*
  * Programs
  */
 
 #define SCM_PROGRAM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_program))
-#define SCM_PROGRAM_CODE(x) ((scm_t_uint32 *) SCM_CELL_WORD_1 (x))
+#define SCM_PROGRAM_CODE(x) ((uint32_t *) SCM_CELL_WORD_1 (x))
 #define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 2))
 #define SCM_PROGRAM_FREE_VARIABLE_REF(x,i) (SCM_PROGRAM_FREE_VARIABLES (x)[i])
 #define SCM_PROGRAM_FREE_VARIABLE_SET(x,i,v) (SCM_PROGRAM_FREE_VARIABLES (x)[i]=(v))
@@ -49,7 +50,7 @@
 
 #ifdef BUILDING_LIBGUILE
 static inline SCM
-scm_i_make_program (const scm_t_uint32 *code)
+scm_i_make_program (const uint32_t *code)
 {
   return scm_cell (scm_tc7_program, (scm_t_bits)code);
 }
@@ -59,6 +60,7 @@ SCM_INTERNAL SCM scm_program_p (SCM obj);
 SCM_INTERNAL SCM scm_program_code (SCM program);
 
 SCM_INTERNAL SCM scm_primitive_code_p (SCM code);
+SCM_INTERNAL SCM scm_primitive_code_name (SCM code);
 SCM_INTERNAL SCM scm_primitive_call_ip (SCM prim);
 
 SCM_INTERNAL SCM scm_i_program_name (SCM program);
@@ -80,9 +82,3 @@ SCM_INTERNAL void scm_bootstrap_programs (void);
 SCM_INTERNAL void scm_init_programs (void);
 
 #endif /* _SCM_PROGRAMS_H_ */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/promises.c b/libguile/promises.c
index 3ed229443..c47bd9086 100644
--- a/libguile/promises.c
+++ b/libguile/promises.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
- * Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,44 +25,42 @@
 
 #include <alloca.h>
 
-#include "libguile/__scm.h"
-
-#include "libguile/_scm.h"
-#include "libguile/alist.h"
-#include "libguile/async.h"
-#include "libguile/continuations.h"
-#include "libguile/debug.h"
-#include "libguile/deprecation.h"
-#include "libguile/dynwind.h"
-#include "libguile/eq.h"
-#include "libguile/eval.h"
-#include "libguile/feature.h"
-#include "libguile/fluids.h"
-#include "libguile/goops.h"
-#include "libguile/hash.h"
-#include "libguile/hashtab.h"
-#include "libguile/list.h"
-#include "libguile/macros.h"
-#include "libguile/memoize.h"
-#include "libguile/modules.h"
-#include "libguile/ports.h"
-#include "libguile/print.h"
-#include "libguile/procprop.h"
-#include "libguile/programs.h"
-#include "libguile/smob.h"
-#include "libguile/srcprop.h"
-#include "libguile/stackchk.h"
-#include "libguile/strings.h"
-#include "libguile/threads.h"
-#include "libguile/throw.h"
-#include "libguile/validate.h"
-#include "libguile/values.h"
-#include "libguile/promises.h"
+#include "alist.h"
+#include "async.h"
+#include "continuations.h"
+#include "debug.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "eval.h"
+#include "feature.h"
+#include "fluids.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "list.h"
+#include "macros.h"
+#include "memoize.h"
+#include "modules.h"
+#include "ports.h"
+#include "print.h"
+#include "procprop.h"
+#include "procs.h"
+#include "programs.h"
+#include "smob.h"
+#include "srcprop.h"
+#include "stackchk.h"
+#include "strings.h"
+#include "threads.h"
+#include "throw.h"
+#include "values.h"
+
+#include "promises.h"
 
 
 
 
-
 scm_t_bits scm_tc16_promise;
 
 SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, 
@@ -135,14 +133,7 @@ scm_init_promises ()
   scm_tc16_promise = scm_make_smob_type ("promise", 0);
   scm_set_smob_print (scm_tc16_promise, promise_print);
 
-#include "libguile/promises.x"
+#include "promises.x"
 
   scm_add_feature ("delay");
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
-
diff --git a/libguile/promises.h b/libguile/promises.h
index 66349b5ab..dcb736d6b 100644
--- a/libguile/promises.h
+++ b/libguile/promises.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_PROMISES_H
 #define SCM_PROMISES_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2004,2008-2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/smob.h"
 
 
 
@@ -53,9 +51,3 @@ SCM_INTERNAL void scm_init_promises (void);
 
 
 #endif  /* SCM_PROMISES_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index b5fae4e89..a7192cf47 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -1,25 +1,24 @@
-/* classes: h_files */
-
 #ifndef SCM_PTHREADS_THREADS_H
 #define SCM_PTHREADS_THREADS_H
 
-/* Copyright (C) 2002, 2005, 2006, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2002,2005-2006,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -98,9 +97,3 @@ extern pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1];
 #define scm_i_scm_pthread_cond_timedwait    scm_pthread_cond_timedwait
 
 #endif  /* SCM_PTHREADS_THREADS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c
index 598267268..bce59022a 100644
--- a/libguile/quicksort.i.c
+++ b/libguile/quicksort.i.c
@@ -12,6 +12,7 @@
  */
 
 #define SWAP(a, b) do { const SCM _tmp = GET(a); SET(a, GET(b)); SET(b, _tmp); } while (0)
+#define MIN(A, B) ((A) <= (B) ? (A) : (B))
 
 
 /* Order using quicksort.  This implementation incorporates four
@@ -177,7 +178,7 @@ NAME (VEC_PARAM ssize_t lbnd, ssize_t ubnd, INC_PARAM SCM less)
   {
     ssize_t tmp = lbnd;
     ssize_t end = ubnd;
-    ssize_t thresh = min (end, MAX_THRESH);
+    ssize_t thresh = MIN (end, MAX_THRESH);
     ssize_t run;
 
     /* Find smallest element in first threshold and place it at the
@@ -230,6 +231,7 @@ NAME (VEC_PARAM ssize_t lbnd, ssize_t ubnd, INC_PARAM SCM less)
 #undef STACK_NOT_EMPTY
 #undef GET
 #undef SET
+#undef MIN
 
 #undef NAME
 #undef INC_PARAM
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 84038022c..445ae5464 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,42 +1,49 @@
-/* Copyright (C) 2009-2011, 2013-2015, 2018, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009-2011,2013-2015,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
+#include <assert.h>
+#include <intprops.h>
 #include <unistd.h>
 #include <string.h>
 #include <stdio.h>
-#include <assert.h>
-#include <intprops.h>
-
-#include "libguile/_scm.h"
-#include "libguile/bytevectors.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/r6rs-ports.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/values.h"
-#include "libguile/vectors.h"
-#include "libguile/ports-internal.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "chars.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "ports-internal.h"
+#include "procs.h"
+#include "smob.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "values.h"
+#include "vectors.h"
+#include "version.h"
+
+#include "r6rs-ports.h"
 
 
 
@@ -79,9 +86,8 @@ SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
 
 /* Input ports.  */
 
-#ifndef MIN
-# define MIN(a,b) ((a) < (b) ? (a) : (b))
-#endif
+#define MAX(A, B) ((A) >= (B) ? (A) : (B))
+#define MIN(A, B) ((A) < (B) ? (A) : (B))
 
 /* Bytevector input ports.  */
 static scm_t_port_type *bytevector_input_port_type = 0;
@@ -404,7 +410,7 @@ SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
   if (u8 == EOF)
     result = SCM_EOF_VAL;
   else
-    result = SCM_I_MAKINUM ((scm_t_uint8) u8);
+    result = SCM_I_MAKINUM ((uint8_t) u8);
 
   return result;
 }
@@ -507,7 +513,7 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
     }
 
   bv = scm_c_make_bytevector (avail);
-  scm_port_buffer_take (buf, (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv),
+  scm_port_buffer_take (buf, (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv),
                         avail, cur, avail);
 
   return bv;
@@ -548,9 +554,9 @@ SCM_DEFINE (scm_get_bytevector_some_x, "get-bytevector-some!", 4, 0, 0,
       return SCM_EOF_VAL;
     }
 
-  transfer_size = min (avail, c_count);
+  transfer_size = MIN (avail, c_count);
   scm_port_buffer_take (buf,
-                        (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv) + c_start,
+                        (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv) + c_start,
                         transfer_size, cur, avail);
 
   return scm_from_size_t (transfer_size);
@@ -624,7 +630,7 @@ SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
 	    "Write @var{octet} to binary port @var{port}.")
 #define FUNC_NAME s_scm_put_u8
 {
-  scm_t_uint8 c_octet;
+  uint8_t c_octet;
 
   SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
   c_octet = scm_to_uint8 (octet);
@@ -779,13 +785,13 @@ bytevector_output_port_buffer_grow (scm_t_bytevector_output_port_buffer *buf,
     {
       if (INT_ADD_OVERFLOW (buf->total_len, buf->total_len))
         scm_num_overflow ("bytevector_output_port_buffer_grow");
-      new_size = max (min_size, buf->total_len * 2);
+      new_size = MAX (min_size, buf->total_len * 2);
       new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
                                 new_size, SCM_GC_BYTEVECTOR_OUTPUT_PORT);
     }
   else
     {
-      new_size = max (min_size, SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER_INITIAL_SIZE);
+      new_size = MAX (min_size, SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER_INITIAL_SIZE);
       new_buf = scm_gc_malloc_pointerless (new_size,
                                            SCM_GC_BYTEVECTOR_OUTPUT_PORT);
     }
@@ -813,7 +819,7 @@ make_bytevector_output_port (void)
 
   SCM_NEWSMOB (proc, bytevector_output_port_procedure, buf);
 
-  return scm_values (scm_list_2 (port, proc));
+  return scm_values_2 (port, proc);
 }
 
 /* Write octets from WRITE_BUF to the backing store.  */
@@ -1238,5 +1244,5 @@ scm_register_r6rs_ports (void)
 void
 scm_init_r6rs_ports (void)
 {
-#include "libguile/r6rs-ports.x"
+#include "r6rs-ports.x"
 }
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
index 51dec4185..56a535e8e 100644
--- a/libguile/r6rs-ports.h
+++ b/libguile/r6rs-ports.h
@@ -1,27 +1,28 @@
 #ifndef SCM_R6RS_PORTS_H
 #define SCM_R6RS_PORTS_H
 
-/* Copyright (C) 2009-2011, 2013, 2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009-2011,2013,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 /* R6RS I/O Ports.  */
 
diff --git a/libguile/random.c b/libguile/random.c
index 7590dcbb1..6fd567cca 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,22 +1,21 @@
-/* Copyright (C) 1999-2001, 2003, 2005, 2006, 2009, 2010, 2012-2014,
- *   2017, 2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2003,2005-2006,2009-2010,2012-2014,2017-2019
+     Free Software Foundation, Inc.
 
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 /* Original Author: Mikael Djurfeldt <djurfeldt@nada.kth.se> */
@@ -25,26 +24,34 @@
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-
-#include <gmp.h>
-#include <stdio.h>
 #include <math.h>
+#include <stdio.h>
 #include <string.h>
 #include <sys/types.h>
 #include <unistd.h>
 
-#include "libguile/smob.h"
-#include "libguile/numbers.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/arrays.h"
-#include "libguile/srfi-4.h"
-#include "libguile/vectors.h"
-#include "libguile/generalized-vectors.h"
+#include <gmp.h>
+
+#include "arrays.h"
+#include "feature.h"
+#include "generalized-arrays.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "smob.h"
+#include "srfi-4.h"
+#include "stime.h"
+#include "strings.h"
+#include "symbols.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "random.h"
 
-#include "libguile/validate.h"
-#include "libguile/random.h"
 
 
 /*
@@ -78,8 +85,8 @@ scm_t_rng scm_the_rng;
 
 typedef struct scm_t_i_rstate {
   scm_t_rstate rstate;
-  scm_t_uint32 w;
-  scm_t_uint32 c;
+  uint32_t w;
+  uint32_t c;
 } scm_t_i_rstate;
 
 
@@ -89,12 +96,12 @@ typedef struct scm_t_i_rstate {
 #define M_PI 3.14159265359
 #endif
 
-static scm_t_uint32
+static uint32_t
 scm_i_uniform32 (scm_t_rstate *state)
 {
   scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
-  scm_t_uint64 x = (scm_t_uint64) A * istate->w + istate->c;
-  scm_t_uint32 w = x & 0xffffffffUL;
+  uint64_t x = (uint64_t) A * istate->w + istate->c;
+  uint32_t w = x & 0xffffffffUL;
   istate->w = w;
   istate->c = x >> 32L;
   return w;
@@ -104,8 +111,8 @@ static void
 scm_i_init_rstate (scm_t_rstate *state, const char *seed, int n)
 {
   scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
-  scm_t_uint32 w = 0L;
-  scm_t_uint32 c = 0L;
+  uint32_t w = 0L;
+  uint32_t c = 0L;
   int i, m;
   for (i = 0; i < n; ++i)
     {
@@ -138,7 +145,7 @@ scm_i_rstate_from_datum (scm_t_rstate *state, SCM value)
 #define FUNC_NAME "scm_i_rstate_from_datum"
 {
   scm_t_i_rstate *istate = (scm_t_i_rstate*) state;
-  scm_t_uint32 w, c;
+  uint32_t w, c;
   long length;
   
   SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, value, length);
@@ -246,8 +253,8 @@ scm_c_exp1 (scm_t_rstate *state)
 
 unsigned char scm_masktab[256];
 
-static inline scm_t_uint32
-scm_i_mask32 (scm_t_uint32 m)
+static inline uint32_t
+scm_i_mask32 (uint32_t m)
 {
   return (m < 0x100
 	  ? scm_masktab[m]
@@ -255,28 +262,28 @@ scm_i_mask32 (scm_t_uint32 m)
 	     ? scm_masktab[m >> 8] << 8 | 0xff
 	     : (m < 0x1000000
 		? scm_masktab[m >> 16] << 16 | 0xffff
-		: ((scm_t_uint32) scm_masktab[m >> 24]) << 24 | 0xffffff)));
+		: ((uint32_t) scm_masktab[m >> 24]) << 24 | 0xffffff)));
 }
 
-scm_t_uint32
-scm_c_random (scm_t_rstate *state, scm_t_uint32 m)
+uint32_t
+scm_c_random (scm_t_rstate *state, uint32_t m)
 {
-  scm_t_uint32 r, mask = scm_i_mask32 (m);
+  uint32_t r, mask = scm_i_mask32 (m);
   while ((r = state->rng->random_bits (state) & mask) >= m);
   return r;
 }
 
-scm_t_uint64
-scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m)
+uint64_t
+scm_c_random64 (scm_t_rstate *state, uint64_t m)
 {
-  scm_t_uint64 r;
-  scm_t_uint32 mask;
+  uint64_t r;
+  uint32_t mask;
 
-  if (m <= SCM_T_UINT32_MAX)
-    return scm_c_random (state, (scm_t_uint32) m);
+  if (m <= UINT32_MAX)
+    return scm_c_random (state, (uint32_t) m);
   
   mask = scm_i_mask32 (m >> 32);
-  while ((r = ((scm_t_uint64) (state->rng->random_bits (state) & mask) << 32)
+  while ((r = ((uint64_t) (state->rng->random_bits (state) & mask) << 32)
           | state->rng->random_bits (state)) >= m)
     ;
   return r;
@@ -302,24 +309,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
 {
   SCM result = scm_i_mkbig ();
   const size_t m_bits = mpz_sizeinbase (SCM_I_BIG_MPZ (m), 2);
-  /* how many bits would only partially fill the last scm_t_uint32? */
-  const size_t end_bits = m_bits % (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
-  scm_t_uint32 *random_chunks = NULL;
-  const scm_t_uint32 num_full_chunks =
-    m_bits / (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
-  const scm_t_uint32 num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
+  /* how many bits would only partially fill the last uint32_t? */
+  const size_t end_bits = m_bits % (sizeof (uint32_t) * SCM_CHAR_BIT);
+  uint32_t *random_chunks = NULL;
+  const uint32_t num_full_chunks =
+    m_bits / (sizeof (uint32_t) * SCM_CHAR_BIT);
+  const uint32_t num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
 
   /* we know the result will be this big */
   mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
 
   random_chunks =
-    (scm_t_uint32 *) scm_gc_calloc (num_chunks * sizeof (scm_t_uint32),
+    (uint32_t *) scm_gc_calloc (num_chunks * sizeof (uint32_t),
                                      "random bignum chunks");
 
   do
     {
-      scm_t_uint32 *current_chunk = random_chunks + (num_chunks - 1);
-      scm_t_uint32 chunks_left = num_chunks;
+      uint32_t *current_chunk = random_chunks + (num_chunks - 1);
+      uint32_t chunks_left = num_chunks;
 
       mpz_set_ui (SCM_I_BIG_MPZ (result), 0);
       
@@ -327,24 +334,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
         {
           /* generate a mask with ones in the end_bits position, i.e. if
              end_bits is 3, then we'd have a mask of ...0000000111 */
-          const scm_t_uint32 rndbits = state->rng->random_bits (state);
-          int rshift = (sizeof (scm_t_uint32) * SCM_CHAR_BIT) - end_bits;
-          scm_t_uint32 mask = ((scm_t_uint32)-1) >> rshift;
-          scm_t_uint32 highest_bits = rndbits & mask;
+          const uint32_t rndbits = state->rng->random_bits (state);
+          int rshift = (sizeof (uint32_t) * SCM_CHAR_BIT) - end_bits;
+          uint32_t mask = ((uint32_t)-1) >> rshift;
+          uint32_t highest_bits = rndbits & mask;
           *current_chunk-- = highest_bits;
           chunks_left--;
         }
       
       while (chunks_left)
         {
-          /* now fill in the remaining scm_t_uint32 sized chunks */
+          /* now fill in the remaining uint32_t sized chunks */
           *current_chunk-- = state->rng->random_bits (state);
           chunks_left--;
         }
       mpz_import (SCM_I_BIG_MPZ (result),
                   num_chunks,
                   -1,
-                  sizeof (scm_t_uint32),
+                  sizeof (uint32_t),
                   0,
                   0,
                   random_chunks);
@@ -352,7 +359,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
 	 all bits in order not to get a distorted distribution) */
     } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >= 0);
   scm_gc_free (random_chunks,
-               num_chunks * sizeof (scm_t_uint32),
+               num_chunks * sizeof (uint32_t),
                "random bignum chunks");
   return scm_i_normbig (result);
 }
@@ -404,15 +411,14 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
       SCM_ASSERT_RANGE (1, n, SCM_I_INUM (n) > 0);
 #if SCM_SIZEOF_UINTPTR_T <= 4
       return scm_from_uint32 (scm_c_random (SCM_RSTATE (state),
-                                            (scm_t_uint32) m));
+                                            (uint32_t) m));
 #elif SCM_SIZEOF_UINTPTR_T <= 8
       return scm_from_uint64 (scm_c_random64 (SCM_RSTATE (state),
-                                              (scm_t_uint64) m));
+                                              (uint64_t) m));
 #else
 #error "Cannot deal with this platform's scm_t_bits size"
 #endif
     }
-  SCM_VALIDATE_NIM (1, n);
   if (SCM_REALP (n))
     return scm_from_double (SCM_REAL_VALUE (n)
 			    * scm_c_uniform01 (SCM_RSTATE (state)));
@@ -822,13 +828,7 @@ scm_init_random ()
     for (i = m >> 1; i < m; ++i)
       scm_masktab[i] = m - 1;
 
-#include "libguile/random.x"
+#include "random.x"
 
   scm_add_feature ("random");
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/random.h b/libguile/random.h
index 109969e01..e3bb321c3 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_RANDOM_H
 #define SCM_RANDOM_H
 
-/* Copyright (C) 1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
 
 
 /*
@@ -46,7 +45,7 @@ typedef struct scm_t_rstate {
 
 typedef struct scm_t_rng {
   size_t rstate_size;				    /* size of random state */
-  scm_t_uint32 (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
+  uint32_t (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
   void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
   scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
   void (*from_datum) (scm_t_rstate *state, SCM datum);
@@ -66,8 +65,8 @@ SCM_API scm_t_rstate *scm_c_default_rstate (void);
 SCM_API double scm_c_uniform01 (scm_t_rstate *);
 SCM_API double scm_c_normal01 (scm_t_rstate *);
 SCM_API double scm_c_exp1 (scm_t_rstate *);
-SCM_API scm_t_uint32 scm_c_random (scm_t_rstate *, scm_t_uint32 m);
-SCM_API scm_t_uint64 scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m);
+SCM_API uint32_t scm_c_random (scm_t_rstate *, uint32_t m);
+SCM_API uint64_t scm_c_random64 (scm_t_rstate *state, uint64_t m);
 SCM_API SCM scm_c_random_bignum (scm_t_rstate *, SCM m);
 
 
@@ -78,6 +77,9 @@ SCM_API scm_t_bits scm_tc16_rstate;
 #define SCM_RSTATEP(obj) SCM_SMOB_PREDICATE (scm_tc16_rstate, obj)
 #define SCM_RSTATE(obj)  ((scm_t_rstate *) SCM_SMOB_DATA (obj))
 
+#define SCM_VALIDATE_RSTATE(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state")
+
 SCM_API unsigned char scm_masktab[256];
 
 SCM_API SCM scm_var_random_state;
@@ -98,9 +100,3 @@ SCM_INTERNAL void scm_init_random (void);
 SCM_INTERNAL void scm_i_random_bytes_from_platform (unsigned char *buf, size_t len);
 
 #endif  /* SCM_RANDOM_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 80962bc5e..4a0b20954 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -1,41 +1,42 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006,
- *   2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2006,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-
 #include <stdio.h>
-
-#ifdef HAVE_STRING_H
 #include <string.h>
-#endif
 
-#include "libguile/chars.h"
-#include "libguile/modules.h"
-#include "libguile/ports.h"
-#include "libguile/rdelim.h"
-#include "libguile/strings.h"
-#include "libguile/strports.h"
-#include "libguile/validate.h"
+#include "boolean.h"
+#include "chars.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "strports.h"
+
+#include "rdelim.h"
 
 SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
             (SCM delims, SCM str, SCM gobble, SCM port, SCM start, SCM end),
@@ -203,7 +204,7 @@ SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
 SCM
 scm_init_rdelim_builtins (void)
 {
-#include "libguile/rdelim.x"
+#include "rdelim.x"
 
   return SCM_UNSPECIFIED;
 }
@@ -214,9 +215,3 @@ scm_init_rdelim (void)
   scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
 		      scm_init_rdelim_builtins);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/rdelim.h b/libguile/rdelim.h
index 2e401e4fe..e8930726a 100644
--- a/libguile/rdelim.h
+++ b/libguile/rdelim.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_RDELIM_H
 #define SCM_RDELIM_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API SCM scm_read_delimited_x (SCM delims, SCM buf, SCM gobble, SCM port,
 				  SCM offset, SCM length);
@@ -34,9 +33,3 @@ SCM_API SCM scm_init_rdelim_builtins (void);
 SCM_INTERNAL void scm_init_rdelim (void);
 
 #endif  /* SCM_RDELIM_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/read.c b/libguile/read.c
index 63d67210e..f146f0ef0 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-1997, 1999-2001, 2003, 2004, 2006-2012, 2014-2019
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2003-2004,2006-2012,2014-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,38 +24,46 @@
 # include <config.h>
 #endif
 
+#include <alloca.h>
+#include <c-ctype.h>
+#include <c-strcase.h>
 #include <stdio.h>
 #include <string.h>
-#include <unistd.h>
 #include <unicase.h>
 #include <unictype.h>
-#include <c-strcase.h>
-#include <c-ctype.h>
-#include <alloca.h>
+#include <unistd.h>
 
-#include "libguile/_scm.h"
-#include "libguile/bytevectors.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/arrays.h"
-#include "libguile/bitvectors.h"
-#include "libguile/keywords.h"
-#include "libguile/alist.h"
-#include "libguile/srcprop.h"
-#include "libguile/hashtab.h"
-#include "libguile/hash.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/fports.h"
-#include "libguile/strings.h"
-#include "libguile/strports.h"
-#include "libguile/vectors.h"
-#include "libguile/validate.h"
-#include "libguile/srfi-4.h"
-#include "libguile/srfi-13.h"
-
-#include "libguile/read.h"
-#include "libguile/private-options.h"
+#include "alist.h"
+#include "arrays.h"
+#include "bitvectors.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "chars.h"
+#include "eq.h"
+#include "eval.h"
+#include "fluids.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "private-options.h"
+#include "procs.h"
+#include "srcprop.h"
+#include "srfi-13.h"
+#include "srfi-4.h"
+#include "strings.h"
+#include "strports.h"
+#include "symbols.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "read.h"
 
 
 
@@ -2394,11 +2402,5 @@ scm_init_read ()
     SCM_VARIABLE_LOC (scm_c_define ("%read-hash-procedures", read_hash_procs));
 
   scm_init_opts (scm_read_options, scm_read_opts);
-#include "libguile/read.x"
+#include "read.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/read.h b/libguile/read.h
index 3c47afdd0..94d92db4a 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -1,29 +1,26 @@
-/* classes: h_files */
-
 #ifndef SCM_READ_H
 #define SCM_READ_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008-2009,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
 
-#include "libguile/__scm.h"
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
 #include "libguile/options.h"
 
@@ -65,9 +62,3 @@ SCM_INTERNAL void scm_i_input_error (const char *func, SCM port,
 SCM_INTERNAL void scm_init_read (void);
 
 #endif  /* SCM_READ_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index d3dd6d876..a08da02db 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1997-2001, 2004, 2006, 2007, 2010-2012, 2018
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1997-2001,2004,2006-2007,2010-2012,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -32,27 +32,29 @@
 #  include <config.h>
 #endif
 
-#include <sys/types.h>
-
-#include "libguile/_scm.h"
-
 #include <regex.h>
+#include <string.h>
+#include <sys/types.h>
 
 #ifdef HAVE_WCHAR_H
 #include <wchar.h>
 #endif
 
-#include "libguile/async.h"
-#include "libguile/smob.h"
-#include "libguile/symbols.h"
-#include "libguile/vectors.h"
-#include "libguile/strports.h"
-#include "libguile/ports.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-
-#include "libguile/validate.h"
-#include "libguile/regex-posix.h"
+#include "async.h"
+#include "feature.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "strings.h"
+#include "strports.h"
+#include "symbols.h"
+#include "vectors.h"
+
+#include "regex-posix.h"
 
 /* This is defined by some regex libraries and omitted by others. */
 #ifndef REG_BASIC
@@ -328,13 +330,7 @@ scm_init_regex_posix ()
   scm_c_define ("regexp/notbol", scm_from_int (REG_NOTBOL));
   scm_c_define ("regexp/noteol", scm_from_int (REG_NOTEOL));
 
-#include "libguile/regex-posix.x"
+#include "regex-posix.x"
 
   scm_add_feature ("regex");
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h
index 8060fe3b7..c2425603b 100644
--- a/libguile/regex-posix.h
+++ b/libguile/regex-posix.h
@@ -1,43 +1,38 @@
-/* classes: h_files */
-
 #ifndef SCM_REGEX_POSIX_H
 #define SCM_REGEX_POSIX_H
 
-/* Copyright (C) 1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1997-1998,2000-2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
 
 SCM_API scm_t_bits scm_tc16_regex;
 #define SCM_RGX(X)	((regex_t *) SCM_SMOB_DATA (X))
 #define SCM_RGXP(X)	(SCM_SMOB_PREDICATE (scm_tc16_regex, (X)))
 
+#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp")
+
 SCM_API SCM scm_make_regexp (SCM pat, SCM flags);
 SCM_API SCM scm_regexp_p (SCM x);
 SCM_API SCM scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags);
 SCM_INTERNAL void scm_init_regex_posix (void);
 
 #endif  /* SCM_REGEX_POSIX_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/rw.c b/libguile/rw.c
index 70bcd81a0..7afae1c63 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2001, 2006, 2009, 2011, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2009,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -26,22 +27,26 @@
 
 #include <errno.h>
 #include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/fports.h"
-#include "libguile/ports.h"
-#include "libguile/rw.h"
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/modules.h"
-#include "libguile/strports.h"
-#include "libguile/ports-internal.h"
-
 #include <unistd.h>
+
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
 
+#include "async.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "numbers.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "strings.h"
+#include "strports.h"
+#include "syscalls.h"
+
+#include "rw.h"
+
+
 
 
 #if defined (EAGAIN)
@@ -270,7 +275,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 SCM 
 scm_init_rw_builtins ()
 {
-#include "libguile/rw.x"
+#include "rw.x"
 
   return SCM_UNSPECIFIED;
 }
@@ -280,9 +285,3 @@ scm_init_rw ()
 {
   scm_c_define_gsubr ("%init-rw-builtins", 0, 0, 0, scm_init_rw_builtins);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/rw.h b/libguile/rw.h
index d54f1b3ef..64765687f 100644
--- a/libguile/rw.h
+++ b/libguile/rw.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_RW_H
 #define SCM_RW_H
 
-/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start,
 				       SCM end);
@@ -34,9 +33,3 @@ SCM_INTERNAL SCM scm_init_rw_builtins (void);
 SCM_INTERNAL void scm_init_rw (void);
 
 #endif  /* SCM_RW_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/scm.h b/libguile/scm.h
new file mode 100644
index 000000000..e69552893
--- /dev/null
+++ b/libguile/scm.h
@@ -0,0 +1,854 @@
+#ifndef SCM_SCM_H
+#define SCM_SCM_H
+
+/* Copyright 1995-2004,2006-2015,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+/* This is the central header for Guile that defines how Scheme values
+   are represented.  Enjoy the read!  */
+
+
+
+#include <stdint.h>
+
+#include "libguile/scmconfig.h"
+
+
+
+
+/* The value of SCM_DEBUG determines the default for most of the not yet
+   defined debugging options.  This allows, for example, to enable most
+   of the debugging options by simply defining SCM_DEBUG as 1.  */
+#ifndef SCM_DEBUG
+#define SCM_DEBUG 0
+#endif
+
+/* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will
+   be exhaustively checked.  Note:  If this option is enabled, guile
+   will run slower than normally.  */
+#ifndef SCM_DEBUG_PAIR_ACCESSES
+#define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG
+#endif
+
+/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest
+   arguments will check whether the rest arguments are actually passed
+   as a proper list.  Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0,
+   functions that take rest arguments will take it for granted that
+   these are passed as a proper list.  */
+#ifndef SCM_DEBUG_REST_ARGUMENT
+#define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
+#endif
+
+/* The macro SCM_DEBUG_TYPING_STRICTNESS indicates what level of type
+   checking shall be performed with respect to the use of the SCM
+   datatype.  The macro may be defined to one of the values 0, 1 and 2.
+
+   A value of 0 means that there will be no compile time type checking,
+   since the SCM datatype will be declared as an integral type.  This
+   setting should only be used on systems, where casting from integral
+   types to pointers may lead to loss of bit information.
+
+   A value of 1 means that there will an intermediate level of compile
+   time type checking, since the SCM datatype will be declared as a
+   pointer to an undefined struct.  This setting is the default, since
+   it does not cost anything in terms of performance or code size.
+
+   A value of 2 provides a maximum level of compile time type checking
+   since the SCM datatype will be declared as a struct.  This setting
+   should be used for _compile time_ type checking only, since the
+   compiled result is likely to be quite inefficient.  The right way to
+   make use of this option is to do a 'make clean; make
+   CFLAGS=-DSCM_DEBUG_TYPING_STRICTNESS=2', fix your errors, and then do
+   'make clean; make'.  */
+#ifndef SCM_DEBUG_TYPING_STRICTNESS
+#define SCM_DEBUG_TYPING_STRICTNESS 1
+#endif
+
+
+
+/* Guile as of today can only work on systems which fulfill at least the
+   following requirements:
+
+   - scm_t_bits and SCM variables have at least 32 bits.
+     Guile's type system is based on this assumption.
+
+   - sizeof (scm_t_bits) >= sizeof (void*) and sizeof (SCM) >= sizeof (void*)
+     Guile's type system is based on this assumption, since it must be
+     possible to store pointers to cells on the heap in scm_t_bits and
+     SCM variables.
+
+   - sizeof (scm_t_bits) >= 4 and sizeof (scm_t_bits) is a power of 2.
+     Guile's type system is based on this assumption.  In particular, it
+     is assumed that cells, i. e. pairs of scm_t_bits variables, are
+     eight-byte aligned.  This is because three bits of a scm_t_bits
+     variable that is holding a pointer to a cell on the heap must be
+     available for storing type data.
+
+   - sizeof (scm_t_bits) <= sizeof (void*) and sizeof (SCM) <= sizeof (void*)
+     In some parts of guile, scm_t_bits and SCM variables are passed to
+     functions as void* arguments.  Together with the requirement above,
+     this requires a one-to-one correspondence between the size of a
+     void* and the sizes of scm_t_bits and SCM variables.
+
+   - numbers are encoded using two's complement.
+     The implementation of the bitwise Scheme-level operations is based on
+     this assumption.  */
+
+
+
+/* In the beginning was the Word:
+
+   For the representation of scheme objects and their handling, Guile
+   provides two types: scm_t_bits and SCM.
+
+   - scm_t_bits values can hold bit patterns of non-objects and objects:
+
+     Non-objects -- in this case the value may not be changed into a SCM
+     value in any way.
+
+     Objects -- in this case the value may be changed into a SCM value
+     using the SCM_PACK macro.
+
+   - SCM values can hold proper scheme objects only.  They can be
+     changed into a scm_t_bits value using the SCM_UNPACK macro.
+
+   When working in the domain of scm_t_bits values, programmers must
+   keep track of any scm_t_bits value they create that is not a proper
+   scheme object.  This makes sure that in the domain of SCM values
+   developers can rely on the fact that they are dealing with proper
+   scheme objects only.  Thus, the distinction between scm_t_bits and
+   SCM values helps to identify those parts of the code where special
+   care has to be taken not to create bad SCM values.  */
+
+/* For dealing with the bit level representation of scheme objects we
+   define scm_t_bits.  */
+typedef intptr_t  scm_t_signed_bits;
+typedef uintptr_t scm_t_bits;
+
+#define SCM_T_SIGNED_BITS_MAX INTPTR_MAX
+#define SCM_T_SIGNED_BITS_MIN INTPTR_MIN
+#define SCM_T_BITS_MAX        UINTPTR_MAX
+
+
+/* But as external interface, we define SCM, which may, according to the
+   desired level of type checking, be defined in several ways.  */
+#if (SCM_DEBUG_TYPING_STRICTNESS == 2)
+  typedef union SCM { struct { scm_t_bits n; } n; } SCM;
+# define SCM_UNPACK(x) ((x).n.n)
+# define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
+#elif (SCM_DEBUG_TYPING_STRICTNESS == 1)
+/* This is the default, which provides an intermediate level of compile
+   time type checking while still resulting in very efficient code.  */
+  typedef struct scm_unused_struct { char scm_unused_field; } *SCM;
+
+/* The 0?: constructions makes sure that the code is never executed, and
+   that there is no performance hit.  However, the alternative is
+   compiled, and does generate a warning when used with the wrong
+   pointer type.  We use a volatile pointer type to avoid warnings from
+   clang.
+
+   The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)'
+   statements, so for them type-checking is disabled.  */
+# if defined __DECC || defined __HP_cc
+#  define SCM_UNPACK(x) ((scm_t_bits) (x))
+# else
+#  define SCM_UNPACK(x) ((scm_t_bits) (0? (*(volatile SCM *)0=(x)): x))
+# endif
+
+/* There is no typechecking on SCM_PACK, since all kinds of types
+   (unsigned long, void*) go in SCM_PACK.  */
+# define SCM_PACK(x) ((SCM) (x))
+
+#else
+/* This should be used as a fall back solution for machines on which
+   casting to a pointer may lead to loss of bit information, e. g. in
+   the three least significant bits.  */
+  typedef scm_t_bits SCM;
+# define SCM_UNPACK(x) (x)
+# define SCM_PACK(x) ((SCM) (x))
+#endif
+
+/* Packing SCM objects into and out of pointers.  */
+#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
+#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
+
+/* SCM values can not be compared by using the operator ==.  Use the
+   following macro instead, which is the equivalent of the scheme
+   predicate 'eq?'.  */
+#define scm_is_eq(x, y) (SCM_UNPACK (x) == SCM_UNPACK (y))
+
+
+
+
+/* Representation of scheme objects:
+
+   Guile's type system is designed to work on systems where scm_t_bits
+   and SCM variables consist of at least 32 bits.  The objects that a
+   SCM variable can represent belong to one of the following two major
+   categories:
+
+   - Immediates -- meaning that the SCM variable contains an entire
+     Scheme object.  That means, all the object's data (including the
+     type tagging information that is required to identify the object's
+     type) must fit into 32 bits.
+
+   - Heap objects -- meaning that the SCM variable holds a pointer into
+     the heap.  On systems where a pointer needs more than 32 bits this
+     means that scm_t_bits and SCM variables need to be large enough to
+     hold such pointers.  In contrast to immediates, the data associated
+     with a heap object can consume arbitrary amounts of memory.
+
+   The 'heap' is the memory area that is under control of Guile's
+   garbage collector.  It holds allocated memory of various sizes.  The
+   impact on the runtime type system is that Guile needs to be able to
+   determine the type of an object given the pointer.  Usually the way
+   that Guile does this is by storing a "type tag" in the first word of
+   the object.
+
+   Some objects are common enough that they get special treatment.
+   Since Guile guarantees that the address of a GC-allocated object on
+   the heap is 8-byte aligned, Guile can play tricks with the lower 3
+   bits.  That is, since heap objects encode a pointer to an
+   8-byte-aligned pointer, the three least significant bits of a SCM can
+   be used to store additional information.  The bits are used to store
+   information about the object's type and thus are called tc3-bits,
+   where tc stands for type-code.
+
+   For a given SCM value, the distinction whether it holds an immediate
+   or heap object is based on the tc3-bits (see above) of its scm_t_bits
+   equivalent: If the tc3-bits equal #b000, then the SCM value holds a
+   heap object, and the scm_t_bits variable's value is just the pointer
+   to the heap cell.
+
+   Summarized, the data of a scheme object that is represented by a SCM
+   variable consists of a) the SCM variable itself, b) in case of heap
+   objects memory that the SCM object points to, c) in case of heap
+   objects potentially additional data outside of the heap (like for
+   example malloc'ed data), and d) in case of heap objects potentially
+   additional data inside of the heap, since data stored in b) and c)
+   may hold references to other cells.
+
+
+   Immediates
+
+   Operations on immediate objects can typically be processed faster
+   than on heap objects.  The reason is that the object's data can be
+   extracted directly from the SCM variable (or rather a corresponding
+   scm_t_bits variable), instead of having to perform additional memory
+   accesses to obtain the object's data from the heap.  In order to get
+   the best possible performance frequently used data types should be
+   realized as immediates.  This is, as has been mentioned above, only
+   possible if the objects can be represented with 32 bits (including
+   type tagging).
+
+   In Guile, the following data types and special objects are realized
+   as immediates: booleans, characters, small integers (see below), the
+   empty list, the end of file object, the 'unspecified' object (which
+   is delivered as a return value by functions for which the return
+   value is unspecified), a 'nil' object used in the elisp-compatibility
+   mode and certain other 'special' objects which are only used
+   internally in Guile.
+
+   Integers in Guile can be arbitrarily large.  On the other hand,
+   integers are one of the most frequently used data types.  Especially
+   integers with less than 32 bits are commonly used.  Thus, internally
+   and transparently for application code guile distinguishes between
+   small and large integers.  Whether an integer is a large or a small
+   integer depends on the number of bits needed to represent its value.
+   Small integers are those which can be represented as immediates.
+   Since they don't require more than a fixed number of bits for their
+   representation, they are also known as 'fixnums'.
+
+   The tc3-combinations #b010 and #b110 are used to represent small
+   integers, which allows to use the most significant bit of the
+   tc3-bits to be part of the integer value being represented.  This
+   means that all integers with up to 30 bits (including one bit for the
+   sign) can be represented as immediates.  On systems where SCM and
+   scm_t_bits variables hold more than 32 bits, the amount of bits
+   usable for small integers will even be larger.  The tc3-code #b100 is
+   shared among booleans, characters and the other special objects
+   listed above.
+
+
+   Heap Objects
+
+   All object types not mentioned above in the list of immediate objects
+   are represented as heap objects.  The amount of memory referenced by
+   a heap object depends on the object's type, namely on the set of
+   attributes that have to be stored with objects of that type.  Every
+   heap object type is allowed to define its own layout and
+   interpretation of the data stored in its cell (with some
+   restrictions, see below).
+
+   One of the design goals of guile's type system is to make it possible
+   to store a scheme pair with as little memory usage as possible.  The
+   minimum amount of memory that is required to store two scheme objects
+   (car and cdr of a pair) is the amount of memory required by two
+   scm_t_bits or SCM variables.  Therefore pairs in guile are stored in
+   two words, and are tagged with a bit pattern in the SCM value, not
+   with a type tag on the heap.
+
+
+   Garbage collection
+
+   During garbage collection, unreachable objects on the heap will be
+   freed.  To determine the set of reachable objects, by default, the GC
+   just traces all words in all heap objects.  It is possible to
+   register custom tracing ("marking") procedures.
+
+   If an object is unreachable, by default, the GC just notes this fact
+   and moves on.  Later allocations will clear out the memory associated
+   with the object, and re-use it.  It is possible to register custom
+   finalizers, however.
+
+
+   Run-time type introspection
+
+   Guile's type system is designed to make it possible to determine a
+   the type of a heap object from the object's first scm_t_bits
+   variable.  (Given a SCM variable X holding a heap object, the macro
+   SCM_CELL_TYPE(X) will deliver the corresponding object's first
+   scm_t_bits variable.)
+
+   If the object holds a scheme pair, then we already know that the
+   first scm_t_bits variable of the cell will hold a scheme object with
+   one of the following tc3-codes: #b000 (heap object), #b010 (small
+   integer), #b110 (small integer), #b100 (non-integer immediate).  All
+   these tc3-codes have in common, that their least significant bit is
+   #b0.  This fact is used by the garbage collector to identify cells
+   that hold pairs.  The remaining tc3-codes are assigned as follows:
+   #b001 (class instance or, more precisely, a struct, of which a class
+   instance is a special case), #b011 (closure), #b101/#b111 (all
+   remaining heap object types).
+
+
+   Summary of type codes of scheme objects (SCM variables)
+
+   Here is a summary of tagging bits as they might occur in a scheme
+   object.  The notation is as follows: tc stands for type code as
+   before, tc<n> with n being a number indicates a type code formed by
+   the n least significant bits of the SCM variables corresponding
+   scm_t_bits value.
+
+   Note that (as has been explained above) tc1==1 can only occur in the
+   first scm_t_bits variable of a cell belonging to a heap object that
+   is not a pair.  For an explanation of the tc tags with tc1==1, see
+   the next section with the summary of the type codes on the heap.
+
+   tc1:
+     0:  For scheme objects, tc1==0 must be fulfilled.
+    (1:  This can never be the case for a scheme object.)
+
+   tc2:
+     00:  Either a heap object or some non-integer immediate
+    (01:  This can never be the case for a scheme object.)
+     10:  Small integer
+    (11:  This can never be the case for a scheme object.)
+
+   tc3:
+     000:  a heap object (pair, closure, class instance etc.)
+    (001:  This can never be the case for a scheme object.)
+     010:  an even small integer (least significant bit is 0).
+    (011:  This can never be the case for a scheme object.)
+     100:  Non-integer immediate
+    (101:  This can never be the case for a scheme object.)
+     110:  an odd small integer (least significant bit is 1).
+    (111:  This can never be the case for a scheme object.)
+
+   The remaining bits of the heap objects form the pointer to the heap
+   cell.  The remaining bits of the small integers form the integer's
+   value and sign.  Thus, the only scheme objects for which a further
+   subdivision is of interest are the ones with tc3==100.
+
+   tc8 (for objects with tc3==100):
+     00000-100:  special objects ('flags')
+     00001-100:  characters
+     00010-100:  unused
+     00011-100:  unused
+
+
+   Summary of type codes on the heap
+
+   Here is a summary of tagging in scm_t_bits values as they might occur
+   in the first scm_t_bits variable of a heap cell.
+
+   tc1:
+     0:  the cell belongs to a pair.
+     1:  the cell belongs to a non-pair.
+
+   tc2:
+     00:  the cell belongs to a pair with no short integer in its car.
+     01:  the cell belongs to a non-pair (struct or some other heap object).
+     10:  the cell belongs to a pair with a short integer in its car.
+     11:  the cell belongs to a non-pair (closure or some other heap object).
+
+   tc3:
+     000:  the cell belongs to a pair with a heap object in its car.
+     001:  the cell belongs to a struct
+     010:  the cell belongs to a pair with an even short integer in its car.
+     011:  the cell belongs to a closure
+     100:  the cell belongs to a pair with a non-integer immediate in its car.
+     101:  the cell belongs to some other heap object.
+     110:  the cell belongs to a pair with an odd short integer in its car.
+     111:  the cell belongs to some other heap object.
+
+   tc7 (for tc3==1x1):
+     See below for the list of types.  Three special tc7-codes are of
+     interest: numbers, ports and smobs in fact each represent
+     collections of types, which are subdivided using tc16-codes.
+
+   tc16 (for tc7==scm_tc7_smob):
+     The largest part of the space of smob types is not subdivided in a
+     predefined way, since smobs can be added arbitrarily by user C
+     code.  */
+
+
+
+/* Checking if a SCM variable holds an immediate or a heap object.  This
+   check can either be performed by checking for tc3==000 or tc3==00x,
+   since for a SCM variable it is known that tc1==0.  */
+#define SCM_IMP(x) 		(6 & SCM_UNPACK (x))
+#define SCM_NIMP(x) 		(!SCM_IMP (x))
+#define SCM_HEAP_OBJECT_P(x)    (SCM_NIMP (x))
+
+/* Checking if a SCM variable holds an immediate integer: See numbers.h
+   for the definition of the following macros: SCM_I_FIXNUM_BIT,
+   SCM_MOST_POSITIVE_FIXNUM, SCM_I_INUMP, SCM_I_MAKINUM, SCM_I_INUM.  */
+
+/* Checking if a SCM variable holds a pair (for historical reasons, in
+   Guile also known as a cons-cell): This is done by first checking that
+   the SCM variable holds a heap object, and second, by checking that
+   tc1==0 holds for the SCM_CELL_TYPE of the SCM variable.  */
+#define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
+
+
+
+/* Definitions for tc2: */
+
+#define scm_tc2_int              2
+
+
+/* Definitions for tc3: */
+
+#define SCM_ITAG3(x) 		 (7 & SCM_UNPACK (x))
+#define SCM_TYP3(x) 		 (7 & SCM_CELL_TYPE (x))
+
+#define scm_tc3_cons	 	 0
+#define scm_tc3_struct    	 1
+#define scm_tc3_int_1		 (scm_tc2_int + 0)
+#define scm_tc3_unused		 3
+#define scm_tc3_imm24		 4
+#define scm_tc3_tc7_1		 5
+#define scm_tc3_int_2		 (scm_tc2_int + 4)
+#define scm_tc3_tc7_2		 7
+
+
+/* Definitions for tc7: */
+
+#define SCM_ITAG7(x) 		(0x7f & SCM_UNPACK (x))
+#define SCM_TYP7(x) 		(0x7f & SCM_CELL_TYPE (x))
+#define SCM_HAS_HEAP_TYPE(x, type, tag)                         \
+  (SCM_NIMP (x) && type (x) == (tag))
+#define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
+
+/* These type codes form part of the ABI and cannot be changed in a
+   stable series.  The low bits of each must have the tc3 of a heap
+   object type code (see above).  If you do change them in a development
+   series, change them also in (system vm assembler) and (system base
+   types).  Bonus points if you change the build to define these tag
+   values in only one place!  */
+
+#define scm_tc7_symbol		0x05
+#define scm_tc7_variable        0x07
+#define scm_tc7_vector		0x0d
+#define scm_tc7_wvect		0x0f
+#define scm_tc7_string		0x15
+#define scm_tc7_number		0x17
+#define scm_tc7_hashtable	0x1d
+#define scm_tc7_pointer		0x1f
+#define scm_tc7_fluid		0x25
+#define scm_tc7_stringbuf       0x27
+#define scm_tc7_dynamic_state	0x2d
+#define scm_tc7_frame		0x2f
+#define scm_tc7_keyword		0x35
+#define scm_tc7_atomic_box	0x37
+#define scm_tc7_syntax		0x3d
+#define scm_tc7_values		0x3f
+#define scm_tc7_program		0x45
+#define scm_tc7_vm_cont		0x47
+#define scm_tc7_bytevector	0x4d
+#define scm_tc7_unused_4f	0x4f
+#define scm_tc7_weak_set	0x55
+#define scm_tc7_weak_table	0x57
+#define scm_tc7_array		0x5d
+#define scm_tc7_bitvector	0x5f
+#define scm_tc7_unused_65	0x65
+#define scm_tc7_unused_67	0x67
+#define scm_tc7_unused_6d	0x6d
+#define scm_tc7_unused_6f	0x6f
+#define scm_tc7_unused_75	0x75
+#define scm_tc7_smob		0x77
+#define scm_tc7_port		0x7d
+#define scm_tc7_unused_7f	0x7f
+
+
+/* Definitions for tc16: */
+#define SCM_TYP16(x) 		(0xffff & SCM_CELL_TYPE (x))
+#define SCM_HAS_TYP16(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP16, tag))
+#define SCM_TYP16_PREDICATE(tag, x) (SCM_HAS_TYP16 (x, tag))
+
+
+
+
+/* Immediate values (besides fixnums).  */
+
+enum scm_tc8_tags
+{
+  scm_tc8_flag = scm_tc3_imm24 + 0x00,  /* special objects ('flags') */
+  scm_tc8_char = scm_tc3_imm24 + 0x08,  /* characters */
+  scm_tc8_unused_0 = scm_tc3_imm24 + 0x10,
+  scm_tc8_unused_1 = scm_tc3_imm24 + 0x18
+};
+
+#define SCM_ITAG8(X)		(SCM_UNPACK (X) & 0xff)
+#define SCM_MAKE_ITAG8_BITS(X, TAG) (((X) << 8) + TAG)
+#define SCM_MAKE_ITAG8(X, TAG)	(SCM_PACK (SCM_MAKE_ITAG8_BITS (X, TAG)))
+#define SCM_ITAG8_DATA(X)	(SCM_UNPACK (X) >> 8)
+
+
+
+/* Flags (special objects).  The indices of the flags must agree with
+   the declarations in print.c: iflagnames.  */
+
+#define SCM_IFLAGP(n)    (SCM_ITAG8 (n) == scm_tc8_flag)
+#define SCM_MAKIFLAG_BITS(n)  (SCM_MAKE_ITAG8_BITS ((n), scm_tc8_flag))
+#define SCM_IFLAGNUM(n)  (SCM_ITAG8_DATA (n))
+
+/*
+   IMPORTANT NOTE regarding IFLAG numbering!!!
+
+   Several macros depend upon careful IFLAG numbering of SCM_BOOL_F,
+   SCM_BOOL_T, SCM_ELISP_NIL, SCM_EOL, and the two SCM_XXX_*_DONT_USE
+   constants.  In particular:
+
+   - SCM_BOOL_F and SCM_BOOL_T must differ in exactly one bit position.
+     (used to implement scm_is_bool_and_not_nil, aka scm_is_bool)
+
+   - SCM_ELISP_NIL and SCM_BOOL_F must differ in exactly one bit
+     position.  (used to implement scm_is_false_or_nil and
+     scm_is_true_and_not_nil)
+
+   - SCM_ELISP_NIL and SCM_EOL must differ in exactly one bit position.
+     (used to implement scm_is_null_or_nil)
+
+   - SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL,
+     SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE must all be equal except for
+     two bit positions.  (used to implement scm_is_lisp_false)
+
+   - SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T,
+     SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0 must all be equal except for two
+     bit positions.  (used to implement scm_is_bool_or_nil)
+
+   These properties allow the aforementioned macros to be implemented by
+   bitwise ANDing with a mask and then comparing with a constant, using
+   as a common basis the macro SCM_MATCHES_BITS_IN_COMMON, defined
+   below.  The properties are checked at compile-time using `verify'
+   macros near the top of boolean.c and pairs.c.  */
+#define SCM_BOOL_F_BITS		SCM_MAKIFLAG_BITS (0)
+#define SCM_ELISP_NIL_BITS	SCM_MAKIFLAG_BITS (1)
+
+#define SCM_BOOL_F		SCM_PACK (SCM_BOOL_F_BITS)
+#define SCM_ELISP_NIL		SCM_PACK (SCM_ELISP_NIL_BITS)
+
+#ifdef BUILDING_LIBGUILE
+#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE	SCM_MAKIFLAG_BITS (2)
+#endif
+
+#define SCM_EOL_BITS		SCM_MAKIFLAG_BITS (3)
+#define SCM_BOOL_T_BITS 	SCM_MAKIFLAG_BITS (4)
+
+#define SCM_EOL			SCM_PACK (SCM_EOL_BITS)
+#define SCM_BOOL_T 		SCM_PACK (SCM_BOOL_T_BITS)
+
+#ifdef BUILDING_LIBGUILE
+#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0	SCM_MAKIFLAG_BITS (5)
+#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1	SCM_MAKIFLAG_BITS (6)
+#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2	SCM_MAKIFLAG_BITS (7)
+#endif
+
+#define SCM_UNSPECIFIED_BITS	SCM_MAKIFLAG_BITS (8)
+#define SCM_UNDEFINED_BITS	SCM_MAKIFLAG_BITS (9)
+#define SCM_EOF_VAL_BITS 	SCM_MAKIFLAG_BITS (10)
+
+#define SCM_UNSPECIFIED		SCM_PACK (SCM_UNSPECIFIED_BITS)
+#define SCM_UNDEFINED	 	SCM_PACK (SCM_UNDEFINED_BITS)
+#define SCM_EOF_VAL 		SCM_PACK (SCM_EOF_VAL_BITS)
+
+#define SCM_UNBNDP(x)		(scm_is_eq ((x), SCM_UNDEFINED))
+
+/* SCM_MATCHES_BITS_IN_COMMON(x,a,b) returns 1 if and only if x matches
+   both a and b in every bit position where a and b are equal; otherwise
+   it returns 0.  Bit positions where a and b differ are ignored.
+
+   This is used to efficiently compare against two values which differ
+   in exactly one bit position, or against four values which differ in
+   exactly two bit positions.  It is the basis for the following macros:
+
+     scm_is_null_or_nil,
+     scm_is_false_or_nil,
+     scm_is_true_and_not_nil,
+     scm_is_lisp_false,
+     scm_is_lisp_true,
+     scm_is_bool_and_not_nil (aka scm_is_bool)
+     scm_is_bool_or_nil.  */
+#define SCM_MATCHES_BITS_IN_COMMON(x,a,b)				\
+  ((SCM_UNPACK(x) & ~(SCM_UNPACK(a) ^ SCM_UNPACK(b))) ==		\
+   (SCM_UNPACK(a) & SCM_UNPACK(b)))
+
+/* These macros are used for compile-time verification that the
+   constants have the properties needed for the above macro to work
+   properly.  */
+#ifdef BUILDING_LIBGUILE
+#define SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED(x)  ((x) & ((x)-1))
+#define SCM_HAS_EXACTLY_ONE_BIT_SET(x)					\
+  ((x) != 0 && SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x) == 0)
+#define SCM_HAS_EXACTLY_TWO_BITS_SET(x)					\
+  (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x)))
+
+#define SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b)		\
+  (SCM_HAS_EXACTLY_ONE_BIT_SET ((a) ^ (b)))
+#define SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d)		\
+  (SCM_HAS_EXACTLY_TWO_BITS_SET (((a) ^ (b)) |                          \
+                                 ((b) ^ (c)) |                          \
+                                 ((c) ^ (d))))
+#endif /* BUILDING_LIBGUILE */
+
+
+
+
+/* Dispatching aids:
+
+   When switching on SCM_TYP7 of a SCM value, use these fake case
+   labels to catch types that use fewer than 7 bits for tagging.  */
+
+/* Pairs with immediate values in the CAR.  */
+#define scm_tcs_cons_imcar \
+       scm_tc2_int + 0:   case scm_tc2_int + 4:   case scm_tc3_imm24 + 0:\
+  case scm_tc2_int + 8:   case scm_tc2_int + 12:  case scm_tc3_imm24 + 8:\
+  case scm_tc2_int + 16:  case scm_tc2_int + 20:  case scm_tc3_imm24 + 16:\
+  case scm_tc2_int + 24:  case scm_tc2_int + 28:  case scm_tc3_imm24 + 24:\
+  case scm_tc2_int + 32:  case scm_tc2_int + 36:  case scm_tc3_imm24 + 32:\
+  case scm_tc2_int + 40:  case scm_tc2_int + 44:  case scm_tc3_imm24 + 40:\
+  case scm_tc2_int + 48:  case scm_tc2_int + 52:  case scm_tc3_imm24 + 48:\
+  case scm_tc2_int + 56:  case scm_tc2_int + 60:  case scm_tc3_imm24 + 56:\
+  case scm_tc2_int + 64:  case scm_tc2_int + 68:  case scm_tc3_imm24 + 64:\
+  case scm_tc2_int + 72:  case scm_tc2_int + 76:  case scm_tc3_imm24 + 72:\
+  case scm_tc2_int + 80:  case scm_tc2_int + 84:  case scm_tc3_imm24 + 80:\
+  case scm_tc2_int + 88:  case scm_tc2_int + 92:  case scm_tc3_imm24 + 88:\
+  case scm_tc2_int + 96:  case scm_tc2_int + 100: case scm_tc3_imm24 + 96:\
+  case scm_tc2_int + 104: case scm_tc2_int + 108: case scm_tc3_imm24 + 104:\
+  case scm_tc2_int + 112: case scm_tc2_int + 116: case scm_tc3_imm24 + 112:\
+  case scm_tc2_int + 120: case scm_tc2_int + 124: case scm_tc3_imm24 + 120
+
+/* Pairs with heap objects in the CAR.  */
+#define scm_tcs_cons_nimcar \
+       scm_tc3_cons + 0:\
+  case scm_tc3_cons + 8:\
+  case scm_tc3_cons + 16:\
+  case scm_tc3_cons + 24:\
+  case scm_tc3_cons + 32:\
+  case scm_tc3_cons + 40:\
+  case scm_tc3_cons + 48:\
+  case scm_tc3_cons + 56:\
+  case scm_tc3_cons + 64:\
+  case scm_tc3_cons + 72:\
+  case scm_tc3_cons + 80:\
+  case scm_tc3_cons + 88:\
+  case scm_tc3_cons + 96:\
+  case scm_tc3_cons + 104:\
+  case scm_tc3_cons + 112:\
+  case scm_tc3_cons + 120
+
+/* Structs.  */
+#define scm_tcs_struct \
+       scm_tc3_struct + 0:\
+  case scm_tc3_struct + 8:\
+  case scm_tc3_struct + 16:\
+  case scm_tc3_struct + 24:\
+  case scm_tc3_struct + 32:\
+  case scm_tc3_struct + 40:\
+  case scm_tc3_struct + 48:\
+  case scm_tc3_struct + 56:\
+  case scm_tc3_struct + 64:\
+  case scm_tc3_struct + 72:\
+  case scm_tc3_struct + 80:\
+  case scm_tc3_struct + 88:\
+  case scm_tc3_struct + 96:\
+  case scm_tc3_struct + 104:\
+  case scm_tc3_struct + 112:\
+  case scm_tc3_struct + 120
+
+
+
+
+/* If SCM_ENABLE_DEPRECATED is set to 1, deprecated code will be
+   included in Guile, as well as some functions to issue run-time
+   warnings about uses of deprecated functions.  */
+#ifndef SCM_ENABLE_DEPRECATED
+#define SCM_ENABLE_DEPRECATED 0
+#endif
+
+
+
+/* SCM_API is a macro prepended to all function and data definitions
+   which should be exported from libguile. */
+#if defined BUILDING_LIBGUILE && defined HAVE_VISIBILITY
+# define SCM_API extern __attribute__((__visibility__("default")))
+#elif defined BUILDING_LIBGUILE && defined _MSC_VER
+# define SCM_API __declspec(dllexport) extern
+#elif defined _MSC_VER
+# define SCM_API __declspec(dllimport) extern
+#else
+# define SCM_API extern
+#endif
+
+/* The SCM_INTERNAL macro makes it possible to explicitly declare a
+   function as having "internal" linkage.  However our current tack on
+   this problem is to use GCC 4's -fvisibility=hidden, making functions
+   internal by default, and then SCM_API marks them for export.  */
+#define SCM_INTERNAL  extern
+
+/* The SCM_DEPRECATED macro is used in declarations of deprecated
+   functions or variables.  Defining `SCM_BUILDING_DEPRECATED_CODE'
+   allows deprecated functions to be implemented in terms of deprecated
+   functions, and allows deprecated functions to be referred to by
+   `scm_c_define_gsubr ()'.  */
+#if !defined (SCM_BUILDING_DEPRECATED_CODE) && defined __GNUC__
+# define SCM_DEPRECATED  SCM_API __attribute__ ((__deprecated__))
+#else
+# define SCM_DEPRECATED  SCM_API
+#endif
+
+/* The SCM_NORETURN macro indicates that a function will never return.
+   Examples:
+     1) int foo (char arg) SCM_NORETURN;  */
+#ifdef __GNUC__
+# define SCM_NORETURN __attribute__ ((__noreturn__))
+#else
+# define SCM_NORETURN
+#endif
+
+/* The SCM_UNUSED macro indicates that a function, function argument or
+   variable may potentially be unused.
+   Examples:
+     1) static int unused_function (char arg) SCM_UNUSED;
+     2) int foo (char unused_argument SCM_UNUSED);
+     3) int unused_variable SCM_UNUSED;  */
+#ifdef __GNUC__
+# define SCM_UNUSED __attribute__ ((unused))
+#else
+# define SCM_UNUSED
+#endif
+
+/* The SCM_MALLOC macro can be used in function declarations to tell the
+   compiler that a function may be treated as if any non-NULL pointer it
+   returns cannot alias any other pointer valid when the function
+   returns.  */
+#ifdef __GNUC__
+# define SCM_MALLOC  __attribute__ ((__malloc__))
+#else
+# define SCM_MALLOC
+#endif
+
+/* The SCM_EXPECT macros provide branch prediction hints to the
+   compiler.  To use only in places where the result of the expression
+   under "normal" circumstances is known.  */
+#ifdef __GNUC__
+# define SCM_EXPECT    __builtin_expect
+#else
+# define SCM_EXPECT(_expr, _value) (_expr)
+#endif
+
+#define SCM_LIKELY(_expr)    SCM_EXPECT ((_expr), 1)
+#define SCM_UNLIKELY(_expr)  SCM_EXPECT ((_expr), 0)
+
+/* The SCM_ALIGNED macro, when defined, can be used to instruct the
+   compiler to honor the given alignment constraint.  Sun Studio
+   supports alignment since Sun Studio 12.  */
+#if defined __GNUC__ || (defined( __SUNPRO_C ) && (__SUNPRO_C - 0 >= 0x590))
+# define SCM_ALIGNED(x)  __attribute__ ((aligned (x)))
+#elif defined __INTEL_COMPILER
+# define SCM_ALIGNED(x)  __declspec (align (x))
+#else
+# undef SCM_ALIGNED
+#endif
+
+/* Thread-local storage (TLS).  */
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+# define SCM_THREAD_LOCAL __thread
+#else
+# define SCM_THREAD_LOCAL
+#endif
+
+
+
+
+/* The type of subrs, i.e., Scheme procedures implemented in C.  Empty
+   function declarators are used internally for pointers to functions of
+   any arity.  However, these are equivalent to `(void)' in C++, are
+   obsolescent as of C99, and trigger `strict-prototypes' GCC warnings
+   (bug #23681).  */
+#ifdef BUILDING_LIBGUILE
+typedef SCM (* scm_t_subr) ();
+#else
+typedef void *scm_t_subr;
+#endif
+
+typedef struct scm_dynamic_state scm_t_dynamic_state;
+typedef struct scm_print_state scm_print_state;
+typedef struct scm_dynstack scm_t_dynstack;
+typedef int32_t scm_t_wchar;
+struct scm_frame;
+struct scm_vm;
+union scm_vm_stack_element;
+typedef struct scm_thread scm_thread;
+
+
+
+#ifdef CHAR_BIT
+# define SCM_CHAR_BIT CHAR_BIT
+#else
+# define SCM_CHAR_BIT 8
+#endif
+
+#ifdef LONG_BIT
+# define SCM_LONG_BIT LONG_BIT
+#else
+# define SCM_LONG_BIT (SCM_SIZEOF_LONG * 8)
+#endif
+
+
+
+/* Cast pointer through (void *) in order to avoid compiler warnings
+   when strict aliasing is enabled */
+typedef long SCM_STACKITEM;
+#define SCM_STACK_PTR(ptr) ((SCM_STACKITEM *) (void *) (ptr))
+
+
+#endif  /* SCM_SCM_H */
diff --git a/libguile/scmconfig.h.top b/libguile/scmconfig.h.top
index b84660b6c..13b789f3b 100644
--- a/libguile/scmconfig.h.top
+++ b/libguile/scmconfig.h.top
@@ -1,17 +1,18 @@
-/* Copyright (C) 2003, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2003,2006,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index a870f5687..d1daf04b4 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006,
- *   2007, 2008, 2009, 2011, 2013, 2014, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2002,2004,2006-2009,2011,2013-2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -41,15 +41,23 @@
 
 #include <full-write.h>
 
-#include "libguile/_scm.h"
-
-#include "libguile/async.h"
-#include "libguile/eval.h"
-#include "libguile/vectors.h"
-#include "libguile/threads.h"
-
-#include "libguile/validate.h"
-#include "libguile/scmsigs.h"
+#include "async.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "feature.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+#include "syscalls.h"
+#include "threads.h"
+#include "variable.h"
+#include "vectors.h"
+
+#include "scmsigs.h"
 
 
 
@@ -92,7 +100,7 @@ static SCM signal_handler_asyncs;
 static SCM signal_handler_threads;
 
 /* The signal delivery thread.  */
-scm_i_thread *scm_i_signal_delivery_thread = NULL;
+scm_thread *scm_i_signal_delivery_thread = NULL;
 
 /* The mutex held when launching the signal delivery thread.  */
 static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
@@ -235,7 +243,7 @@ static SIGRETTYPE
 take_signal (int signum)
 {
   SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, signum);
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   if (scm_is_false (SCM_CDR (cell)))
     {
@@ -755,12 +763,6 @@ scm_init_scmsigs ()
 #endif
 #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
 
-#include "libguile/scmsigs.x"
+#include "scmsigs.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
index fce372849..1837833c3 100644
--- a/libguile/scmsigs.h
+++ b/libguile/scmsigs.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_SCMSIGS_H
 #define SCM_SCMSIGS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000,2002,2006-2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
-#include "libguile/threads.h"
+#include "libguile/scm.h"
 
 
 
@@ -46,12 +44,6 @@ SCM_INTERNAL void scm_init_scmsigs (void);
 SCM_INTERNAL void scm_i_close_signal_pipe (void);
 SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void);
 
-SCM_INTERNAL scm_i_thread *scm_i_signal_delivery_thread;
+SCM_INTERNAL scm_thread *scm_i_signal_delivery_thread;
 
 #endif  /* SCM_SCMSIGS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/script.c b/libguile/script.c
index 63fbb0f3f..6430484a3 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1994-1998, 2000-2011, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1994-1998,2000-2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* "script.c" argv tricks for `#!' scripts.
    Authors: Aubrey Jaffer and Jim Blandy */
@@ -23,92 +24,36 @@
 #  include <config.h>
 #endif
 
+#include <ctype.h>
+#include <errno.h>
 #include <localcharset.h>
-#include <stdlib.h>
 #include <stdio.h>
-#include <errno.h>
-#include <ctype.h>
-#include <uniconv.h>
-
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/feature.h"
-#include "libguile/load.h"
-#include "libguile/read.h"
-#include "libguile/script.h"
-#include "libguile/strings.h"
-#include "libguile/strports.h"
-#include "libguile/validate.h"
-#include "libguile/version.h"
-#include "libguile/vm.h"
-
-#ifdef HAVE_STRING_H
+#include <stdlib.h>
 #include <string.h>
-#endif
-
+#include <uniconv.h>
 #include <unistd.h>		/* for X_OK define */
 
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
 
-/* Concatentate str2 onto str1 at position n and return concatenated
-   string if file exists; 0 otherwise. */
-
-static char *
-scm_cat_path (char *str1, const char *str2, long n)
-{
-  if (!n)
-    n = strlen (str2);
-  if (str1)
-    {
-      size_t len = strlen (str1);
-      str1 = (char *) realloc (str1, (size_t) (len + n + 1));
-      if (!str1)
-	return 0L;
-      strncat (str1 + len, str2, n);
-      return str1;
-    }
-  str1 = (char *) scm_malloc ((size_t) (n + 1));
-  if (!str1)
-    return 0L;
-  str1[0] = 0;
-  strncat (str1, str2, n);
-  return str1;
-}
+#include "eval.h"
+#include "feature.h"
+#include "fluids.h"
+#include "load.h"
+#include "modules.h"
+#include "pairs.h"
+#include "read.h"
+#include "strings.h"
+#include "strports.h"
+#include "throw.h"
+#include "version.h"
+#include "vm.h"
 
-#if 0 
-static char *
-scm_try_path (char *path)
-{
-  FILE *f;
-  /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
-  if (!path)
-    return 0L;
-  SCM_SYSCALL (f = fopen (path, "r");
-    );
-  if (f)
-    {
-      fclose (f);
-      return path;
-    }
-  free (path);
-  return 0L;
-}
+#include "script.h"
 
-static char *
-scm_sep_init_try (char *path, const char *sep, const char *initname)
-{
-  if (path)
-    path = scm_cat_path (path, sep, 0L);
-  if (path)
-    path = scm_cat_path (path, initname, 0L);
-  return scm_try_path (path);
-}
-#endif 
 
-#ifndef LINE_INCREMENTORS
-#define LINE_INCREMENTORS  '\n'
+#ifndef WHITE_SPACES
 #ifdef MSDOS
 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
 #else
@@ -116,48 +61,6 @@ scm_sep_init_try (char *path, const char *sep, const char *initname)
 #endif /* def MSDOS */
 #endif /* ndef LINE_INCREMENTORS */
 
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 80
-#endif /* ndef MAXPATHLEN */
-#ifndef X_OK
-#define X_OK 1
-#endif /* ndef X_OK */
-
-char *
-scm_find_executable (const char *name)
-{
-  char tbuf[MAXPATHLEN];
-  int i = 0, c;
-  FILE *f;
-
-  /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
-  if (access (name, X_OK))
-    return 0L;
-  f = fopen (name, "r");
-  if (!f)
-    return 0L;
-  if ((fgetc (f) == '#') && (fgetc (f) == '!'))
-    {
-      while (1)
-	switch (c = fgetc (f))
-	  {
-	  case /*WHITE_SPACES */ ' ':
-	  case '\t':
-	  case '\r':
-	  case '\f':
-	  case EOF:
-	    tbuf[i] = 0;
-	    fclose (f);
-	    return scm_cat_path (0L, tbuf, 0L);
-	  default:
-	    tbuf[i++] = c;
-	    break;
-	  }
-    }
-  fclose (f);
-  return scm_cat_path (0L, name, 0L);
-}
-
 
 /* Read a \nnn-style escape.  We've just read the backslash.  */
 static int
@@ -459,11 +362,5 @@ scm_shell (int argc, char **argv)
 void
 scm_init_script ()
 {
-#include "libguile/script.x"
+#include "script.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/script.h b/libguile/script.h
index cf0162a40..51c3c618b 100644
--- a/libguile/script.h
+++ b/libguile/script.h
@@ -1,36 +1,30 @@
-/* classes: h_files */
-
 #ifndef SCM_SCRIPT_H
 #define SCM_SCRIPT_H
 
-/* Copyright (C) 1997,1998,2000, 2006, 2008, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1997-1998,2000,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
-SCM_API char *scm_find_executable (const char *name);
-SCM_API char *scm_find_impl_file (char *exec_path,
-				  const char *generic_name,
-				  const char *initname,
-				  const char *sep);
 SCM_API char **scm_get_meta_args (int argc, char **argv);
 SCM_API int scm_count_argv (char **argv);
 SCM_API void scm_shell_usage (int fatal, char *message);
@@ -41,9 +35,3 @@ SCM_INTERNAL void scm_i_set_boot_program_arguments (int argc, char *argv[]);
 SCM_INTERNAL void scm_init_script (void);
 
 #endif  /* SCM_SCRIPT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/simpos.c b/libguile/simpos.c
index 38d8dfde1..2a292eeff 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
- *   2010, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003-2004,2009-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -27,11 +27,12 @@
 #include <stdlib.h>  /* for getenv, system, exit, free */
 #include <unistd.h>  /* for _exit */
 
-#include "libguile/_scm.h"
+#include "boolean.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "strings.h"
 
-#include "libguile/strings.h"
-#include "libguile/validate.h"
-#include "libguile/simpos.h"
+#include "simpos.h"
 
 
 
@@ -137,12 +138,6 @@ SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
 void
 scm_init_simpos ()
 {
-#include "libguile/simpos.x"
+#include "simpos.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/simpos.h b/libguile/simpos.h
index 9ebb0c52b..4ac3ceb73 100644
--- a/libguile/simpos.h
+++ b/libguile/simpos.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_SIMPOS_H
 #define SCM_SIMPOS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000, 2006, 2008, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000,2006,2008,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -35,9 +34,3 @@ SCM_INTERNAL int scm_getenv_int (const char *var, int def);
 SCM_INTERNAL void scm_init_simpos (void);
 
 #endif  /* SCM_SIMPOS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/smob.c b/libguile/smob.c
index 43ea613de..8e4da9adb 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,42 +1,45 @@
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2003-2004,2006,2009-2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
+#include <errno.h>
 #include <stdio.h>
 #include <stdlib.h>
-#include <errno.h>
 
-#include "libguile/_scm.h"
+#include "async.h"
+#include "bdw-gc.h"
+#include "finalizers.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "instructions.h"
+#include "numbers.h"
+#include "ports.h"
+#include "programs.h"
 
-#include "libguile/async.h"
-#include "libguile/goops.h"
-#include "libguile/instructions.h"
-#include "libguile/programs.h"
+#include "smob.h"
 
-#include "libguile/smob.h"
-
-#include "libguile/bdw-gc.h"
 #include <gc/gc_mark.h>
 
 
@@ -511,9 +514,3 @@ scm_smob_prehistory ()
   finalized_smob_tc16 = scm_make_smob_type ("finalized smob", 0);
   if (SCM_TC2SMOBNUM (finalized_smob_tc16) != 0) abort ();
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/smob.h b/libguile/smob.h
index 561a6d124..d137b3278 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -1,31 +1,32 @@
-/* classes: h_files */
-
 #ifndef SCM_SMOB_H
 #define SCM_SMOB_H
 
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2009,
- *   2010, 2011, 2012, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2004,2006,2009-2012,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include <libguile/gc.h>
+#include "libguile/inline.h"
 #include "libguile/print.h"
+#include <libguile/snarf.h>
 
 
 
@@ -54,6 +55,12 @@ typedef struct scm_smob_descriptor
 #define SCM_SMOB_DESCRIPTOR(x)		(scm_smobs[SCM_SMOBNUM (x)])
 #define SCM_SMOB_APPLICABLE_P(x)	(SCM_SMOB_DESCRIPTOR (x).apply)
 
+#define SCM_VALIDATE_SMOB(pos, obj, type) \
+  do { \
+    SCM_ASSERT (SCM_SMOB_PREDICATE (scm_tc16_ ## type, obj), \
+                obj, pos, FUNC_NAME); \
+  } while (0)
+
 /* Maximum number of SMOB types.  */
 #define SCM_I_MAX_SMOB_TYPE_COUNT  256
 
@@ -63,6 +70,57 @@ SCM_API scm_smob_descriptor scm_smobs[];
 
 
 
+#define SCM_SMOB(tag, scheme_name, size) \
+SCM_SNARF_HERE(static scm_t_bits tag) \
+SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
+
+#define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
+SCM_SNARF_HERE(scm_t_bits tag) \
+SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
+
+#define SCM_SMOB_MARK(tag, c_name, arg) \
+SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
+SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
+
+#define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
+SCM_SNARF_HERE(SCM c_name(SCM arg)) \
+SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
+
+#define SCM_SMOB_FREE(tag, c_name, arg) \
+SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
+SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
+
+#define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
+SCM_SNARF_HERE(size_t c_name(SCM arg)) \
+SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
+
+#define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
+SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
+SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
+
+#define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
+SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
+SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
+
+#define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
+SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
+SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
+
+#define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
+SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
+SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
+
+#define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
+SCM_SNARF_HERE(static SCM c_name arglist) \
+SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
+
+#define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
+SCM_SNARF_HERE(SCM c_name arglist) \
+SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
+
+
+
+
 SCM_API SCM scm_i_new_smob (scm_t_bits tc, scm_t_bits);
 SCM_API SCM scm_i_new_double_smob (scm_t_bits tc, scm_t_bits,
                                    scm_t_bits, scm_t_bits);
@@ -201,9 +259,3 @@ SCM_API SCM scm_make_smob (scm_t_bits tc);
 SCM_API void scm_smob_prehistory (void);
 
 #endif  /* SCM_SMOB_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/snarf.h b/libguile/snarf.h
index c9c3a587c..54272d5c9 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -1,35 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_SNARF_H
 #define SCM_SNARF_H
 
-/* Copyright (C) 1995-2004, 2006, 2009-2011, 2013, 2014, 2017, 2018
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2004,2006,2009-2011,2013-2014,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-/* Macros for snarfing initialization actions from C source. */
 
-/* Casting to a function that can take any number of arguments.  */
-#define SCM_FUNC_CAST_ARBITRARY_ARGS  scm_t_subr
+#include <libguile/scm.h>
 
 
+/* Macros for snarfing initialization actions from C source. */
+
 #ifdef SCM_ALIGNED
 /* We support static allocation of some `SCM' objects.  */
 # define SCM_SUPPORT_STATIC_ALLOCATION
@@ -85,248 +83,23 @@ DOCSTRING ^^ }
 # endif
 #endif
 
-#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(\
-scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
-                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
-)\
-SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
-
-/* Always use the generic subr case.  */
-#define SCM_DEFINE SCM_DEFINE_GSUBR
-
-
-#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
-static SCM g_ ## FNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(\
-g_ ## FNAME = SCM_PACK (0); \
-scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
-                    		 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
-				 &g_ ## FNAME); \
-)\
-SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
-
-#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(\
-scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
-                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
-scm_c_export (s_ ## FNAME, NULL); \
-)\
-SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
-
-#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
-SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
-SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
-                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
-
-#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
-SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
-SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
-                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
-SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
-               "implemented by the C function \"" #CFN "\"")
-
-#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF)  \
-SCM_SNARF_HERE(\
-SCM_UNUSED static const char RANAME[]=STR;\
-static SCM GF \
-)SCM_SNARF_INIT(\
-GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
-scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
-                                 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
-)
-
-#ifdef SCM_SUPPORT_STATIC_ALLOCATION
-
-# define SCM_SYMBOL(c_name, scheme_name)				\
-SCM_SNARF_HERE(								\
-  SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name);	\
-  static SCM c_name)							\
-SCM_SNARF_INIT(								\
-  c_name = scm_string_to_symbol (scm_i_paste (c_name, _string))		\
-)
-
-# define SCM_GLOBAL_SYMBOL(c_name, scheme_name)				\
-SCM_SNARF_HERE(								\
-  SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name);	\
-  SCM c_name)								\
-SCM_SNARF_INIT(								\
-  c_name = scm_string_to_symbol (scm_i_paste (c_name, _string))		\
-)
-
-#else /* !SCM_SUPPORT_STATIC_ALLOCATION */
-
-# define SCM_SYMBOL(c_name, scheme_name)				\
-SCM_SNARF_HERE(static SCM c_name)					\
-SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
-
-# define SCM_GLOBAL_SYMBOL(c_name, scheme_name)				\
-SCM_SNARF_HERE(SCM c_name)						\
-SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
-
-#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
-
-#define SCM_KEYWORD(c_name, scheme_name) \
-SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_from_utf8_keyword (scheme_name))
-
-#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
-SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_from_utf8_keyword (scheme_name))
-
-#define SCM_VARIABLE(c_name, scheme_name) \
-SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
-
-#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
-SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
-
-#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
-SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
-
-#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
-SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
-
-#define SCM_MUTEX(c_name) \
-SCM_SNARF_HERE(static scm_t_mutex c_name) \
-SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
-
-#define SCM_GLOBAL_MUTEX(c_name) \
-SCM_SNARF_HERE(scm_t_mutex c_name) \
-SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
-
-#define SCM_REC_MUTEX(c_name) \
-SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \
-SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
-
-#define SCM_GLOBAL_REC_MUTEX(c_name) \
-SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
-SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
-
-#define SCM_SMOB(tag, scheme_name, size) \
-SCM_SNARF_HERE(static scm_t_bits tag) \
-SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
-
-#define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
-SCM_SNARF_HERE(scm_t_bits tag) \
-SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
-
-#define SCM_SMOB_MARK(tag, c_name, arg) \
-SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
-
-#define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
-SCM_SNARF_HERE(SCM c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
-
-#define SCM_SMOB_FREE(tag, c_name, arg) \
-SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
-
-#define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
-SCM_SNARF_HERE(size_t c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
-
-#define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
-SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
-SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
-
-#define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
-SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
-SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
-
-#define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
-SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
-SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
-
-#define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
-SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
-SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
-
-#define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
-SCM_SNARF_HERE(static SCM c_name arglist) \
-SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
-
-#define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
-SCM_SNARF_HERE(SCM c_name arglist) \
-SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
-
 
 /* Low-level snarfing for static memory allocation.  */
 
 #ifdef SCM_SUPPORT_STATIC_ALLOCATION
 
 #define SCM_IMMUTABLE_CELL(c_name, car, cdr)		\
-  static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell			\
-       c_name ## _raw_scell =						\
-  {                                                                     \
-    SCM_PACK (car),                                                     \
-    SCM_PACK (cdr)                                                      \
-  };                                                                    \
-  static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell)
+  static SCM_ALIGNED (8) const SCM c_name ## _raw [2] =			\
+    { SCM_PACK (car), SCM_PACK (cdr) };					\
+  static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw)
 
 #define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr)		\
-  static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell			\
-  c_name ## _raw_cell [2] =						\
-    {									\
-      { SCM_PACK (car), SCM_PACK (cbr) },				\
-      { SCM_PACK (ccr), SCM_PACK (cdr) }				\
-    };									\
-  static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
-
-#define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr)		\
-  static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell                          \
-  c_name ## _raw_cell [2] =						\
-    {									\
-      { SCM_PACK (car), SCM_PACK (cbr) },				\
-      { SCM_PACK (ccr), SCM_PACK (cdr) }				\
-    };									\
-  static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
-
-#define SCM_IMMUTABLE_STRINGBUF(c_name, contents)	\
-  static SCM_UNUSED const				\
-  struct						\
-  {							\
-    scm_t_bits word_0;					\
-    scm_t_bits word_1;					\
-    const char buffer[sizeof (contents)];		\
-  }							\
-  c_name =						\
-    {							\
-      scm_tc7_stringbuf,                                \
-      sizeof (contents) - 1,				\
-      contents						\
-    }
-
-#define SCM_IMMUTABLE_STRING(c_name, contents)				\
-  SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents);	\
-  SCM_IMMUTABLE_DOUBLE_CELL (c_name,					\
-			     scm_tc7_ro_string,				\
-			     (scm_t_bits) &scm_i_paste (c_name,		\
-							_stringbuf),	\
-			     (scm_t_bits) 0,				\
-                             (scm_t_bits) (sizeof (contents) - 1))
-
-#define SCM_IMMUTABLE_POINTER(c_name, ptr)		\
-  SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
-
+  static SCM_ALIGNED (8) const SCM c_name ## _raw [4] =			\
+    { SCM_PACK (car), SCM_PACK (cbr), SCM_PACK (ccr), SCM_PACK (cdr) };	\
+  static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw)
 #endif /* SCM_SUPPORT_STATIC_ALLOCATION */
 
+
 
 /* Documentation.  */
 
@@ -336,9 +109,3 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
 #endif /* SCM_MAGIC_SNARF_DOCS */
 
 #endif  /* SCM_SNARF_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/socket.c b/libguile/socket.c
index 71c17e892..64354f1f1 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1996-1998, 2000-2007, 2009, 2011-2015
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-1998,2000-2007,2009,2011-2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -34,8 +34,8 @@
 #include <string.h>
 #endif
 #include <unistd.h>
-#include <sys/types.h>
 #include <sys/socket.h>
+#include <sys/types.h>
 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
 #include <sys/un.h>
 #endif
@@ -46,22 +46,24 @@
 
 #include <gmp.h>
 
-#include "libguile/_scm.h"
-#include "libguile/arrays.h"
-#include "libguile/feature.h"
-#include "libguile/fports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
-#include "libguile/srfi-13.h"
-
-#include "libguile/validate.h"
-#include "libguile/socket.h"
-
-#if SCM_ENABLE_DEPRECATED == 1
-# include "libguile/deprecation.h"
-#endif
-
+#include "arrays.h"
+#include "async.h"
+#include "bytevectors.h"
+#include "dynwind.h"
+#include "feature.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "vectors.h"
+
+#include "socket.h"
 
 
 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
@@ -161,7 +163,7 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
   \
   for (i = 0; i < 8; i++)\
     {\
-      scm_t_uint8 c = (addr)[i];\
+      uint8_t c = (addr)[i];\
       \
       (addr)[i] = (addr)[15 - i];\
       (addr)[15 - i] = c;\
@@ -174,8 +176,8 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 #else
 #define FLIPCPY_NET_HOST_128(dest, src) \
 { \
-  const scm_t_uint8 *tmp_srcp = (src) + 15; \
-  scm_t_uint8 *tmp_destp = (dest); \
+  const uint8_t *tmp_srcp = (src) + 15; \
+  uint8_t *tmp_destp = (dest); \
   \
   do { \
     *tmp_destp++ = *tmp_srcp--; \
@@ -184,8 +186,8 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 #endif
 
 
-#if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
-#error "Assumption that scm_t_bits <= 128 bits has been violated."
+#if (SIZEOF_UINTPTR_T * SCM_CHAR_BIT) > 128
+#error "Assumption that uintptr_t <= 128 bits has been violated."
 #endif
 
 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
@@ -199,7 +201,7 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 /* convert a 128 bit IPv6 address in network order to a host ordered
    SCM integer.  */
 static SCM
-scm_from_ipv6 (const scm_t_uint8 *src)
+scm_from_ipv6 (const uint8_t *src)
 {
   SCM result = scm_i_mkbig ();
   mpz_import (SCM_I_BIG_MPZ (result),
@@ -215,7 +217,7 @@ scm_from_ipv6 (const scm_t_uint8 *src)
 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
    network order.  */
 static void
-scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
+scm_to_ipv6 (uint8_t dst[16], SCM src)
 {
   if (SCM_I_INUMP (src))
     {
@@ -293,7 +295,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
 		    );
   if (af == AF_INET)
     {
-      scm_t_uint32 addr4;
+      uint32_t addr4;
 
       addr4 = htonl (SCM_NUM2ULONG (2, address));
       result = inet_ntop (af, &addr4, dst, sizeof (dst));
@@ -303,7 +305,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
     {
       char addr6[16];
 
-      scm_to_ipv6 ((scm_t_uint8 *) addr6, address);
+      scm_to_ipv6 ((uint8_t *) addr6, address);
       result = inet_ntop (af, &addr6, dst, sizeof (dst));
     }
 #endif
@@ -332,7 +334,7 @@ SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
 {
   int af;
   char *src;
-  scm_t_uint32 dst[4];
+  uint32_t dst[4];
   int rv, eno;
 
   af = scm_to_int (family);
@@ -357,7 +359,7 @@ SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
     return scm_from_ulong (ntohl (*dst));
 #ifdef HAVE_IPV6
   else if (af == AF_INET6)
-    return scm_from_ipv6 ((scm_t_uint8 *) dst);
+    return scm_from_ipv6 ((uint8_t *) dst);
 #endif
   else
     SCM_MISC_ERROR ("unsupported address family", family);
@@ -715,6 +717,8 @@ SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
    proc is the name of the original procedure.
    size returns the size of the structure allocated.  */
 
+#define MAX(A, B) ((A) >= (B) ? (A) : (B))
+
 static struct sockaddr *
 scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
 		   const char *proc, size_t *size)
@@ -802,7 +806,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
 	   connect/bind etc., to fail.  sun_path is always the last
 	   member of the structure.  */
 	addr_size = sizeof (struct sockaddr_un)
-	  + max (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
+	  + MAX (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
 	soka = (struct sockaddr_un *) scm_malloc (addr_size);
 	memset (soka, 0, addr_size);  /* for sun_len: see sin_len above. */
 	soka->sun_family = AF_UNIX;
@@ -1766,12 +1770,6 @@ scm_init_socket ()
 
   scm_add_feature ("socket");
 
-#include "libguile/socket.x"
+#include "socket.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/socket.h b/libguile/socket.h
index d7c368a22..e2d24b243 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_SOCKET_H
 #define SCM_SOCKET_H
 
-/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000-2001,2004-2006,2008,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -63,9 +62,3 @@ SCM_API struct sockaddr *scm_c_make_socket_address (SCM family, SCM address,
 SCM_API SCM scm_make_socket_address (SCM family, SCM address, SCM args);
 
 #endif  /* SCM_SOCKET_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/sort.c b/libguile/sort.c
index ff7d6634d..05ecee577 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2008, 2009,
- *   2010, 2011, 2012, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2002,2004,2006-2012,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -39,17 +39,20 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/arrays.h"
-#include "libguile/array-map.h"
-#include "libguile/feature.h"
-#include "libguile/vectors.h"
-#include "libguile/async.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/validate.h"
-#include "libguile/sort.h"
+#include "array-map.h"
+#include "arrays.h"
+#include "async.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "feature.h"
+#include "generalized-arrays.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "vectors.h"
+
+#include "sort.h"
 
 /* We have two quicksort variants: one for SCM (#t) arrays and one for
    typed arrays.
@@ -60,14 +63,14 @@
 #define VEC_PARAM   SCM * ra,
 #define GET(i)      ra[(i)*inc]
 #define SET(i, val) ra[(i)*inc] = val
-#include "libguile/quicksort.i.c"
+#include "quicksort.i.c"
 
 #define NAME        quicksorta
 #define INC_PARAM
 #define VEC_PARAM   scm_t_array_handle * const ra,
 #define GET(i)      scm_array_handle_ref (ra, scm_array_handle_pos_1 (ra, i))
 #define SET(i, val) scm_array_handle_set (ra, scm_array_handle_pos_1 (ra, i), val)
-#include "libguile/quicksort.i.c"
+#include "quicksort.i.c"
 
 SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
             (SCM vec, SCM less, SCM startpos, SCM endpos),
@@ -643,13 +646,7 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0,
 void
 scm_init_sort ()
 {
-#include "libguile/sort.x"
+#include "sort.x"
 
   scm_add_feature ("sort");
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/sort.h b/libguile/sort.h
index 3ae86c2f3..f668d7a8b 100644
--- a/libguile/sort.h
+++ b/libguile/sort.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_SORT_H
 #define SCM_SORT_H
 
-/* Copyright (C) 1999,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2000,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -43,9 +42,3 @@ SCM_API SCM scm_sort_list_x (SCM ls, SCM less);
 SCM_INTERNAL void scm_init_sort (void);
 
 #endif  /* SCM_SORT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 14e56bd1c..b644a32a5 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -1,43 +1,51 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2006,
- *   2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2002,2006,2008-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <errno.h>
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/smob.h"
-#include "libguile/alist.h"
-#include "libguile/debug.h"
-#include "libguile/hashtab.h"
-#include "libguile/hash.h"
-#include "libguile/ports.h"
-#include "libguile/gc.h"
+#include "alist.h"
+#include "async.h"
+#include "debug.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "keywords.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "private-options.h"
+#include "smob.h"
+#include "symbols.h"
+#include "weak-table.h"
+
+#include "srcprop.h"
 
-#include "libguile/validate.h"
-#include "libguile/srcprop.h"
-#include "libguile/private-options.h"
 
 
 /* {Source Properties}
@@ -195,6 +203,9 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_VALIDATE_NIM(pos, scm) \
+  SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate")
+
 /* Perhaps this procedure should look through an alist
    and try to make a srcprops-object...? */
 SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
@@ -352,12 +363,6 @@ scm_init_srcprop ()
   scm_last_alist_filename = scm_cons (SCM_EOL,
 				      scm_acons (SCM_EOL, SCM_EOL, SCM_EOL));
 
-#include "libguile/srcprop.x"
+#include "srcprop.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 0252e54a1..b32203c0b 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_SRCPROP_H
 #define SCM_SRCPROP_H
 
-/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010,
- *   2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/boolean.h"
 
 
 
@@ -56,9 +54,3 @@ SCM_INTERNAL void scm_init_srcprop (void);
 
 
 #endif  /* SCM_SRCPROP_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 08a4b22e2..ca812935a 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -1,38 +1,46 @@
 /* srfi-1.c --- SRFI-1 procedures for Guile
- *
- * Copyright (C) 1995-1997, 2000-2003, 2005, 2006, 2008-2011, 2013
- *   2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 1995-1997,2000-2003,2005-2006,2008-2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
+#include <stdarg.h>
 
-#include "libguile/validate.h"
-#include "libguile/list.h"
-#include "libguile/eval.h"
-#include "libguile/srfi-1.h"
+#include "boolean.h"
+#include "eq.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "procs.h"
+#include "values.h"
+#include "vectors.h"
+#include "version.h"
 
-#include <stdarg.h>
+#include "srfi-1.h"
 
 
 /* The intent of this file was to gradually replace those Scheme
@@ -811,12 +819,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
       dropped_tail = new_tail;
     }
   }
-  /* re-use the initial conses for the values list */
-  SCM_SETCAR(kept, SCM_CDR(kept));
-  SCM_SETCDR(kept, dropped);
-  SCM_SETCAR(dropped, SCM_CDR(dropped));
-  SCM_SETCDR(dropped, SCM_EOL);
-  return scm_values(kept);
+  return scm_values_2 (SCM_CDR (kept), SCM_CDR (dropped));
 }
 #undef FUNC_NAME
 
@@ -870,7 +873,7 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
   *tp = SCM_EOL;
   *fp = SCM_EOL;
 
-  return scm_values (scm_list_2 (tlst, flst));
+  return scm_values_2 (tlst, flst);
 }
 #undef FUNC_NAME
 
@@ -947,7 +950,7 @@ void
 scm_init_srfi_1 (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/srfi-1.x"
+#include "srfi-1.x"
 #endif
 }
 
diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h
index 47607bc55..82efaef42 100644
--- a/libguile/srfi-1.h
+++ b/libguile/srfi-1.h
@@ -1,28 +1,28 @@
 /* srfi-1.h --- SRFI-1 procedures for Guile
- *
- * 	Copyright (C) 2002, 2003, 2005, 2006, 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+   Copyright 2002-2003,2005-2006,2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifndef SCM_SRFI_1_H
 #define SCM_SRFI_1_H
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_INTERNAL SCM scm_srfi1_append_reverse (SCM revhead, SCM tail);
 SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 4a9719173..97c372674 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -1,23 +1,21 @@
-/* srfi-13.c --- SRFI-13 procedures for Guile
- *
- * Copyright (C) 2001, 2004-2006, 2008-2013, 2017-2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2004-2006,2008-2013,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
@@ -28,11 +26,20 @@
 #include <unicase.h>
 #include <unictype.h>
 
-#include "libguile.h"
+#include "deprecation.h"
+#include "error.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "procs.h"
+#include "srfi-14.h"
+#include "symbols.h"
+
+#include "srfi-13.h"
 
-#include <libguile/deprecation.h>
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
 
 #define MY_VALIDATE_SUBSTRING_SPEC(pos_str, str,              \
                                    pos_start, start, c_start, \
@@ -3113,22 +3120,6 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
   SCM result;
   size_t idx;
 
-#if SCM_ENABLE_DEPRECATED == 1
-  if (scm_is_string (char_pred))
-    {
-      SCM tmp;
-
-      scm_c_issue_deprecation_warning
-        ("Guile used to use the wrong argument order for string-filter.\n"
-         "This call to string-filter had the arguments in the wrong order.\n"
-         "See SRFI-13 for more details. At some point we will remove this hack.");
-
-      tmp = char_pred;
-      char_pred = s;
-      s = tmp;
-    }
-#endif
-
   MY_VALIDATE_SUBSTRING_SPEC (2, s,
 			      3, start, cstart,
 			      4, end, cend);
@@ -3246,22 +3237,6 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
   SCM result;
   size_t idx;
 
-#if SCM_ENABLE_DEPRECATED == 1
-  if (scm_is_string (char_pred))
-    {
-      SCM tmp;
-
-      scm_c_issue_deprecation_warning
-        ("Guile used to use the wrong argument order for string-delete.\n"
-         "This call to string-filter had the arguments in the wrong order.\n"
-         "See SRFI-13 for more details. At some point we will remove this hack.");
-
-      tmp = char_pred;
-      char_pred = s;
-      s = tmp;
-    }
-#endif
-
   MY_VALIDATE_SUBSTRING_SPEC (2, s,
 			      3, start, cstart,
 			      4, end, cend);
@@ -3385,7 +3360,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
 void
 scm_init_srfi_13 (void)
 {
-#include "libguile/srfi-13.x"
+#include "srfi-13.x"
 }
 
 /* End of srfi-13.c.  */
diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h
index 325e22272..10d473a0c 100644
--- a/libguile/srfi-13.h
+++ b/libguile/srfi-13.h
@@ -2,27 +2,27 @@
 #define SCM_SRFI_13_H
 
 /* srfi-13.c --- SRFI-13 procedures for Guile
- *
- * 	Copyright (C) 2001, 2004, 2006, 2008, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+   Copyright 2001,2004,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_API SCM scm_string_null_p (SCM s);
 SCM_API SCM scm_string_any (SCM pred, SCM s, SCM start, SCM end);
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index a4d71e8eb..bbddb0598 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -1,39 +1,50 @@
-/* srfi-14.c --- SRFI-14 procedures for Guile
- *
- * Copyright (C) 2001, 2004, 2006, 2007, 2009, 2011,
- *   2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2004,2006-2007,2009,2011,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-
+#include <stdio.h>
 #include <string.h>
 #include <unictype.h>
 
-#include "libguile.h"
-#include "libguile/srfi-14.h"
-#include "libguile/strings.h"
-#include "libguile/chars.h"
+#include "boolean.h"
+#include "chars.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "procs.h"
+#include "smob.h"
+#include "strings.h"
+#include "symbols.h"
+#include "values.h"
+
+#include "srfi-14.h"
+
 
 /* Include the pre-computed standard charset data.  */
-#include "libguile/srfi-14.i.c"
+#include "srfi-14.i.c"
 
 scm_t_char_range cs_full_ranges[] = {
   {0x0000, SCM_CODEPOINT_SURROGATE_START - 1}
@@ -1893,7 +1904,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
       charsets_intersection (p, r);
       rest = SCM_CDR (rest);
     }
-  return scm_values (scm_list_2 (res1, res2));
+  return scm_values_2 (res1, res2);
 }
 #undef FUNC_NAME
 
@@ -1981,7 +1992,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection_x,
     scm_char_set_intersection (scm_cons (cs1, scm_cons (cs2, rest)));
   cs1 = diff;
   cs2 = intersect;
-  return scm_values (scm_list_2 (cs1, cs2));
+  return scm_values_2 (cs1, cs2);
 }
 #undef FUNC_NAME
 
@@ -2038,7 +2049,7 @@ SCM_DEFINE (scm_sys_char_set_dump, "%char-set-dump", 1, 0, 0, (SCM charset),
   SCM ranges = SCM_EOL, elt;
   size_t i;
   scm_t_char_set *cs;
-  char codepoint_string_lo[9], codepoint_string_hi[9];
+  char codepoint_string_lo[13], codepoint_string_hi[13];
 
   SCM_VALIDATE_SMOB (1, charset, charset);
   cs = SCM_CHARSET_DATA (charset);
@@ -2112,7 +2123,7 @@ scm_init_srfi_14 (void)
   scm_char_set_designated = define_charset ("char-set:designated", &cs_designated);
   scm_char_set_full = define_charset ("char-set:full", &cs_full);
 
-#include "libguile/srfi-14.x"
+#include "srfi-14.x"
 }
 
 /* End of srfi-14.c.  */
diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h
index dc9718d70..51d37b160 100644
--- a/libguile/srfi-14.h
+++ b/libguile/srfi-14.h
@@ -2,27 +2,28 @@
 #define SCM_SRFI_14_H
 
 /* srfi-14.c --- SRFI-14 procedures for Guile
- *
- * 	Copyright (C) 2001, 2004, 2006, 2008, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+xxg
+   Copyright 2001,2004,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
-#include "libguile/__scm.h"
+#include "libguile/chars.h"
 
 typedef struct
 {
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index b0ed0ce17..cb9de9d8f 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -1,37 +1,44 @@
 /* srfi-4.c --- Uniform numeric vector datatypes.
- *
- * 	Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 2001,2004,2006,2009-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/bdw-gc.h"
-#include "libguile/srfi-4.h"
-#include "libguile/bytevectors.h"
-#include "libguile/error.h"
-#include "libguile/eval.h"
-#include "libguile/extensions.h"
-#include "libguile/uniform.h"
-#include "libguile/validate.h"
+#include <string.h>
+
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "bytevectors.h"
+#include "error.h"
+#include "eval.h"
+#include "extensions.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "numbers.h"
+#include "uniform.h"
+#include "variable.h"
+
+#include "srfi-4.h"
 
 
 #define DEFINE_SCHEME_PROXY100(cname, modname, scmname)                   \
@@ -112,7 +119,7 @@
 #define DEFINE_SRFI_4_C_FUNCS(TAG, tag, ctype, width)                   \
   SCM scm_take_##tag##vector (ctype *data, size_t n)                    \
   {                                                                     \
-    return scm_c_take_typed_bytevector ((scm_t_int8*)data, n, ETYPE (TAG), \
+    return scm_c_take_typed_bytevector ((int8_t*)data, n, ETYPE (TAG), \
                                         SCM_BOOL_F);                    \
   }                                                                     \
   const ctype* scm_array_handle_##tag##_elements (scm_t_array_handle *h) \
@@ -156,28 +163,28 @@
 #define MOD "srfi srfi-4"
 
 DEFINE_SRFI_4_PROXIES (u8);
-DEFINE_SRFI_4_C_FUNCS (U8, u8, scm_t_uint8, 1);
+DEFINE_SRFI_4_C_FUNCS (U8, u8, uint8_t, 1);
 
 DEFINE_SRFI_4_PROXIES (s8);
-DEFINE_SRFI_4_C_FUNCS (S8, s8, scm_t_int8, 1);
+DEFINE_SRFI_4_C_FUNCS (S8, s8, int8_t, 1);
 
 DEFINE_SRFI_4_PROXIES (u16);
-DEFINE_SRFI_4_C_FUNCS (U16, u16, scm_t_uint16, 1);
+DEFINE_SRFI_4_C_FUNCS (U16, u16, uint16_t, 1);
 
 DEFINE_SRFI_4_PROXIES (s16);
-DEFINE_SRFI_4_C_FUNCS (S16, s16, scm_t_int16, 1);
+DEFINE_SRFI_4_C_FUNCS (S16, s16, int16_t, 1);
 
 DEFINE_SRFI_4_PROXIES (u32);
-DEFINE_SRFI_4_C_FUNCS (U32, u32, scm_t_uint32, 1);
+DEFINE_SRFI_4_C_FUNCS (U32, u32, uint32_t, 1);
 
 DEFINE_SRFI_4_PROXIES (s32);
-DEFINE_SRFI_4_C_FUNCS (S32, s32, scm_t_int32, 1);
+DEFINE_SRFI_4_C_FUNCS (S32, s32, int32_t, 1);
 
 DEFINE_SRFI_4_PROXIES (u64);
-DEFINE_SRFI_4_C_FUNCS (U64, u64, scm_t_uint64, 1);
+DEFINE_SRFI_4_C_FUNCS (U64, u64, uint64_t, 1);
 
 DEFINE_SRFI_4_PROXIES (s64);
-DEFINE_SRFI_4_C_FUNCS (S64, s64, scm_t_int64, 1);
+DEFINE_SRFI_4_C_FUNCS (S64, s64, int64_t, 1);
 
 DEFINE_SRFI_4_PROXIES (f32);
 DEFINE_SRFI_4_C_FUNCS (F32, f32, float, 1);
@@ -291,7 +298,7 @@ scm_init_srfi_4 (void)
   REGISTER (c32, C32);
   REGISTER (c64, C64);
 
-#include "libguile/srfi-4.x"
+#include "srfi-4.x"
 }
 
 /* End of srfi-4.c.  */
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index f56c3f35b..3f279e6ef 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -1,27 +1,28 @@
 #ifndef SCM_SRFI_4_H
 #define SCM_SRFI_4_H
 /* srfi-4.c --- Homogeneous numeric vector datatypes.
- *
- * 	Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010, 2011, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 2001,2004,2006,2008-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
-#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
 
 SCM_API SCM scm_make_srfi_4_vector (SCM type, SCM len, SCM fill);
 
@@ -31,7 +32,7 @@ SCM_API SCM scm_make_srfi_4_vector (SCM type, SCM len, SCM fill);
 
 SCM_API SCM scm_u8vector_p (SCM obj);
 SCM_API SCM scm_make_u8vector (SCM n, SCM fill);
-SCM_API SCM scm_take_u8vector (scm_t_uint8 *data, size_t n);
+SCM_API SCM scm_take_u8vector (uint8_t *data, size_t n);
 SCM_API SCM scm_u8vector (SCM l);
 SCM_API SCM scm_u8vector_length (SCM uvec);
 SCM_API SCM scm_u8vector_ref (SCM uvec, SCM index);
@@ -39,19 +40,19 @@ SCM_API SCM scm_u8vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u8vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u8vector (SCM l);
 SCM_API SCM scm_any_to_u8vector (SCM obj);
-SCM_API const scm_t_uint8 *scm_array_handle_u8_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint8 *scm_array_handle_u8_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_uint8 *scm_u8vector_elements (SCM uvec, 
+SCM_API const uint8_t *scm_array_handle_u8_elements (scm_t_array_handle *h);
+SCM_API uint8_t *scm_array_handle_u8_writable_elements (scm_t_array_handle *h);
+SCM_API const uint8_t *scm_u8vector_elements (SCM uvec, 
 						  scm_t_array_handle *h,
 						  size_t *lenp, ssize_t *incp);
-SCM_API scm_t_uint8 *scm_u8vector_writable_elements (SCM uvec, 
+SCM_API uint8_t *scm_u8vector_writable_elements (SCM uvec, 
 						     scm_t_array_handle *h,
 						     size_t *lenp,
 						     ssize_t *incp);
 
 SCM_API SCM scm_s8vector_p (SCM obj);
 SCM_API SCM scm_make_s8vector (SCM n, SCM fill);
-SCM_API SCM scm_take_s8vector (scm_t_int8 *data, size_t n);
+SCM_API SCM scm_take_s8vector (int8_t *data, size_t n);
 SCM_API SCM scm_s8vector (SCM l);
 SCM_API SCM scm_s8vector_length (SCM uvec);
 SCM_API SCM scm_s8vector_ref (SCM uvec, SCM index);
@@ -59,19 +60,19 @@ SCM_API SCM scm_s8vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s8vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s8vector (SCM l);
 SCM_API SCM scm_any_to_s8vector (SCM obj);
-SCM_API const scm_t_int8 *scm_array_handle_s8_elements (scm_t_array_handle *h);
-SCM_API scm_t_int8 *scm_array_handle_s8_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_int8 *scm_s8vector_elements (SCM uvec, 
+SCM_API const int8_t *scm_array_handle_s8_elements (scm_t_array_handle *h);
+SCM_API int8_t *scm_array_handle_s8_writable_elements (scm_t_array_handle *h);
+SCM_API const int8_t *scm_s8vector_elements (SCM uvec, 
 						 scm_t_array_handle *h,
 						 size_t *lenp, ssize_t *incp);
-SCM_API scm_t_int8 *scm_s8vector_writable_elements (SCM uvec, 
+SCM_API int8_t *scm_s8vector_writable_elements (SCM uvec, 
 						    scm_t_array_handle *h,
 						    size_t *lenp,
 						    ssize_t *incp);
 
 SCM_API SCM scm_u16vector_p (SCM obj);
 SCM_API SCM scm_make_u16vector (SCM n, SCM fill);
-SCM_API SCM scm_take_u16vector (scm_t_uint16 *data, size_t n);
+SCM_API SCM scm_take_u16vector (uint16_t *data, size_t n);
 SCM_API SCM scm_u16vector (SCM l);
 SCM_API SCM scm_u16vector_length (SCM uvec);
 SCM_API SCM scm_u16vector_ref (SCM uvec, SCM index);
@@ -79,20 +80,20 @@ SCM_API SCM scm_u16vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u16vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u16vector (SCM l);
 SCM_API SCM scm_any_to_u16vector (SCM obj);
-SCM_API const scm_t_uint16 *scm_array_handle_u16_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint16 *scm_array_handle_u16_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_uint16 *scm_u16vector_elements (SCM uvec, 
+SCM_API const uint16_t *scm_array_handle_u16_elements (scm_t_array_handle *h);
+SCM_API uint16_t *scm_array_handle_u16_writable_elements (scm_t_array_handle *h);
+SCM_API const uint16_t *scm_u16vector_elements (SCM uvec, 
 						    scm_t_array_handle *h,
 						    size_t *lenp,
 						    ssize_t *incp);
-SCM_API scm_t_uint16 *scm_u16vector_writable_elements (SCM uvec, 
+SCM_API uint16_t *scm_u16vector_writable_elements (SCM uvec, 
 						       scm_t_array_handle *h,
 						       size_t *lenp,
 						       ssize_t *incp);
 
 SCM_API SCM scm_s16vector_p (SCM obj);
 SCM_API SCM scm_make_s16vector (SCM n, SCM fill);
-SCM_API SCM scm_take_s16vector (scm_t_int16 *data, size_t n);
+SCM_API SCM scm_take_s16vector (int16_t *data, size_t n);
 SCM_API SCM scm_s16vector (SCM l);
 SCM_API SCM scm_s16vector_length (SCM uvec);
 SCM_API SCM scm_s16vector_ref (SCM uvec, SCM index);
@@ -100,19 +101,19 @@ SCM_API SCM scm_s16vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s16vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s16vector (SCM l);
 SCM_API SCM scm_any_to_s16vector (SCM obj);
-SCM_API const scm_t_int16 *scm_array_handle_s16_elements (scm_t_array_handle *h);
-SCM_API scm_t_int16 *scm_array_handle_s16_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_int16 *scm_s16vector_elements (SCM uvec, 
+SCM_API const int16_t *scm_array_handle_s16_elements (scm_t_array_handle *h);
+SCM_API int16_t *scm_array_handle_s16_writable_elements (scm_t_array_handle *h);
+SCM_API const int16_t *scm_s16vector_elements (SCM uvec, 
 						   scm_t_array_handle *h,
 						   size_t *lenp, ssize_t *incp);
-SCM_API scm_t_int16 *scm_s16vector_writable_elements (SCM uvec, 
+SCM_API int16_t *scm_s16vector_writable_elements (SCM uvec, 
 						      scm_t_array_handle *h,
 						      size_t *lenp,
 						      ssize_t *incp);
 
 SCM_API SCM scm_u32vector_p (SCM obj);
 SCM_API SCM scm_make_u32vector (SCM n, SCM fill);
-SCM_API SCM scm_take_u32vector (scm_t_uint32 *data, size_t n);
+SCM_API SCM scm_take_u32vector (uint32_t *data, size_t n);
 SCM_API SCM scm_u32vector (SCM l);
 SCM_API SCM scm_u32vector_length (SCM uvec);
 SCM_API SCM scm_u32vector_ref (SCM uvec, SCM index);
@@ -120,20 +121,20 @@ SCM_API SCM scm_u32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u32vector (SCM l);
 SCM_API SCM scm_any_to_u32vector (SCM obj);
-SCM_API const scm_t_uint32 *scm_array_handle_u32_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint32 *scm_array_handle_u32_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_uint32 *scm_u32vector_elements (SCM uvec, 
+SCM_API const uint32_t *scm_array_handle_u32_elements (scm_t_array_handle *h);
+SCM_API uint32_t *scm_array_handle_u32_writable_elements (scm_t_array_handle *h);
+SCM_API const uint32_t *scm_u32vector_elements (SCM uvec, 
 						    scm_t_array_handle *h,
 						    size_t *lenp,
 						    ssize_t *incp);
-SCM_API scm_t_uint32 *scm_u32vector_writable_elements (SCM uvec, 
+SCM_API uint32_t *scm_u32vector_writable_elements (SCM uvec, 
 						       scm_t_array_handle *h,
 						       size_t *lenp,
 						       ssize_t *incp);
 
 SCM_API SCM scm_s32vector_p (SCM obj);
 SCM_API SCM scm_make_s32vector (SCM n, SCM fill);
-SCM_API SCM scm_take_s32vector (scm_t_int32 *data, size_t n);
+SCM_API SCM scm_take_s32vector (int32_t *data, size_t n);
 SCM_API SCM scm_s32vector (SCM l);
 SCM_API SCM scm_s32vector_length (SCM uvec);
 SCM_API SCM scm_s32vector_ref (SCM uvec, SCM index);
@@ -141,12 +142,12 @@ SCM_API SCM scm_s32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s32vector (SCM l);
 SCM_API SCM scm_any_to_s32vector (SCM obj);
-SCM_API const scm_t_int32 *scm_array_handle_s32_elements (scm_t_array_handle *h);
-SCM_API scm_t_int32 *scm_array_handle_s32_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_int32 *scm_s32vector_elements (SCM uvec, 
+SCM_API const int32_t *scm_array_handle_s32_elements (scm_t_array_handle *h);
+SCM_API int32_t *scm_array_handle_s32_writable_elements (scm_t_array_handle *h);
+SCM_API const int32_t *scm_s32vector_elements (SCM uvec, 
 						   scm_t_array_handle *h,
 						   size_t *lenp, ssize_t *incp);
-SCM_API scm_t_int32 *scm_s32vector_writable_elements (SCM uvec, 
+SCM_API int32_t *scm_s32vector_writable_elements (SCM uvec, 
 						      scm_t_array_handle *h,
 						      size_t *lenp,
 						      ssize_t *incp);
@@ -161,14 +162,14 @@ SCM_API SCM scm_u64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u64vector (SCM l);
 SCM_API SCM scm_any_to_u64vector (SCM obj);
 
-SCM_API SCM scm_take_u64vector (scm_t_uint64 *data, size_t n);
-SCM_API const scm_t_uint64 *scm_array_handle_u64_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint64 *scm_array_handle_u64_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_uint64 *scm_u64vector_elements (SCM uvec, 
+SCM_API SCM scm_take_u64vector (uint64_t *data, size_t n);
+SCM_API const uint64_t *scm_array_handle_u64_elements (scm_t_array_handle *h);
+SCM_API uint64_t *scm_array_handle_u64_writable_elements (scm_t_array_handle *h);
+SCM_API const uint64_t *scm_u64vector_elements (SCM uvec, 
 						    scm_t_array_handle *h,
 						    size_t *lenp,
 						    ssize_t *incp);
-SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM uvec, 
+SCM_API uint64_t *scm_u64vector_writable_elements (SCM uvec, 
 						       scm_t_array_handle *h,
 						       size_t *lenp,
 						       ssize_t *incp);
@@ -183,13 +184,13 @@ SCM_API SCM scm_s64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s64vector (SCM l);
 SCM_API SCM scm_any_to_s64vector (SCM obj);
 
-SCM_API SCM scm_take_s64vector (scm_t_int64 *data, size_t n);
-SCM_API const scm_t_int64 *scm_array_handle_s64_elements (scm_t_array_handle *h);
-SCM_API scm_t_int64 *scm_array_handle_s64_writable_elements (scm_t_array_handle *h);
-SCM_API const scm_t_int64 *scm_s64vector_elements (SCM uvec, 
+SCM_API SCM scm_take_s64vector (int64_t *data, size_t n);
+SCM_API const int64_t *scm_array_handle_s64_elements (scm_t_array_handle *h);
+SCM_API int64_t *scm_array_handle_s64_writable_elements (scm_t_array_handle *h);
+SCM_API const int64_t *scm_s64vector_elements (SCM uvec, 
 						   scm_t_array_handle *h,
 						   size_t *lenp, ssize_t *incp);
-SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM uvec, 
+SCM_API int64_t *scm_s64vector_writable_elements (SCM uvec, 
 						      scm_t_array_handle *h,
 						      size_t *lenp,
 						      ssize_t *incp);
diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c
index de97cbc60..578106e8e 100644
--- a/libguile/srfi-60.c
+++ b/libguile/srfi-60.c
@@ -1,22 +1,23 @@
 /* srfi-60.c --- Integers as Bits
- *
- * Copyright (C) 2005, 2006, 2008, 2010, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 2005-2006,2008,2010,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,13 +25,16 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
-
-#include "libguile/validate.h"
-#include "libguile/numbers.h"
+#include "boolean.h"
+#include "eq.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "version.h"
 
-#include "libguile/srfi-60.h"
+#include "srfi-60.h"
 
 
 SCM_DEFINE (scm_srfi60_log2_binary_factors, "log2-binary-factors", 1, 0, 0,
@@ -455,6 +459,6 @@ void
 scm_init_srfi_60 (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/srfi-60.x"
+#include "srfi-60.x"
 #endif
 }
diff --git a/libguile/srfi-60.h b/libguile/srfi-60.h
index 013820fca..3b71157d3 100644
--- a/libguile/srfi-60.h
+++ b/libguile/srfi-60.h
@@ -1,28 +1,29 @@
 /* srfi-60.h --- SRFI-60 procedures for Guile
- *
- * 	Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+
+   Copyright 2005-2006,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifndef SCM_SRFI_60_H
 #define SCM_SRFI_60_H
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_INTERNAL SCM scm_srfi60_log2_binary_factors (SCM n);
 SCM_INTERNAL SCM scm_srfi60_copy_bit (SCM index, SCM n, SCM bit);
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
index 96f72408d..a9bf133c2 100644
--- a/libguile/stackchk.c
+++ b/libguile/stackchk.c
@@ -1,33 +1,38 @@
-/*	Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008, 2010, 2011, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,2000-2001,2006,2008,2010-2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/ports.h"
-#include "libguile/threads.h"
-#include "libguile/dynwind.h"
+#include "dynwind.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "ports.h"
+#include "threads.h"
+
+#include "stackchk.h"
+
 
-#include "libguile/stackchk.h"
 
 
 /* {Stack Checking}
@@ -52,7 +57,7 @@ scm_stack_report ()
 {
   SCM port = scm_current_error_port ();
   SCM_STACKITEM stack;
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
 
   scm_uintprint ((scm_stack_size (thread->continuation_base) 
 		  * sizeof (SCM_STACKITEM)),
@@ -78,11 +83,5 @@ SCM_DEFINE (scm_sys_get_stack_size, "%get-stack-size", 0, 0, 0,
 void
 scm_init_stackchk ()
 {
-#include "libguile/stackchk.x"
+#include "stackchk.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
index 23dbdba7b..75688ec3b 100644
--- a/libguile/stackchk.h
+++ b/libguile/stackchk.h
@@ -1,29 +1,26 @@
-/* classes: h_files */
-
 #ifndef SCM_STACKCHK_H
 #define SCM_STACKCHK_H
 
-/* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008, 2009, 2010, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000,2003,2006,2008-2011,2014,2018
+     Free Software Foundation, Inc.
 
-
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
 
-#include "libguile/__scm.h"
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
 
 #include "libguile/continuations.h"
 #include "libguile/debug.h"
@@ -63,9 +60,3 @@ SCM_API SCM scm_sys_get_stack_size (void);
 SCM_INTERNAL void scm_init_stackchk (void);
 
 #endif  /* SCM_STACKCHK_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/stacks.c b/libguile/stacks.c
index c4dd317f7..36842920b 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,46 +1,51 @@
-/* A stack holds a frame chain
- *
- * Copyright (C) 1996, 1997, 2000, 2001, 2006-2015, 2017, 2018
- *   Free Software Foundation
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-1997,2000-2001,2006-2015,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/control.h"
-#include "libguile/eval.h"
-#include "libguile/debug.h"
-#include "libguile/continuations.h"
-#include "libguile/struct.h"
-#include "libguile/macros.h"
-#include "libguile/procprop.h"
-#include "libguile/modules.h"
-#include "libguile/strings.h"
-#include "libguile/vm.h" /* to capture vm stacks */
-#include "libguile/frames.h" /* vm frames */
-
-#include "libguile/validate.h"
-#include "libguile/stacks.h"
-#include "libguile/private-options.h"
+#include "boolean.h"
+#include "continuations.h"
+#include "control.h"
+#include "debug.h"
+#include "eval.h"
+#include "fluids.h"
+#include "frames.h" /* vm frames */
+#include "gsubr.h"
+#include "list.h"
+#include "macros.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "private-options.h"
+#include "procprop.h"
+#include "strings.h"
+#include "struct.h"
+#include "symbols.h"
+#include "threads.h"
+#include "vm.h" /* to capture vm stacks */
+
+#include "stacks.h"
 
 
 static SCM scm_sys_stacks;
@@ -97,13 +102,13 @@ stack_depth (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
  * encountered.
  */
 
-static scm_t_ptrdiff
+static ptrdiff_t
 find_prompt (SCM key)
 {
-  scm_t_ptrdiff fp_offset;
+  ptrdiff_t fp_offset;
 
   if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
-                                 NULL, &fp_offset, NULL, NULL, NULL))
+                                 NULL, &fp_offset, NULL, NULL, NULL, NULL))
     scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
                     scm_list_1 (key));
 
@@ -148,14 +153,14 @@ narrow_stack (long len, enum scm_vm_frame_kind kind, struct scm_frame *frame,
            && scm_is_integer (scm_cdr (inner_cut)))
     {
       /* Cut until an IP within the given range is found.  */
-      scm_t_uintptr low_pc, high_pc, pc;
+      uintptr_t low_pc, high_pc, pc;
 
       low_pc = scm_to_uintptr_t (scm_car (inner_cut));
       high_pc = scm_to_uintptr_t (scm_cdr (inner_cut));
 
       for (; len ;)
         {
-          pc = (scm_t_uintptr) frame->ip;
+          pc = (uintptr_t) frame->ip;
           len--;
           scm_c_frame_previous (kind, frame);
           if (low_pc <= pc && pc < high_pc)
@@ -176,7 +181,7 @@ narrow_stack (long len, enum scm_vm_frame_kind kind, struct scm_frame *frame,
   else
     {
       /* Cut until the given prompt tag is seen. */
-      scm_t_ptrdiff fp_offset = find_prompt (inner_cut);
+      ptrdiff_t fp_offset = find_prompt (inner_cut);
       for (; len; len--, scm_c_frame_previous (kind, frame))
         if (fp_offset == frame->fp_offset)
           break;
@@ -202,7 +207,7 @@ narrow_stack (long len, enum scm_vm_frame_kind kind, struct scm_frame *frame,
            && scm_is_integer (scm_cdr (outer_cut)))
     {
       /* Cut until an IP within the given range is found.  */
-      scm_t_uintptr low_pc, high_pc, pc;
+      uintptr_t low_pc, high_pc, pc;
       long i, new_len;
       struct scm_frame tmp;
 
@@ -214,7 +219,7 @@ narrow_stack (long len, enum scm_vm_frame_kind kind, struct scm_frame *frame,
       /* Cut until the given procedure is seen. */
       for (new_len = i = 0; i < len; i++, scm_c_frame_previous (kind, &tmp))
         {
-          pc = (scm_t_uintptr) tmp.ip;
+          pc = (uintptr_t) tmp.ip;
           if (low_pc <= pc && pc < high_pc)
             new_len = i;
         }
@@ -236,7 +241,7 @@ narrow_stack (long len, enum scm_vm_frame_kind kind, struct scm_frame *frame,
       /* Cut until the given prompt tag is seen. */
       long i;
       struct scm_frame tmp;
-      scm_t_ptrdiff fp_offset = find_prompt (outer_cut);
+      ptrdiff_t fp_offset = find_prompt (outer_cut);
 
       memcpy (&tmp, frame, sizeof tmp);
 
@@ -329,7 +334,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       frame.stack_holder = c;
       frame.fp_offset = c->fp_offset;
       frame.sp_offset = c->stack_size;
-      frame.ip = c->ra;
+      frame.ip = c->vra;
     }
   else if (SCM_VM_FRAME_P (obj))
     {
@@ -468,11 +473,5 @@ scm_init_stacks ()
                                     SCM_UNDEFINED);
   scm_set_struct_vtable_name_x (scm_stack_type,
 				scm_from_utf8_symbol ("stack"));
-#include "libguile/stacks.x"
+#include "stacks.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/stacks.h b/libguile/stacks.h
index ba97e0892..25ece853a 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_STACKS_H
 #define SCM_STACKS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2004,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
 #include "libguile/frames.h"
 
 /* {Frames and stacks}
@@ -46,6 +45,11 @@ SCM_API SCM scm_stack_type;
 
 #define SCM_FRAMEP(obj) (SCM_VM_FRAME_P (obj))
 
+#define SCM_VALIDATE_STACK(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack")
+#define SCM_VALIDATE_FRAME(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame")
+
 
 
 
@@ -58,9 +62,3 @@ SCM_API SCM scm_stack_length (SCM stack);
 SCM_INTERNAL void scm_init_stacks (void);
 
 #endif  /* SCM_STACKS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/stime.c b/libguile/stime.c
index b681d7ee3..6c17eb931 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-2001, 2003-2009, 2011, 2013, 2014, 2016-2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2001,2003-2009,2011,2013-2014,2016-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -44,33 +44,35 @@
 #  include <config.h>
 #endif
 
-#include <stdio.h>
 #include <errno.h>
+#include <stdio.h>
 #include <strftime.h>
-#include <unistr.h>
-
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/dynwind.h"
-#include "libguile/strings.h"
-
-#include "libguile/validate.h"
-#include "libguile/stime.h"
-
-#include <unistd.h>
-#include <time.h>				  /* Gnulib-provided */
-
-#include <sys/types.h>
 #include <string.h>
 #include <sys/times.h>
+#include <sys/types.h>
+#include <time.h>				  /* Gnulib-provided */
+#include <unistd.h>
+#include <unistr.h>
 
 #ifdef HAVE_SYS_TIMEB_H
 # include <sys/timeb.h>
 #endif
 
+#include "async.h"
+#include "boolean.h"
+#include "dynwind.h"
+#include "feature.h"
+#include "gsubr.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "strings.h"
+#include "strings.h"
+#include "vectors.h"
+
+#include "stime.h"
+
+
 #if ! HAVE_DECL_STRPTIME
 extern char *strptime ();
 #endif
@@ -672,7 +674,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      character to the format string, so that valid returns are always
      nonzero. */
   myfmt = scm_malloc (len+2);
-  *myfmt = (scm_t_uint8) 'x';
+  *myfmt = (uint8_t) 'x';
   strncpy (myfmt + 1, fmt, len);
   myfmt[len + 1] = 0;
   scm_remember_upto_here_1 (format);
@@ -808,7 +810,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 #endif
 
   /* Compute the number of UTF-8 characters.  */
-  used_len = u8_strnlen ((scm_t_uint8*) str, rest-str);
+  used_len = u8_strnlen ((uint8_t*) str, rest-str);
   scm_remember_upto_here_2 (format, string);
   free (str);
   free (fmt);
@@ -865,12 +867,6 @@ scm_init_stime()
     }
 
   scm_add_feature ("current-time");
-#include "libguile/stime.x"
+#include "stime.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/stime.h b/libguile/stime.h
index e41f79730..2b5f69e16 100644
--- a/libguile/stime.h
+++ b/libguile/stime.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_STIME_H
 #define SCM_STIME_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006, 2008, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000,2003,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -46,9 +45,3 @@ SCM_API SCM scm_strptime (SCM format, SCM string);
 SCM_INTERNAL void scm_init_stime (void);
 
 #endif  /* SCM_STIME_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strerror.c b/libguile/strerror.c
deleted file mode 100644
index 0e0e94ee8..000000000
--- a/libguile/strerror.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/* Turning errno values into English error messages.
-   Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 2000, 2001, 2006 Free Software Foundation, Inc.
-
-   This library is free software; you can redistribute it and/or
-   modify it under the terms of the GNU Lesser General Public License
-   as published by the Free Software Foundation; either version 3 of
-   the License, or (at your option) any later version.
-  
-   This library is distributed in the hope that it will be useful, but
-   WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-   Lesser General Public License for more details.
-  
-   You should have received a copy of the GNU Lesser General Public
-   License along with this library; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-   02110-1301 USA
-*/
-
-char *
-strerror (int errnum)
-{
-  extern char *sys_errlist[];
-  extern int sys_nerr;
-
-  if (errnum >= 0 && errnum < sys_nerr)
-    return sys_errlist[errnum];
-  return (char *) "Unknown error";
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strings.c b/libguile/strings.c
index 180fae1ce..aab104498 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2004, 2006,
- *   2008-2016, 2018, 2019 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2016,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -27,24 +27,29 @@
 #include <string.h>
 #include <stdio.h>
 #include <ctype.h>
+#include <errno.h>
 #include <uninorm.h>
 #include <unistr.h>
 #include <uniconv.h>
 #include <c-strcase.h>
 #include <intprops.h>
 
+#include "chars.h"
+#include "deprecation.h"
+#include "error.h"
+#include "generalized-vectors.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "private-options.h"
 #include "striconveh.h"
+#include "symbols.h"
+#include "threads.h"
+
+#include "strings.h"
 
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/strings.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/error.h"
-#include "libguile/generalized-vectors.h"
-#include "libguile/deprecation.h"
-#include "libguile/validate.h"
-#include "libguile/private-options.h"
 
 #ifndef SCM_MAX_ALLOCA
 # define SCM_MAX_ALLOCA 4096 /* Max bytes per string to allocate via alloca */
@@ -163,7 +168,7 @@ make_wide_stringbuf (size_t len)
   if (len > (((size_t) -(STRINGBUF_HEADER_BYTES + 32 + sizeof (scm_t_wchar)))
              / sizeof (scm_t_wchar)))
     scm_num_overflow ("make_wide_stringbuf");
-    
+
   raw_len = (len + 1) * sizeof (scm_t_wchar);
   buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len,
                                                      "string"));
@@ -378,8 +383,8 @@ substring_with_immutable_stringbuf (SCM str, size_t start, size_t end,
       if (STRINGBUF_WIDE (buf))
         {
           new_buf = make_wide_stringbuf (len);
-          u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf),
-                   (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) + start), len);
+          u32_cpy ((uint32_t *) STRINGBUF_WIDE_CHARS (new_buf),
+                   (uint32_t *) (STRINGBUF_WIDE_CHARS (buf) + start), len);
           new_str = scm_double_cell (tag, SCM_UNPACK (new_buf), 0, len);
           scm_i_try_narrow_string (new_str);
         }
@@ -446,8 +451,8 @@ scm_i_string_ensure_mutable_x (SCM str)
     if (STRINGBUF_WIDE (buf))
       {
         new_buf = make_wide_stringbuf (len);
-        u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf),
-                 (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
+        u32_cpy ((uint32_t *) STRINGBUF_WIDE_CHARS (new_buf),
+                 (uint32_t *) STRINGBUF_WIDE_CHARS (buf), len);
       }
     else
       {
@@ -933,8 +938,8 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str),
       size_t len = STRINGBUF_LENGTH (buf);
       scm_t_wchar *cbuf;
       SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
-      u32_cpy ((scm_t_uint32 *) cbuf, 
-               (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
+      u32_cpy ((uint32_t *) cbuf, 
+               (uint32_t *) STRINGBUF_WIDE_CHARS (buf), len);
       e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
                      sbc);
     }
@@ -1006,8 +1011,8 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym),
       size_t len = STRINGBUF_LENGTH (buf);
       scm_t_wchar *cbuf;
       SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
-      u32_cpy ((scm_t_uint32 *) cbuf, 
-               (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
+      u32_cpy ((uint32_t *) cbuf, 
+               (uint32_t *) STRINGBUF_WIDE_CHARS (buf), len);
       e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
                      sbc);
     }
@@ -1436,8 +1441,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
                 data.wide[i] = (unsigned char) src[i];
             }
           else
-            u32_cpy ((scm_t_uint32 *) data.wide,
-                     (scm_t_uint32 *) scm_i_string_wide_chars (s), len);
+            u32_cpy ((uint32_t *) data.wide,
+                     (uint32_t *) scm_i_string_wide_chars (s), len);
           data.wide += len;
         }
       total -= len;
@@ -1555,7 +1560,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
     {
       scm_t_wchar *wdst;
       res = scm_i_make_wide_string (u32len, &wdst, 0);
-      u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len);
+      u32_cpy ((uint32_t *) wdst, (uint32_t *) u32, u32len);
       wdst[u32len] = 0;
     }
 
@@ -1615,7 +1620,7 @@ SCM
 scm_from_utf8_stringn (const char *str, size_t len)
 {
   size_t i, char_len;
-  const scm_t_uint8 *ustr = (const scm_t_uint8 *) str;
+  const uint8_t *ustr = (const uint8_t *) str;
   int ascii = 1, narrow = 1;
   SCM res;
 
@@ -1949,7 +1954,7 @@ scm_to_utf8_string (SCM str)
 }
 
 static size_t
-latin1_u8_strlen (const scm_t_uint8 *str, size_t len)
+latin1_u8_strlen (const uint8_t *str, size_t len)
 {
   size_t ret, i;
   for (i = 0, ret = 0; i < len; i++)
@@ -1957,9 +1962,9 @@ latin1_u8_strlen (const scm_t_uint8 *str, size_t len)
   return ret;
 }
 
-static scm_t_uint8*
-latin1_to_u8 (const scm_t_uint8 *str, size_t latin_len,
-              scm_t_uint8 *u8_result, size_t *u8_lenp)
+static uint8_t*
+latin1_to_u8 (const uint8_t *str, size_t latin_len,
+              uint8_t *u8_result, size_t *u8_lenp)
 {
   size_t i, n;
   size_t u8_len = latin1_u8_strlen (str, latin_len);
@@ -1999,13 +2004,13 @@ latin1_to_u8 (const scm_t_uint8 *str, size_t latin_len,
 */
 
 static size_t
-u32_u8_length_in_bytes (const scm_t_uint32 *str, size_t len)
+u32_u8_length_in_bytes (const uint32_t *str, size_t len)
 {
   size_t ret, i;
 
   for (i = 0, ret = 0; i < len; i++)
     {
-      scm_t_uint32 c = str[i];
+      uint32_t c = str[i];
 
       if (c <= 0x7f)
         ret += 1;
@@ -2028,11 +2033,11 @@ static size_t
 utf8_length (SCM str)
 {
   if (scm_i_is_narrow_string (str))
-    return latin1_u8_strlen ((scm_t_uint8 *) scm_i_string_chars (str),
+    return latin1_u8_strlen ((uint8_t *) scm_i_string_chars (str),
                              scm_i_string_length (str));
   else
     return u32_u8_length_in_bytes
-      ((scm_t_uint32 *) scm_i_string_wide_chars (str),
+      ((uint32_t *) scm_i_string_wide_chars (str),
        scm_i_string_length (str));
 }
 
@@ -2063,13 +2068,13 @@ scm_to_utf8_stringn (SCM str, size_t *lenp)
   SCM_VALIDATE_STRING (1, str);
 
   if (scm_i_is_narrow_string (str))
-    return (char *) latin1_to_u8 ((scm_t_uint8 *) scm_i_string_chars (str),
+    return (char *) latin1_to_u8 ((uint8_t *) scm_i_string_chars (str),
                                   scm_i_string_length (str),
                                   NULL, lenp);
   else
     {
-      scm_t_uint32 *chars = (scm_t_uint32 *) scm_i_string_wide_chars (str);
-      scm_t_uint8 *buf, *ret;
+      uint32_t *chars = (uint32_t *) scm_i_string_wide_chars (str);
+      uint8_t *buf, *ret;
       size_t num_chars = scm_i_string_length (str);
       size_t num_bytes_predicted, num_bytes_actual;
 
@@ -2126,10 +2131,10 @@ scm_to_utf32_stringn (SCM str, size_t *lenp)
 
   if (scm_i_is_narrow_string (str))
     {
-      scm_t_uint8 *codepoints;
+      uint8_t *codepoints;
       size_t i, len;
 
-      codepoints = (scm_t_uint8*) scm_i_string_chars (str);
+      codepoints = (uint8_t*) scm_i_string_chars (str);
       len = scm_i_string_length (str);
       if (lenp)
 	*lenp = len;
@@ -2262,7 +2267,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
     {
       buf = u32_conv_to_encoding (encoding,
                                   (enum iconv_ilseq_handler) handler,
-                                  (scm_t_uint32 *) scm_i_string_wide_chars (str),
+                                  (uint32_t *) scm_i_string_wide_chars (str),
                                   ilen,
                                   NULL,
                                   NULL, &len);
@@ -2333,8 +2338,8 @@ static SCM
 normalize_str (SCM string, uninorm_t form)
 {
   SCM ret;
-  scm_t_uint32 *w_str;
-  scm_t_uint32 *w_norm_str;
+  uint32_t *w_str;
+  uint32_t *w_norm_str;
   scm_t_wchar *cbuf;
   int malloc_p;
   size_t norm_len, len = scm_i_string_length (string);
@@ -2355,13 +2360,13 @@ normalize_str (SCM string, uninorm_t form)
   else
     {
       malloc_p = 0;
-      w_str = (scm_t_uint32 *) scm_i_string_wide_chars (string);
+      w_str = (uint32_t *) scm_i_string_wide_chars (string);
     }
 
   w_norm_str = u32_normalize (form, w_str, len, NULL, &norm_len);
 
   ret = scm_i_make_wide_string (norm_len, &cbuf, 0);
-  u32_cpy ((scm_t_uint32 *) cbuf, w_norm_str, norm_len);
+  u32_cpy ((uint32_t *) cbuf, w_norm_str, norm_len);
   free (w_norm_str);
   if (malloc_p)
     free (w_str);
@@ -2495,12 +2500,6 @@ scm_init_strings ()
 {
   scm_nullstr = scm_i_make_string (0, NULL, 0);
 
-#include "libguile/strings.x"
+#include "strings.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strings.h b/libguile/strings.h
index fa0c663b8..3f92d8c89 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -1,30 +1,31 @@
-/* classes: h_files */
-
 #ifndef SCM_STRINGS_H
 #define SCM_STRINGS_H
 
-/* Copyright (C) 1995-1998, 2000, 2001, 2004-2006, 2008-2011, 2013,
- *   2015-2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2004-2006,2008-2011,2013,2015-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/gc.h>
+#include <libguile/error.h>
+#include "libguile/inline.h"
+#include <libguile/snarf.h>
 
 
 
@@ -104,6 +105,7 @@ SCM_INTERNAL SCM scm_nullstr;
 SCM_INTERNAL scm_t_string_failed_conversion_handler
 scm_i_default_string_failed_conversion_handler (void);
 
+SCM_INLINE int scm_is_string (SCM x);
 SCM_API SCM scm_string_p (SCM x);
 SCM_API SCM scm_string (SCM chrs);
 SCM_API SCM scm_make_string (SCM k, SCM chr);
@@ -176,6 +178,39 @@ SCM_API SCM scm_string_normalize_nfkc (SCM str);
 SCM_API SCM scm_makfromstrs (int argc, char **argv);
 
 
+
+
+/* Snarfing support.  See snarf.h.  */
+
+#ifdef SCM_SUPPORT_STATIC_ALLOCATION
+#define SCM_IMMUTABLE_STRINGBUF(c_name, contents)	\
+  static SCM_UNUSED const				\
+  struct						\
+  {							\
+    scm_t_bits word_0;					\
+    scm_t_bits word_1;					\
+    const char buffer[sizeof (contents)];		\
+  }							\
+  c_name =						\
+    {							\
+      scm_tc7_stringbuf,                                \
+      sizeof (contents) - 1,				\
+      contents						\
+    }
+
+#define SCM_IMMUTABLE_STRING(c_name, contents)				\
+  SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents);	\
+  SCM_IMMUTABLE_DOUBLE_CELL (c_name,					\
+			     scm_tc7_ro_string,				\
+			     (scm_t_bits) &scm_i_paste (c_name,		\
+							_stringbuf),	\
+			     (scm_t_bits) 0,				\
+                             (scm_t_bits) (sizeof (contents) - 1))
+
+#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
+
+
+
 /* internal constants */
 
 /* Type tag for read-only strings.  */
@@ -247,13 +282,30 @@ SCM_API SCM scm_sys_stringbuf_hist (void);
 #endif
 
 
+
+
+#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
+/* Either inlining, or being included from inline.c.  */
+
+SCM_INLINE_IMPLEMENTATION int
+scm_is_string (SCM x)
+{
+  return SCM_HAS_TYP7 (x, scm_tc7_string);
+}
+
+#endif
+
+
+
+
+#define SCM_VALIDATE_STRING(pos, str) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_string (str), str, pos, FUNC_NAME, "string"); \
+  } while (0)
+
+
+
 
 SCM_INTERNAL void scm_init_strings (void);
 
 #endif  /* SCM_STRINGS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strorder.c b/libguile/strorder.c
index a51ce17ae..be6600f70 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -1,36 +1,42 @@
-/*	Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1999-2000,2004,2006,2008-2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/strings.h"
-#include "libguile/symbols.h"
+#include "boolean.h"
+#include "chars.h"
+#include "gsubr.h"
+#include "pairs.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "symbols.h"
+
+#include "strorder.h"
+
 
-#include "libguile/validate.h"
-#include "libguile/strorder.h"
-#include "libguile/srfi-13.h"
 
 
+
 SCM_C_INLINE_KEYWORD static SCM
 srfi13_cmp (SCM s1, SCM s2, SCM (*cmp) (SCM, SCM, SCM, SCM, SCM, SCM))
 {
@@ -339,12 +345,6 @@ SCM scm_string_ci_geq_p (SCM s1, SCM s2)
 void
 scm_init_strorder ()
 {
-#include "libguile/strorder.x"
+#include "strorder.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strorder.h b/libguile/strorder.h
index 2c004e48a..4bb7ebc2e 100644
--- a/libguile/strorder.h
+++ b/libguile/strorder.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_STRORDER_H
 #define SCM_STRORDER_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -40,9 +39,3 @@ SCM_API SCM scm_string_ci_geq_p (SCM s1, SCM s2);
 SCM_INTERNAL void scm_init_strorder (void);
 
 #endif  /* SCM_STRORDER_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strports.c b/libguile/strports.c
index 14cdfa06b..4cb2b9119 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1998-2003, 2005, 2006, 2009-2014,
- *   2016-2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,1996,1998-2003,2005-2006,2009-2014,2016-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,27 +24,29 @@
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-
 #include <stdio.h>
+#include <string.h>
 #include <unistd.h>
 #include <intprops.h>
 
-#include "libguile/bytevectors.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/read.h"
-#include "libguile/strings.h"
-#include "libguile/modules.h"
-#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/srfi-4.h"
+#include "bytevectors.h"
+#include "deprecation.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "modules.h"
+#include "ports.h"
+#include "procs.h"
+#include "read.h"
+#include "srfi-4.h"
+#include "strings.h"
+#include "symbols.h"
+#include "syscalls.h"
+#include "threads.h"
+#include "variable.h"
+
+#include "strports.h"
 
-#include "libguile/strports.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
 
 
 
@@ -81,6 +83,8 @@ string_port_read (SCM port, SCM dst, size_t start, size_t count)
   return count;
 }
 
+#define MAX(A, B) ((A) >= (B) ? (A) : (B))
+
 static size_t
 string_port_write (SCM port, SCM src, size_t start, size_t count)
 #define FUNC_NAME "string_port_write"
@@ -97,7 +101,7 @@ string_port_write (SCM port, SCM src, size_t start, size_t count)
         scm_num_overflow (FUNC_NAME);
 
       /* If (old_size * 2) overflows, it's harmless.  */
-      new_size = max (old_size * 2, stream->pos + count);
+      new_size = MAX (old_size * 2, stream->pos + count);
       new_bv = scm_c_make_bytevector (new_size);
       memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv),
               SCM_BYTEVECTOR_CONTENTS (stream->bytevector),
@@ -407,12 +411,6 @@ scm_init_strports ()
 {
   scm_string_port_type = scm_make_string_port_type ();
 
-#include "libguile/strports.x"
+#include "strports.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/strports.h b/libguile/strports.h
index 42080928b..7d7a450c9 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -1,29 +1,30 @@
-/* classes: h_files */
-
 #ifndef SCM_STRPORTS_H
 #define SCM_STRPORTS_H
 
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2002,2006,2008,2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include <libguile/gc.h>
+#include <libguile/ports.h>
 
 
 
@@ -37,6 +38,9 @@
 #define SCM_OPOUTSTRPORTP(x) (SCM_OPSTRPORTP (x) && \
                               (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
 
+#define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \
+  SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port")
+
 
 
 SCM_API scm_t_port_type *scm_string_port_type;
@@ -59,9 +63,3 @@ SCM_API SCM scm_eval_string_in_module (SCM string, SCM module);
 SCM_INTERNAL void scm_init_strports (void);
 
 #endif  /* SCM_STRPORTS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/struct.c b/libguile/struct.c
index b0604f7e1..3dbcc71d4 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1996-2001, 2003-2004, 2006-2013, 2015,
- *               2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-2001,2003-2004,2006-2013,2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
@@ -24,36 +24,36 @@
 
 #include <alloca.h>
 #include <assert.h>
+#include <stdarg.h>
+#include <string.h>
 
 #define SCM_BUILDING_DEPRECATED_CODE
 
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/chars.h"
-#include "libguile/deprecation.h"
-#include "libguile/eval.h"
-#include "libguile/alist.h"
-#include "libguile/hashtab.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
+#include "alist.h"
+#include "async.h"
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "chars.h"
+#include "deprecation.h"
+#include "eq.h"
+#include "eval.h"
+#include "finalizers.h"
+#include "goops.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "symbols.h"
+
+#include "struct.h"
 
-#include "libguile/validate.h"
-#include "libguile/struct.h"
-
-#include "libguile/eq.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-#include "libguile/bdw-gc.h"
 
 
 
-/* A needlessly obscure test. */
-#define SCM_LAYOUT_TAILP(X)		(((X) & 32) == 0) /* R, W or O */
-
 static SCM required_vtable_fields = SCM_BOOL_F;
 static SCM required_applicable_fields = SCM_BOOL_F;
 static SCM required_applicable_with_setter_fields = SCM_BOOL_F;
@@ -70,9 +70,8 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	    "strung together.  The first character of each pair describes a field\n"
 	    "type, the second a field protection.  Allowed types are 'p' for\n"
 	    "GC-protected Scheme data, 'u' for unprotected binary data.  \n"
-            "Allowed protections\n"
-	    "are 'w' for mutable fields, 'h' for hidden fields, and\n"
-            "'r' for read-only fields.\n\n"
+            "Allowed protections are 'w' for normal fields or 'h' for \n"
+            "hidden fields.\n\n"
             "Hidden fields are writable, but they will not consume an initializer arg\n"
             "passed to @code{make-struct}. They are useful to add slots to a struct\n"
             "in a way that preserves backward-compatibility with existing calls to\n"
@@ -99,7 +98,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  {
 	  case 'u':
 	  case 'p':
-	  case 's':
 	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized field type: ~S", 
@@ -110,20 +108,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  {
 	  case 'w':
 	  case 'h':
-	    if (scm_i_string_ref (fields, x) == 's')
-	      SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
 	  case 'r':
-	  case 'o':
-	    break;
-	  case 'R':
-	  case 'W':
-	  case 'O':
-	    if (scm_i_string_ref (fields, x) == 's')
-	      SCM_MISC_ERROR ("self fields not allowed in tail array", 
-			      SCM_EOL);
-	    if (x != len - 2)
-	      SCM_MISC_ERROR ("tail array field must be last field in layout",
-			      SCM_EOL);
 	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized ref specification: ~S",
@@ -138,61 +123,35 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 #undef FUNC_NAME
 
 
-/* Check whether VTABLE instances have a simple layout (i.e., either
-   only "pr" or only "pw" fields and no tail array) and update its flags
-   accordingly.  */
 static void
-set_vtable_layout_flags (SCM vtable)
+set_vtable_access_fields (SCM vtable)
 {
-  size_t len, field;
+  size_t len, nfields, bitmask_size, field;
   SCM layout;
   const char *c_layout;
-  scm_t_bits flags = SCM_VTABLE_FLAG_SIMPLE;
+  uint32_t *unboxed_fields;
 
   layout = SCM_VTABLE_LAYOUT (vtable);
   c_layout = scm_i_symbol_chars (layout);
   len = scm_i_symbol_length (layout);
 
   assert (len % 2 == 0);
+  nfields = len / 2;
 
-  /* Update FLAGS according to LAYOUT.  */
-  for (field = 0;
-       field < len && flags & SCM_VTABLE_FLAG_SIMPLE;
-       field += 2)
-    {
-      if (c_layout[field] != 'p')
-	flags = 0;
-      else
-	switch (c_layout[field + 1])
-	  {
-	  case 'w':
-	    if (field == 0)
-	      flags |= SCM_VTABLE_FLAG_SIMPLE_RW;
-	    break;
-
-	  case 'r':
-	    flags &= ~SCM_VTABLE_FLAG_SIMPLE_RW;
-	    break;
-
-          case 'o':
-          case 'O':
-            scm_c_issue_deprecation_warning
-              ("Opaque struct fields are deprecated.  Struct field protection "
-               "should be layered on at a higher level.");
-            /* Fall through.  */
-
-	  default:
-	    flags = 0;
-	  }
-    }
+  bitmask_size = (nfields + 31U) / 32U;
+  unboxed_fields = scm_gc_malloc_pointerless (bitmask_size, "unboxed fields");
+  memset (unboxed_fields, 0, bitmask_size * sizeof(*unboxed_fields));
 
-  if (flags & SCM_VTABLE_FLAG_SIMPLE)
-    {
-      /* VTABLE is simple so update its flags and record the size of its
-	 instances.  */
-      SCM_SET_VTABLE_FLAGS (vtable, flags);
-      SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
-    }
+  /* Update FLAGS according to LAYOUT.  */
+  for (field = 0; field < nfields; field++)
+    if (c_layout[field*2] == 'u')
+      unboxed_fields[field/32U] |= 1U << (field%32U);
+
+  /* Record computed size of vtable's instances.  */
+  SCM_SET_VTABLE_FLAGS (vtable, 0);
+  SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
+  SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_unboxed_fields,
+                       (uintptr_t) unboxed_fields);
 }
 
 static int
@@ -212,18 +171,16 @@ scm_is_valid_vtable_layout (SCM layout)
       {
       case 'u':
       case 'p':
-      case 's':
         switch (c_layout[n+1])
           {
-          case 'W':
-          case 'R':
-          case 'O':
-            if (n + 2 != len)
-              return 0;
           case 'w':
           case 'h':
+            break;
           case 'r':
-          case 'o':
+            scm_c_issue_deprecation_warning
+              ("Read-only struct fields are deprecated.  Implement access "
+               "control at a higher level instead, as structs no longer "
+               "enforce field permissions.");
             break;
           default:
             return 0;
@@ -235,23 +192,6 @@ scm_is_valid_vtable_layout (SCM layout)
   return 1;
 }
 
-static void
-issue_deprecation_warning_for_self_slots (SCM vtable)
-{
-  SCM olayout;
-  size_t idx, first_user_slot = 0;
-
-  olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (vtable));
-  if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
-    first_user_slot = scm_vtable_offset_user;
-
-  for (idx = first_user_slot * 2; idx < scm_c_string_length (olayout); idx += 2)
-    if (scm_is_eq (scm_c_string_ref (olayout, idx), SCM_MAKE_CHAR ('s')))
-      scm_c_issue_deprecation_warning
-        ("Vtables with \"self\" slots are deprecated.  Initialize these "
-         "fields manually.");
-}
-
 /* Have OBJ, a newly created vtable, inherit flags from VTABLE.  VTABLE is a
    vtable-vtable and OBJ is an instance of VTABLE.  */
 void
@@ -272,7 +212,7 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
     SCM_MISC_ERROR ("invalid layout for new vtable: ~a",
                     scm_list_1 (SCM_VTABLE_LAYOUT (obj)));
 
-  set_vtable_layout_flags (obj);
+  set_vtable_access_fields (obj);
 
   /* If OBJ's vtable is compatible with the required vtable (class) layout, it
      is a metaclass.  */
@@ -311,85 +251,35 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
       SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_APPLICABLE);
     }
 
-  issue_deprecation_warning_for_self_slots (obj);
-
   SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VALIDATED);
 }
 #undef FUNC_NAME
 
 
 static void
-scm_struct_init (SCM handle, SCM layout, size_t n_tail,
-                 size_t n_inits, scm_t_bits *inits)
+scm_struct_init (SCM handle, SCM layout, size_t n_inits, scm_t_bits *inits)
 {
-  SCM vtable;
-  scm_t_bits *mem;
-
-  vtable = SCM_STRUCT_VTABLE (handle);
-  mem = SCM_STRUCT_DATA (handle);
-
-  if (SCM_UNPACK (vtable) != 0
-      && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-      && n_tail == 0
-      && n_inits == SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size))
-    /* The fast path: HANDLE has N_INITS "p" fields.  */
-    memcpy (mem, inits, n_inits * sizeof (SCM));
-  else
+  size_t n, n_fields, inits_idx = 0;
+
+  n_fields = SCM_STRUCT_SIZE (handle);
+
+  for (n = 0; n < n_fields; n++)
     {
-      scm_t_wchar prot = 0;
-      int n_fields = scm_i_symbol_length (layout) / 2;
-      int tailp = 0;
-      int i;
-      size_t inits_idx = 0;
-
-      i = -2;
-      while (n_fields)
-	{
-	  if (!tailp)
-	    {
-	      i += 2;
-	      prot = scm_i_symbol_ref (layout, i+1);
-	      if (SCM_LAYOUT_TAILP (prot))
-		{
-		  tailp = 1;
-		  prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
-		  *mem++ = (scm_t_bits)n_tail;
-		  n_fields += n_tail - 1;
-		  if (n_fields == 0)
-		    break;
-		}
-	    }
-	  switch (scm_i_symbol_ref (layout, i))
-	    {
-	    case 'u':
-	      if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
-		*mem = 0;
-	      else
-		{
-		  *mem = scm_to_ulong (SCM_PACK (inits[inits_idx]));
-		  inits_idx++;
-		}
-	      break;
-
-	    case 'p':
-	      if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
-		*mem = SCM_UNPACK (SCM_BOOL_F);
-	      else
-		{
-		  *mem = inits[inits_idx];
-		  inits_idx++;
-		}
-
-	      break;
-
-	    case 's':
-	      *mem = SCM_UNPACK (handle);
-	      break;
-	    }
-
-	  n_fields--;
-	  mem++;
-	}
+      if (inits_idx == n_inits || scm_i_symbol_ref (layout, n*2+1) == 'h')
+        {
+          if (SCM_STRUCT_FIELD_IS_UNBOXED (handle, n))
+            SCM_STRUCT_DATA_SET (handle, n, 0);
+          else
+            SCM_STRUCT_SLOT_SET (handle, n, SCM_BOOL_F);
+        }
+      else
+        {
+          SCM_STRUCT_DATA_SET (handle, n,
+                               SCM_STRUCT_FIELD_IS_UNBOXED (handle, n)
+                               ? scm_to_uintptr_t (SCM_PACK (inits[inits_idx]))
+                               : inits[inits_idx]);
+          inits_idx++;
+        }
     }
 }
 
@@ -431,30 +321,17 @@ struct_finalizer_trampoline (void *ptr, void *unused_data)
     finalize (obj);
 }
 
-/* All struct data must be allocated at an address whose bottom three
-   bits are zero.  This is because the tag for a struct lives in the
-   bottom three bits of the struct's car, and the upper bits point to
-   the data of its vtable, which is a struct itself.  Thus, if the
-   address of that data doesn't end in three zeros, tagging it will
-   destroy the pointer.
-
-   I suppose we should make it clear here that, the data must be 8-byte aligned,
-   *within* the struct, and the struct itself should be 8-byte aligned. In
-   practice we ensure this because the data starts two words into a struct.
-
-   This function allocates an 8-byte aligned block of memory, whose first word
-   points to the given vtable data, then a data pointer, then n_words of data.
- */
-SCM
-scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
+/* A struct is a sequence of words preceded by a pointer to the struct's
+   vtable.  The vtable reference is tagged with the struct tc3.  */
+static SCM
+scm_i_alloc_struct (scm_t_bits vtable_bits, int n_words)
 {
   SCM ret;
 
-  ret = scm_words ((scm_t_bits)vtable_data | scm_tc3_struct, n_words + 2);
-  SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
+  ret = scm_words (vtable_bits | scm_tc3_struct, n_words + 1);
 
-  /* vtable_data can be null when making a vtable vtable */
-  if (vtable_data && vtable_data[scm_vtable_index_instance_finalize])
+  /* vtable_bits can be 0 when making a vtable vtable */
+  if (vtable_bits && SCM_VTABLE_INSTANCE_FINALIZER (SCM_PACK (vtable_bits)))
     /* Register a finalizer for the newly created instance.  */
     scm_i_set_finalizer (SCM2PTR (ret), struct_finalizer_trampoline, NULL);
 
@@ -466,35 +343,17 @@ SCM
 scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits *init)
 #define FUNC_NAME "make-struct"
 {
-  SCM layout;
   size_t basic_size;
   SCM obj;
 
   SCM_VALIDATE_VTABLE (1, vtable);
 
-  layout = SCM_VTABLE_LAYOUT (vtable);
-  basic_size = scm_i_symbol_length (layout) / 2;
-
-  if (n_tail != 0)
-    {
-      SCM layout_str, last_char;
-      
-      if (basic_size == 0)
-        {
-        bad_tail: 
-          SCM_MISC_ERROR ("tail array not allowed unless layout ends R, W, or O", SCM_EOL);
-        }
-
-      layout_str = scm_symbol_to_string (layout);
-      last_char = scm_string_ref (layout_str,
-                                  scm_from_size_t (2 * basic_size - 1));
-      if (! SCM_LAYOUT_TAILP (SCM_CHAR (last_char)))
-        goto bad_tail;
-    }
+  basic_size = SCM_VTABLE_SIZE (vtable);
 
-  obj = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), basic_size + n_tail);
+  SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, FUNC_NAME);
 
-  scm_struct_init (obj, layout, n_tail, n_init, init);
+  obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size);
+  scm_struct_init (obj, SCM_VTABLE_LAYOUT (vtable), n_init, init);
 
   /* If we're making a vtable, validate its layout and inherit
      flags. However we allow for separation of allocation and
@@ -515,6 +374,8 @@ scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits init, ..
   scm_t_bits *v;
   size_t i;
 
+  SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, "scm_c_make_struct");
+
   v = alloca (sizeof (scm_t_bits) * n_init);
 
   va_start (foo, init);
@@ -525,7 +386,7 @@ scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits init, ..
     }
   va_end (foo);
 
-  return scm_c_make_structv (vtable, n_tail, n_init, v);
+  return scm_c_make_structv (vtable, 0, n_init, v);
 }
 
 SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
@@ -546,19 +407,48 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
   SCM_VALIDATE_VTABLE (1, vtable);
   c_nfields = scm_to_size_t (nfields);
 
-  SCM_ASSERT (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) == c_nfields,
-              nfields, 2, FUNC_NAME);
+  SCM_ASSERT (SCM_VTABLE_SIZE (vtable) == c_nfields, nfields, 2, FUNC_NAME);
+
+  ret = scm_i_alloc_struct (SCM_UNPACK (vtable), c_nfields);
+  scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_struct_simple, "make-struct/simple", 1, 0, 1,
+            (SCM vtable, SCM init),
+	    "Create a new structure.\n\n"
+	    "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
+	    "The @var{init1}, @dots{} arguments supply the initial values\n"
+	    "for the structure's fields\n.\n"
+	    "This is a restricted variant of @code{make-struct/no-tail}\n"
+            "which applies only if the structure has no unboxed fields.\n"
+            "@code{make-struct/simple} must be called with as many\n"
+            "@var{init} values as the struct has fields.  No finalizer is set\n"
+            "on the instance, even if the vtable has a non-zero finalizer\n"
+            "field.  No magical vtable fields are inherited.\n\n"
+            "The advantage of using @code{make-struct/simple} is that the\n"
+            "compiler can inline it, so it is faster.  When in doubt though,\n"
+            "use @code{make-struct/no-tail}.")
+#define FUNC_NAME s_scm_make_struct_simple
+{
+  long i, n_init;
+  SCM ret;
+
+  SCM_VALIDATE_VTABLE (1, vtable);
+  n_init = scm_ilength (init);
+  if (n_init != SCM_VTABLE_SIZE (vtable))
+    SCM_MISC_ERROR ("Wrong number of initializers.", SCM_EOL);
 
-  ret = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), c_nfields);
+  ret = scm_words (SCM_UNPACK (vtable) | scm_tc3_struct, n_init + 1);
 
-  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)))
+  for (i = 0; i < n_init; i++, init = scm_cdr (init))
     {
-      size_t n;
-      for (n = 0; n < c_nfields; n++)
-        SCM_STRUCT_DATA_SET (ret, n, SCM_UNPACK (SCM_BOOL_F));
+      SCM_ASSERT (!SCM_VTABLE_FIELD_IS_UNBOXED (vtable, i),
+                  vtable, 1, FUNC_NAME);
+      SCM_STRUCT_SLOT_SET (ret, i, scm_car (init));
     }
-  else
-    scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, 0, NULL);
 
   return ret;
 }
@@ -570,9 +460,8 @@ SCM_DEFINE (scm_make_struct_no_tail, "make-struct/no-tail", 1, 0, 1,
 	    "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
 	    "The @var{init1}, @dots{} are optional arguments describing how\n"
 	    "successive fields of the structure should be initialized.\n"
-            "Only fields with protection 'r' or 'w' can be initialized.\n"
-            "Hidden fields (those with protection 'h') have to be manually\n"
-            "set.\n\n"
+            "Note that hidden fields (those with protection 'h') have to be\n"
+            "manually set.\n\n"
 	    "If fewer optional arguments than initializable fields are supplied,\n"
 	    "fields of type 'p' get default value #f while fields of type 'u' are\n"
 	    "initialized to 0.")
@@ -608,8 +497,7 @@ scm_i_make_vtable_vtable (SCM fields)
 #define FUNC_NAME "make-vtable-vtable"
 {
   SCM layout, obj;
-  size_t basic_size;
-  scm_t_bits v;
+  size_t n, nfields;
 
   SCM_VALIDATE_STRING (1, fields);
 
@@ -617,16 +505,25 @@ scm_i_make_vtable_vtable (SCM fields)
   if (!scm_is_valid_vtable_layout (layout))
     SCM_MISC_ERROR ("invalid user fields", scm_list_1 (fields));
 
-  basic_size = scm_i_symbol_length (layout) / 2;
+  nfields = scm_i_symbol_length (layout) / 2;
 
-  obj = scm_i_alloc_struct (NULL, basic_size);
+  obj = scm_i_alloc_struct (0, nfields);
   /* Make it so that the vtable of OBJ is itself.  */
-  SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) | scm_tc3_struct);
-
-  v = SCM_UNPACK (layout);
-  scm_struct_init (obj, layout, 0, 1, &v);
-  SCM_SET_VTABLE_FLAGS (obj,
-                        SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
+  SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct);
+  /* Manually initialize fields.  */
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_layout, layout);
+  set_vtable_access_fields (obj);
+  SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_instance_finalize, 0);
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_instance_printer, SCM_BOOL_F);
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_name, SCM_BOOL_F);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_reserved_7, 0);
+
+  for (n = scm_vtable_offset_user; n < nfields; n++)
+    if (SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
+      SCM_STRUCT_DATA_SET (obj, n, 0);
+    else
+      SCM_STRUCT_SLOT_SET (obj, n, SCM_BOOL_F);
 
   return obj;
 }
@@ -653,26 +550,20 @@ SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
 
 
 /* Return true if S1 and S2 are equal structures, i.e., if their vtable and
-   contents are the same.  Field protections are honored.  Thus, it is an
-   error to test the equality of structures that contain opaque fields.  */
+   contents are the same.  */
 SCM
 scm_i_struct_equalp (SCM s1, SCM s2)
 #define FUNC_NAME "scm_i_struct_equalp"
 {
-  SCM vtable1, vtable2, layout;
   size_t struct_size, field_num;
 
   SCM_VALIDATE_STRUCT (1, s1);
   SCM_VALIDATE_STRUCT (2, s2);
 
-  vtable1 = SCM_STRUCT_VTABLE (s1);
-  vtable2 = SCM_STRUCT_VTABLE (s2);
-
-  if (!scm_is_eq (vtable1, vtable2))
+  if (!scm_is_eq (SCM_STRUCT_VTABLE (s1), SCM_STRUCT_VTABLE (s2)))
     return SCM_BOOL_F;
 
-  layout = SCM_STRUCT_LAYOUT (s1);
-  struct_size = scm_i_symbol_length (layout) / 2;
+  struct_size = SCM_STRUCT_SIZE (s1);
 
   for (field_num = 0; field_num < struct_size; field_num++)
     {
@@ -682,35 +573,21 @@ scm_i_struct_equalp (SCM s1, SCM s2)
       field2 = SCM_STRUCT_DATA_REF (s2, field_num);
 
       if (field1 != field2) {
-        switch (scm_i_symbol_ref (layout, field_num * 2))
+        if (SCM_STRUCT_FIELD_IS_UNBOXED (s1, field_num))
+          return SCM_BOOL_F;
+
+        /* Having a normal field point to the object itself is a bit
+           bonkers, but R6RS enums do it, so here we have a horrible
+           hack.  */
+        if (field1 != SCM_UNPACK (s1) && field2 != SCM_UNPACK (s2))
           {
-          case 'p':
-            /* Having a normal field point to the object itself is a bit
-               bonkers, but R6RS enums do it, so here we have a horrible
-               hack.  */
-            if (field1 != SCM_UNPACK (s1) && field2 != SCM_UNPACK (s2))
-              {
-                if (scm_is_false
-                    (scm_equal_p (SCM_PACK (field1), SCM_PACK (field2))))
-                  return SCM_BOOL_F;
-              }
-            break;
-          case 's':
-            /* Skip to avoid infinite recursion.  */
-            break;
-          case 'u':
-            return SCM_BOOL_F;
-          default:
-            /* Don't bother inspecting tail arrays; we never did this in
-               the past and in the future tail arrays are going away
-               anyway.  */
-            return SCM_BOOL_F;
+            if (scm_is_false
+                (scm_equal_p (SCM_PACK (field1), SCM_PACK (field2))))
+              return SCM_BOOL_F;
           }
       }
     }
 
-  /* FIXME: Tail elements should be tested for equality.  */
-
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
@@ -732,75 +609,18 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 	    "word.")
 #define FUNC_NAME s_scm_struct_ref
 {
-  SCM vtable, answer = SCM_UNDEFINED;
-  scm_t_bits *data;
-  size_t p;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
-  vtable = SCM_STRUCT_VTABLE (handle);
-  data = SCM_STRUCT_DATA (handle);
+  nfields = SCM_STRUCT_SIZE (handle);
   p = scm_to_size_t (pos);
 
-  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-  		  && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
-    /* The fast path: HANDLE is a struct with only "p" fields.  */
-    answer = SCM_PACK (data[p]);
-  else
-    {
-      SCM layout;
-      size_t layout_len, n_fields;
-      scm_t_wchar field_type = 0;
-
-      layout = SCM_STRUCT_LAYOUT (handle);
-      layout_len = scm_i_symbol_length (layout);
-      n_fields = layout_len / 2;
-
-      if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
-	n_fields += data[n_fields - 1];
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
 
-      SCM_ASSERT_RANGE (1, pos, p < n_fields);
+  SCM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
 
-      if (p * 2 < layout_len)
-	{
-	  scm_t_wchar ref;
-	  field_type = scm_i_symbol_ref (layout, p * 2);
-	  ref = scm_i_symbol_ref (layout, p * 2 + 1);
-	  if ((ref != 'r') && (ref != 'w') && (ref != 'h'))
-	    {
-	      if ((ref == 'R') || (ref == 'W'))
-		field_type = 'u';
-	      else
-		SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
-	    }
-	}
-      else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
-	field_type = scm_i_symbol_ref(layout, layout_len - 2);
-      else
-	SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
-
-      switch (field_type)
-	{
-	case 'u':
-          scm_c_issue_deprecation_warning
-            ("Accessing unboxed struct fields with struct-ref is deprecated.  "
-             "Use struct-ref/unboxed instead.");
-	  answer = scm_from_ulong (data[p]);
-	  break;
-
-	case 's':
-	case 'p':
-	  answer = SCM_PACK (data[p]);
-	break;
-
-
-	default:
-	  SCM_MISC_ERROR ("unrecognized field type: ~S",
-			  scm_list_1 (SCM_MAKE_CHAR (field_type)));
-	}
-    }
-
-  return answer;
+  return SCM_STRUCT_SLOT_REF (handle, p);
 }
 #undef FUNC_NAME
 
@@ -812,70 +632,18 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
 	    "to.")
 #define FUNC_NAME s_scm_struct_set_x
 {
-  SCM vtable;
-  scm_t_bits *data;
-  size_t p;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
-  vtable = SCM_STRUCT_VTABLE (handle);
-  data = SCM_STRUCT_DATA (handle);
+  nfields = SCM_STRUCT_SIZE (handle);
   p = scm_to_size_t (pos);
 
-  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-  		  && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)
-  		  && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
-    /* The fast path: HANDLE is a struct with only "pw" fields.  */
-    data[p] = SCM_UNPACK (val);
-  else
-    {
-      SCM layout;
-      size_t layout_len, n_fields;
-      scm_t_wchar field_type = 0;
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
 
-      layout = SCM_STRUCT_LAYOUT (handle);
-      layout_len = scm_i_symbol_length (layout);
-      n_fields = layout_len / 2;
+  SCM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
 
-      if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
-	n_fields += data[n_fields - 1];
-
-      SCM_ASSERT_RANGE (1, pos, p < n_fields);
-
-      if (p * 2 < layout_len)
-	{
-	  char set_x;
-	  field_type = scm_i_symbol_ref (layout, p * 2);
-	  set_x = scm_i_symbol_ref (layout, p * 2 + 1);
-	  if (set_x != 'w' && set_x != 'h')
-	    SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
-	}
-      else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
-	field_type = scm_i_symbol_ref (layout, layout_len - 2);
-      else
-	SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
-
-      switch (field_type)
-	{
-	case 'u':
-          scm_c_issue_deprecation_warning
-            ("Accessing unboxed struct fields with struct-set! is deprecated.  "
-             "Use struct-set!/unboxed instead.");
-	  data[p] = SCM_NUM2ULONG (3, val);
-	  break;
-
-	case 'p':
-	  data[p] = SCM_UNPACK (val);
-	  break;
-
-	case 's':
-	  SCM_MISC_ERROR ("self fields immutable", SCM_EOL);
-
-	default:
-	  SCM_MISC_ERROR ("unrecognized field type: ~S",
-			  scm_list_1 (SCM_MAKE_CHAR (field_type)));
-	}
-    }
+  SCM_STRUCT_SLOT_SET (handle, p, val);
 
   return val;
 }
@@ -888,28 +656,16 @@ SCM_DEFINE (scm_struct_ref_unboxed, "struct-ref/unboxed", 2, 0, 0,
 	    "@var{handle}.  The field must be of type 'u'.")
 #define FUNC_NAME s_scm_struct_ref_unboxed
 {
-  SCM vtable, layout;
-  size_t layout_len, n_fields;
-  size_t p;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
-  vtable = SCM_STRUCT_VTABLE (handle);
+  nfields = SCM_STRUCT_SIZE (handle);
   p = scm_to_size_t (pos);
 
-  layout = SCM_VTABLE_LAYOUT (vtable);
-  layout_len = scm_i_symbol_length (layout);
-  n_fields = layout_len / 2;
-
-  SCM_ASSERT_RANGE (1, pos, p < n_fields);
-
-  /* Only 'u' fields, no tail arrays.  */
-  SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'u',
-              layout, 0, FUNC_NAME);
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
 
-  /* Don't support opaque fields.  */
-  SCM_ASSERT (scm_i_symbol_ref (layout, p * 2 + 1) != 'o',
-              layout, 0, FUNC_NAME);
+  SCM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
 
   return scm_from_uintptr_t (SCM_STRUCT_DATA_REF (handle, p));
 }
@@ -923,31 +679,16 @@ SCM_DEFINE (scm_struct_set_x_unboxed, "struct-set!/unboxed", 3, 0, 0,
 	    "to.")
 #define FUNC_NAME s_scm_struct_set_x_unboxed
 {
-  SCM vtable, layout;
-  size_t layout_len, n_fields;
-  size_t p;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
-  vtable = SCM_STRUCT_VTABLE (handle);
+  nfields = SCM_STRUCT_SIZE (handle);
   p = scm_to_size_t (pos);
 
-  layout = SCM_VTABLE_LAYOUT (vtable);
-  layout_len = scm_i_symbol_length (layout);
-  n_fields = layout_len / 2;
-
-  SCM_ASSERT_RANGE (1, pos, p < n_fields);
-
-  /* Only 'u' fields, no tail arrays.  */
-  SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'u',
-              layout, 0, FUNC_NAME);
-
-  /* Don't support opaque fields.  */
-  SCM_ASSERT (scm_i_symbol_ref (layout, p * 2 + 1) != 'o',
-              layout, 0, FUNC_NAME);
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
 
-  if (scm_i_symbol_ref (layout, p * 2 + 1) == 'r')
-    SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
+  SCM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
 
   SCM_STRUCT_DATA_SET (handle, p, scm_to_uintptr_t (val));
 
@@ -1064,16 +805,6 @@ scm_init_struct ()
 {
   SCM name;
 
-  /* The first word of a struct is equal to `SCM_STRUCT_DATA (vtable) +
-     scm_tc3_struct', and `SCM_STRUCT_DATA (vtable)' is 2 words after VTABLE by
-     default.  */
-  GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits) + scm_tc3_struct);
-
-  /* In the general case, `SCM_STRUCT_DATA (obj)' points 2 words after the
-     beginning of a GC-allocated region; that region is different from that of
-     OBJ once OBJ has undergone class redefinition.  */
-  GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
-
   required_vtable_fields = scm_from_latin1_string (SCM_VTABLE_BASE_LAYOUT);
   scm_c_define ("standard-vtable-fields", required_vtable_fields);
   required_applicable_fields = scm_from_latin1_string (SCM_APPLICABLE_BASE_LAYOUT);
@@ -1107,11 +838,5 @@ scm_init_struct ()
   scm_c_define ("vtable-index-printer",
 		scm_from_int (scm_vtable_index_instance_printer));
   scm_c_define ("vtable-offset-user", scm_from_int (scm_vtable_offset_user));
-#include "libguile/struct.x"
+#include "struct.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/struct.h b/libguile/struct.h
index e53bf4f0d..c9533518b 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -1,90 +1,76 @@
-/* classes: h_files */
-
 #ifndef SCM_STRUCT_H
 #define SCM_STRUCT_H
 
-/* Copyright (C) 1995,1997,1999-2001, 2006-2013, 2015,
- *               2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995,1997,1999-2001,2006-2013,2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/boolean.h"
+#include <libguile/error.h>
+#include <libguile/gc.h>
 #include "libguile/print.h"
 
 
 
-/* The relationship between a struct and its vtable is a bit complicated,
-   because we want structs to be used as GOOPS' native representation -- which
-   in turn means we need support for changing the "class" (vtable) of an
-   "instance" (struct). This necessitates some indirection and trickery.
-
-   To summarize, structs are laid out this way:
-
-                  .-------.
-                  |       |
-     .----------------+---v------------- -
-     | vtable | data  | slot0 | slot1 |
-     `----------------+----------------- -
-         |        .-------.
-         |        |       |
-     .---v------------+---v------------- -
-     | vtable | data  | slot0 | slot1 |
-     `----------------+----------------- -
-         |
-         v
+/* Structs are sequences of words where the first word points to the
+   struct's vtable, and the rest are its slots.  The vtable indicates
+   how many words are in the struct among other meta-information.  A
+   vtable is itself a struct and as such has a vtable, and so on until
+   you get to a root struct that is its own vtable.
 
+     .--------+----------------- -
+     | vtable | slot0 | slot1 |
+     `--------+----------------- -
+         |
+         |
+     .---v----+----------------- -
+     | vtable | slot0 | slot1 |
+     `--------+----------------- -
+         |
         ...
-                  .-------.
-         |        |       |
-     .---v------------+---v------------- -
-   .-| vtable | data  | slot0 | slot1 |
-   | `----------------+----------------- -
+         |
+     .---v----+----------------- -
+   .-| vtable | slot0 | slot1 |
+   | `--------+----------------- -
    |     ^
    `-----'
-
-   The DATA indirection (which corresponds to `SCM_STRUCT_DATA ()') is necessary
-   to implement class redefinition.
-
-   For more details, see:
-
-     http://wingolog.org/archives/2009/11/09/class-redefinition-in-guile
-
  */
 
 /* All vtables have the following fields. */
 #define SCM_VTABLE_BASE_LAYOUT                                          \
-  "pr" /* layout */                                                     \
+  "pw" /* layout */                                                     \
   "uh" /* flags */							\
-  "sr" /* self */                                                       \
   "uh" /* finalizer */                                                  \
   "pw" /* printer */                                                    \
   "ph" /* name (hidden from make-struct for back-compat reasons) */     \
   "uh" /* size */							\
+  "uh" /* unboxed fields */						\
   "uh" /* reserved */
 
 #define scm_vtable_index_layout            0 /* A symbol describing the physical arrangement of this type. */
 #define scm_vtable_index_flags	           1 /* Class flags */
-#define scm_vtable_index_self	           2 /* A pointer to the vtable itself */
-#define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */
-#define scm_vtable_index_instance_printer  4 /* A printer for this struct type. */
-#define scm_vtable_index_name              5 /* Name of this vtable. */
-#define scm_vtable_index_size              6 /* Number of fields, for simple structs.  */
+#define scm_vtable_index_instance_finalize 2 /* Finalizer for instances of this struct type. */
+#define scm_vtable_index_instance_printer  3 /* A printer for this struct type. */
+#define scm_vtable_index_name              4 /* Name of this vtable. */
+#define scm_vtable_index_size              5 /* Number of fields, for simple structs.  */
+#define scm_vtable_index_unboxed_fields    6 /* Raw uint32_t* bitmask indicating unboxed fields.  */
 #define scm_vtable_index_reserved_7        7
 #define scm_vtable_offset_user             8 /* Where do user fields start in the vtable? */
 
@@ -109,28 +95,35 @@
 #define SCM_VTABLE_FLAG_APPLICABLE (1L << 3) /* instances of this vtable are applicable? */
 #define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 4) /* instances of this vtable are applicable-with-setter vtables? */
 #define SCM_VTABLE_FLAG_SETTER (1L << 5) /* instances of this vtable are applicable-with-setters? */
-#define SCM_VTABLE_FLAG_SIMPLE (1L << 6) /* instances of this vtable have only "p" fields and no tail array*/
-#define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 7) /* instances of this vtable have only "pw" fields and no tail array */
-#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 8)
-#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 9)
-#define SCM_VTABLE_FLAG_RESERVED_2 (1L << 10)
-#define SCM_VTABLE_FLAG_SMOB_0 (1L << 11)
-#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 12)
-#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 13)
-#define SCM_VTABLE_FLAG_GOOPS_2 (1L << 14)
-#define SCM_VTABLE_FLAG_GOOPS_3 (1L << 15)
+#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 6)
+#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 7)
+#define SCM_VTABLE_FLAG_SMOB_0 (1L << 8)
+#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 9)
+#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 10)
+#define SCM_VTABLE_FLAG_GOOPS_2 (1L << 11)
+#define SCM_VTABLE_FLAG_GOOPS_3 (1L << 12)
+#define SCM_VTABLE_FLAG_GOOPS_4 (1L << 13)
+#define SCM_VTABLE_FLAG_RESERVED_2 (1L << 14)
+#define SCM_VTABLE_FLAG_RESERVED_3 (1L << 15)
 #define SCM_VTABLE_USER_FLAG_SHIFT 16
 
 typedef void (*scm_t_struct_finalize) (SCM obj);
 
 #define SCM_STRUCTP(X)  		(!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct))
-#define SCM_STRUCT_SLOTS(X) 		((SCM*)SCM_CELL_WORD_1 ((X)))
+#define SCM_STRUCT_SLOTS(X) 		(SCM_CELL_OBJECT_LOC(X, 1))
 #define SCM_STRUCT_SLOT_REF(X,I) 	(SCM_STRUCT_SLOTS (X)[(I)])
 #define SCM_STRUCT_SLOT_SET(X,I,V) 	SCM_STRUCT_SLOTS (X)[(I)]=(V)
-#define SCM_STRUCT_DATA(X) 		((scm_t_bits*)SCM_CELL_WORD_1 (X))
+#define SCM_STRUCT_DATA(X) 		((scm_t_bits*)SCM_STRUCT_SLOTS (X))
 #define SCM_STRUCT_DATA_REF(X,I) 	(SCM_STRUCT_DATA (X)[(I)])
 #define SCM_STRUCT_DATA_SET(X,I,V) 	SCM_STRUCT_DATA (X)[(I)]=(V)
 
+#define SCM_VALIDATE_STRUCT(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct")
+#define SCM_VALIDATE_VTABLE(pos, v) \
+  do { \
+    SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \
+  } while (0)
+
 /* The SCM_VTABLE_* macros assume that you're passing them a struct which is a
    valid vtable. */
 #define SCM_VTABLE_LAYOUT(X)            (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout))
@@ -145,19 +138,18 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
 #define SCM_SET_VTABLE_INSTANCE_PRINTER(X,P) (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_instance_printer, (P)))
 #define SCM_VTABLE_NAME(X)              (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_name))
 #define SCM_SET_VTABLE_NAME(X,V)        (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_name, V))
-
-/* Structs hold a pointer to their vtable's data, not the vtable itself. To get
-   the vtable we have to do an indirection through the self slot. */
-#define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
-#define SCM_STRUCT_VTABLE_SLOTS(X)      ((SCM*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
-#define SCM_STRUCT_VTABLE(X)            (SCM_STRUCT_VTABLE_SLOTS(X)[scm_vtable_index_self])
-/* But often we just need to access the vtable's data; we can do that without
-   the data->self->data indirection. */
-#define SCM_STRUCT_LAYOUT(X) 	        (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_layout])
-#define SCM_STRUCT_PRINTER(X) 	        (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_instance_printer])
-#define SCM_STRUCT_FINALIZER(X)         ((scm_t_struct_finalize)SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_instance_finalize])
-#define SCM_STRUCT_VTABLE_FLAGS(X) 	(SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags])
-#define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags]&(F))
+#define SCM_VTABLE_SIZE(X)              (SCM_STRUCT_DATA_REF (X, scm_vtable_index_size))
+#define SCM_VTABLE_UNBOXED_FIELDS(X)    ((uint32_t*) SCM_STRUCT_DATA_REF (X, scm_vtable_index_unboxed_fields))
+#define SCM_VTABLE_FIELD_IS_UNBOXED(X,F) (SCM_VTABLE_UNBOXED_FIELDS (X)[(F)>>5]&(1U<<((F)&31)))
+
+#define SCM_STRUCT_VTABLE(X)            (SCM_PACK (SCM_CELL_WORD_0 (X) - scm_tc3_struct))
+#define SCM_STRUCT_LAYOUT(X) 	        (SCM_VTABLE_LAYOUT (SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_SIZE(X) 	        (SCM_VTABLE_SIZE (SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_PRINTER(X) 	        (SCM_VTABLE_INSTANCE_PRINTER (SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_FINALIZER(X)         (SCM_VTABLE_INSTANCE_FINALIZER (SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_VTABLE_FLAGS(X)      (SCM_VTABLE_FLAGS (SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_VTABLE_FLAG_IS_SET (SCM_STRUCT_VTABLE (X), (F)))
+#define SCM_STRUCT_FIELD_IS_UNBOXED(X,F) (SCM_VTABLE_FIELD_IS_UNBOXED (SCM_STRUCT_VTABLE (X), (F)))
 
 #define SCM_STRUCT_APPLICABLE_P(X) 	(SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_APPLICABLE))
 #define SCM_STRUCT_SETTER_P(X) 	        (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_SETTER))
@@ -176,6 +168,7 @@ SCM_API SCM scm_make_struct_layout (SCM fields);
 SCM_API SCM scm_struct_p (SCM x);
 SCM_API SCM scm_struct_vtable_p (SCM x);
 SCM_INTERNAL SCM scm_allocate_struct (SCM vtable, SCM n_words);
+SCM_INTERNAL SCM scm_make_struct_simple (SCM vtable, SCM init);
 SCM_API SCM scm_make_struct_no_tail (SCM vtable, SCM init);
 SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
                                scm_t_bits init, ...);
@@ -194,14 +187,7 @@ SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *);
 
 SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2);
 SCM_INTERNAL unsigned long scm_struct_ihashq (SCM, unsigned long, void *);
-SCM_INTERNAL SCM scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words);
 SCM_INTERNAL void scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj);
 SCM_INTERNAL void scm_init_struct (void);
 
 #endif  /* SCM_STRUCT_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/symbols.c b/libguile/symbols.c
index ab4b2cdd1..b9d575778 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995-1998, 2000, 2001, 2003, 2004, 2006, 2009, 2011,
- *   2013, 2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009,2011,2013,2015,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,32 +23,33 @@
 #  include <config.h>
 #endif
 
+#include <string.h>
 #include <unistr.h>
 
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/hash.h"
-#include "libguile/smob.h"
-#include "libguile/variable.h"
-#include "libguile/alist.h"
-#include "libguile/fluids.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/weak-set.h"
-#include "libguile/modules.h"
-#include "libguile/read.h"
-#include "libguile/srfi-13.h"
+#include "alist.h"
+#include "boolean.h"
+#include "chars.h"
+#include "eval.h"
+#include "fluids.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "private-options.h"
+#include "read.h"
+#include "smob.h"
+#include "srfi-13.h"
+#include "strings.h"
+#include "strorder.h"
+#include "threads.h"
+#include "variable.h"
+#include "vectors.h"
+#include "weak-set.h"
+
+#include "symbols.h"
 
-#include "libguile/validate.h"
-#include "libguile/symbols.h"
-
-#include "libguile/private-options.h"
-
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
 
 
 
@@ -154,7 +155,7 @@ struct utf8_lookup_data
 };
 
 static int
-utf8_string_equals_wide_string (const scm_t_uint8 *narrow, size_t nlen,
+utf8_string_equals_wide_string (const uint8_t *narrow, size_t nlen,
                                 const scm_t_wchar *wide, size_t wlen)
 {
   size_t byte_idx = 0, char_idx = 0;
@@ -192,7 +193,7 @@ utf8_lookup_predicate_fn (SCM sym, void *closure)
     return (scm_i_symbol_length (sym) == data->len
             && strncmp (scm_i_symbol_chars (sym), data->str, data->len) == 0);
   else
-    return utf8_string_equals_wide_string ((const scm_t_uint8 *) data->str,
+    return utf8_string_equals_wide_string ((const uint8_t *) data->str,
                                            data->len,
                                            scm_i_symbol_wide_chars (sym),
                                            scm_i_symbol_length (sym));
@@ -556,13 +557,7 @@ scm_symbols_prehistory ()
 void
 scm_init_symbols ()
 {
-#include "libguile/symbols.x"
+#include "symbols.x"
 
   default_gensym_prefix = scm_from_latin1_string (" g");
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/symbols.h b/libguile/symbols.h
index f345e7033..e2a1d173f 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -1,29 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_SYMBOLS_H
 #define SCM_SYMBOLS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include <libguile/error.h>
+#include <libguile/gc.h>
+#include <libguile/snarf.h>
+#include <libguile/strings.h>
+
+
 
 
 #define scm_is_symbol(x)            (SCM_HAS_TYP7 (x, scm_tc7_symbol))
@@ -33,6 +37,44 @@
 
 #define SCM_I_F_SYMBOL_UNINTERNED   0x100
 
+#define SCM_VALIDATE_SYMBOL(pos, str) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
+  } while (0)
+
+
+
+
+#ifdef SCM_SUPPORT_STATIC_ALLOCATION
+
+# define SCM_SYMBOL(c_name, scheme_name)				\
+SCM_SNARF_HERE(								\
+  SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name);	\
+  static SCM c_name)							\
+SCM_SNARF_INIT(								\
+  c_name = scm_string_to_symbol (scm_i_paste (c_name, _string))		\
+)
+
+# define SCM_GLOBAL_SYMBOL(c_name, scheme_name)				\
+SCM_SNARF_HERE(								\
+  SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name);	\
+  SCM c_name)								\
+SCM_SNARF_INIT(								\
+  c_name = scm_string_to_symbol (scm_i_paste (c_name, _string))		\
+)
+
+#else /* !SCM_SUPPORT_STATIC_ALLOCATION */
+
+# define SCM_SYMBOL(c_name, scheme_name)				\
+SCM_SNARF_HERE(static SCM c_name)					\
+SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
+
+# define SCM_GLOBAL_SYMBOL(c_name, scheme_name)				\
+SCM_SNARF_HERE(SCM c_name)						\
+SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
+
+#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
+
 
 
 /* Older spellings; don't use in new code.
@@ -96,9 +138,3 @@ SCM_INTERNAL void scm_symbols_prehistory (void);
 SCM_INTERNAL void scm_init_symbols (void);
 
 #endif  /* SCM_SYMBOLS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/syntax.c b/libguile/syntax.c
index df12c69c4..2da4e395e 100644
--- a/libguile/syntax.c
+++ b/libguile/syntax.c
@@ -1,32 +1,39 @@
-/* Copyright (C) 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/keywords.h"
-#include "libguile/ports.h"
-#include "libguile/syntax.h"
-#include "libguile/validate.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "keywords.h"
+#include "modules.h"
+#include "ports.h"
+#include "threads.h"
+#include "variable.h"
+
+#include "syntax.h"
+
 
 
 
@@ -109,12 +116,6 @@ scm_i_syntax_print (SCM obj, SCM port, scm_print_state *pstate)
 void
 scm_init_syntax ()
 {
-#include "libguile/syntax.x"
+#include "syntax.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/syntax.h b/libguile/syntax.h
index 7fdfd2891..16229f659 100644
--- a/libguile/syntax.h
+++ b/libguile/syntax.h
@@ -1,25 +1,26 @@
 #ifndef SCM_SYNTAX_H
 #define SCM_SYNTAX_H
 
-/* Copyright (C) 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-#include "libguile/__scm.h"
+/* Copyright 2017-2018
+    Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+#include "libguile/scm.h"
 
 SCM_INTERNAL SCM scm_syntax_p (SCM obj);
 SCM_INTERNAL SCM scm_make_syntax (SCM exp, SCM wrap, SCM module);
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
new file mode 100644
index 000000000..30b99c193
--- /dev/null
+++ b/libguile/syscalls.h
@@ -0,0 +1,87 @@
+#ifndef SCM_SYSCALLS_H
+#define SCM_SYSCALLS_H
+
+/* Copyright 1995-1996,2000-2002,2006,2008-2011,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+/* ASYNC_TICK after finding EINTR in order to handle pending signals, if
+   any. See comment in scm_syserror. */
+#define SCM_SYSCALL(line)			\
+  do						\
+    {						\
+      errno = 0;				\
+      line;					\
+      if (errno == EINTR)			\
+	{					\
+          scm_async_tick ();                    \
+	  errno = EINTR;			\
+	}					\
+    }						\
+  while (errno == EINTR)
+
+
+
+
+#if defined GUILE_USE_64_CALLS && GUILE_USE_64_CALLS && defined(HAVE_STAT64)
+#define CHOOSE_LARGEFILE(foo,foo64)     foo64
+#else
+#define CHOOSE_LARGEFILE(foo,foo64)     foo
+#endif
+
+/* These names are a bit long, but they make it clear what they represent. */
+#if SCM_HAVE_STRUCT_DIRENT64 == 1
+# define dirent_or_dirent64             CHOOSE_LARGEFILE(dirent,dirent64)
+#else
+# define dirent_or_dirent64             dirent
+#endif
+#define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
+#define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
+#define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
+#define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
+#define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
+#define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
+#define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
+#if SCM_HAVE_READDIR64_R == 1
+# define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
+#else
+# define readdir_r_or_readdir64_r       readdir_r
+#endif
+#define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
+#define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
+#define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
+#define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
+#define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
+#define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)
+
+#if SIZEOF_OFF_T == 4
+#  define scm_to_off_t    scm_to_int32
+#  define scm_from_off_t  scm_from_int32
+#elif SIZEOF_OFF_T == 8
+#  define scm_to_off_t    scm_to_int64
+#  define scm_from_off_t  scm_from_int64
+#else
+#  error sizeof(off_t) is not 4 or 8.
+#endif
+#define scm_to_off64_t    scm_to_int64
+#define scm_from_off64_t  scm_from_int64
+
+
+#endif  /* SCM_SYSCALLS_H */
diff --git a/libguile/tags.h b/libguile/tags.h
index 47c4c9749..db2106789 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -1,659 +1 @@
-/* classes: h_files */
-
-#ifndef SCM_TAGS_H
-#define SCM_TAGS_H
-
-/* Copyright (C) 1995-2004, 2008-2015 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-/** This file defines the format of SCM values and cons pairs.
- ** It is here that tag bits are assigned for various purposes.
- **/
-
-/* picks up scmconfig.h too */
-#include "libguile/__scm.h"
-
-
-
-/* In the beginning was the Word:
- *
- * For the representation of scheme objects and their handling, Guile provides
- * two types:  scm_t_bits and SCM.
- *
- * - scm_t_bits values can hold bit patterns of non-objects and objects:
- *
- *   Non-objects -- in this case the value may not be changed into a SCM value
- *   in any way.
- *
- *   Objects -- in this case the value may be changed into a SCM value using
- *   the SCM_PACK macro.
- *
- * - SCM values can hold proper scheme objects only.  They can be changed into
- *   a scm_t_bits value using the SCM_UNPACK macro.
- *
- * When working in the domain of scm_t_bits values, programmers must keep
- * track of any scm_t_bits value they create that is not a proper scheme
- * object.  This makes sure that in the domain of SCM values developers can
- * rely on the fact that they are dealing with proper scheme objects only.
- * Thus, the distinction between scm_t_bits and SCM values helps to identify
- * those parts of the code where special care has to be taken not to create
- * bad SCM values.
- */
-
-/* For dealing with the bit level representation of scheme objects we define
- * scm_t_bits:
- */
-
-typedef scm_t_intptr  scm_t_signed_bits;
-typedef scm_t_uintptr scm_t_bits;
-
-#define SCM_T_SIGNED_BITS_MAX SCM_T_INTPTR_MAX
-#define SCM_T_SIGNED_BITS_MIN SCM_T_INTPTR_MIN
-#define SCM_T_BITS_MAX        SCM_T_UINTPTR_MAX
-
-
-/* But as external interface, we define SCM, which may, according to the
- * desired level of type checking, be defined in several ways:
- */
-#if (SCM_DEBUG_TYPING_STRICTNESS == 2)
-typedef union SCM { struct { scm_t_bits n; } n; } SCM;
-#   define SCM_UNPACK(x) ((x).n.n)
-#   define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
-#elif (SCM_DEBUG_TYPING_STRICTNESS == 1)
-/* This is the default, which provides an intermediate level of compile time
- * type checking while still resulting in very efficient code.
- */
-    typedef struct scm_unused_struct { char scm_unused_field; } *SCM;
-
-/*
-  The 0?: constructions makes sure that the code is never executed,
-  and that there is no performance hit.  However, the alternative is
-  compiled, and does generate a warning when used with the wrong
-  pointer type.  We use a volatile pointer type to avoid warnings
-  from clang.
-
-  The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)'
-  statements, so for them type-checking is disabled.  */
-#if defined __DECC || defined __HP_cc
-#   define SCM_UNPACK(x) ((scm_t_bits) (x))
-#else
-#   define SCM_UNPACK(x) ((scm_t_bits) (0? (*(volatile SCM *)0=(x)): x))
-#endif
-
-/*
-  There is no typechecking on SCM_PACK, since all kinds of types
-  (unsigned long, void*) go in SCM_PACK
- */
-#   define SCM_PACK(x) ((SCM) (x))
-
-#else
-/* This should be used as a fall back solution for machines on which casting
- * to a pointer may lead to loss of bit information, e. g. in the three least
- * significant bits.
- */
-    typedef scm_t_bits SCM;
-#   define SCM_UNPACK(x) (x)
-#   define SCM_PACK(x) ((SCM) (x))
-#endif
-
-/* Packing SCM objects into and out of pointers.
- */
-#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
-#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
-
-
-/* SCM values can not be compared by using the operator ==.  Use the following
- * macro instead, which is the equivalent of the scheme predicate 'eq?'.
- */
-#define scm_is_eq(x, y) (SCM_UNPACK (x) == SCM_UNPACK (y))
-
-
-
-/* Representation of scheme objects:
- *
- * Guile's type system is designed to work on systems where scm_t_bits
- * and SCM variables consist of at least 32 bits.  The objects that a
- * SCM variable can represent belong to one of the following two major
- * categories:
- *
- * - Immediates -- meaning that the SCM variable contains an entire
- *   Scheme object.  That means, all the object's data (including the
- *   type tagging information that is required to identify the object's
- *   type) must fit into 32 bits.
- *
- * - Heap objects -- meaning that the SCM variable holds a pointer into
- *   the heap.  On systems where a pointer needs more than 32 bits this
- *   means that scm_t_bits and SCM variables need to be large enough to
- *   hold such pointers.  In contrast to immediates, the data associated
- *   with a heap object can consume arbitrary amounts of memory.
- *
- * The 'heap' is the memory area that is under control of Guile's
- * garbage collector.  It holds allocated memory of various sizes.  The
- * impact on the runtime type system is that Guile needs to be able to
- * determine the type of an object given the pointer.  Usually the way
- * that Guile does this is by storing a "type tag" in the first word of
- * the object.
- *
- * Some objects are common enough that they get special treatment.
- * Since Guile guarantees that the address of a GC-allocated object on
- * the heap is 8-byte aligned, Guile can play tricks with the lower 3
- * bits.  That is, since heap objects encode a pointer to an
- * 8-byte-aligned pointer, the three least significant bits of a SCM can
- * be used to store additional information.  The bits are used to store
- * information about the object's type and thus are called tc3-bits,
- * where tc stands for type-code.
- *
- * For a given SCM value, the distinction whether it holds an immediate
- * or heap object is based on the tc3-bits (see above) of its scm_t_bits
- * equivalent: If the tc3-bits equal #b000, then the SCM value holds a
- * heap object, and the scm_t_bits variable's value is just the pointer
- * to the heap cell.
- *
- * Summarized, the data of a scheme object that is represented by a SCM
- * variable consists of a) the SCM variable itself, b) in case of heap
- * objects memory that the SCM object points to, c) in case of heap
- * objects potentially additional data outside of the heap (like for
- * example malloc'ed data), and d) in case of heap objects potentially
- * additional data inside of the heap, since data stored in b) and c)
- * may hold references to other cells.
- *
- *
- * Immediates
- *
- * Operations on immediate objects can typically be processed faster than on
- * heap objects.  The reason is that the object's data can be extracted
- * directly from the SCM variable (or rather a corresponding scm_t_bits
- * variable), instead of having to perform additional memory accesses to
- * obtain the object's data from the heap.  In order to get the best possible
- * performance frequently used data types should be realized as immediates.
- * This is, as has been mentioned above, only possible if the objects can be
- * represented with 32 bits (including type tagging).
- *
- * In Guile, the following data types and special objects are realized as
- * immediates: booleans, characters, small integers (see below), the empty
- * list, the end of file object, the 'unspecified' object (which is delivered
- * as a return value by functions for which the return value is unspecified),
- * a 'nil' object used in the elisp-compatibility mode and certain other
- * 'special' objects which are only used internally in Guile.
- *
- * Integers in Guile can be arbitrarily large.  On the other hand, integers
- * are one of the most frequently used data types.  Especially integers with
- * less than 32 bits are commonly used.  Thus, internally and transparently
- * for application code guile distinguishes between small and large integers.
- * Whether an integer is a large or a small integer depends on the number of
- * bits needed to represent its value.  Small integers are those which can be
- * represented as immediates.  Since they don't require more than a fixed
- * number of bits for their representation, they are also known as 'fixnums'.
- *
- * The tc3-combinations #b010 and #b110 are used to represent small integers,
- * which allows to use the most significant bit of the tc3-bits to be part of
- * the integer value being represented.  This means that all integers with up
- * to 30 bits (including one bit for the sign) can be represented as
- * immediates.  On systems where SCM and scm_t_bits variables hold more than
- * 32 bits, the amount of bits usable for small integers will even be larger.
- * The tc3-code #b100 is shared among booleans, characters and the other
- * special objects listed above.
- *
- *
- * Heap Objects
- *
- * All object types not mentioned above in the list of immediate objects
- * are represented as heap objects.  The amount of memory referenced by
- * a heap object depends on the object's type, namely on the set of
- * attributes that have to be stored with objects of that type.  Every
- * heap object type is allowed to define its own layout and
- * interpretation of the data stored in its cell (with some
- * restrictions, see below).
- *
- * One of the design goals of guile's type system is to make it possible
- * to store a scheme pair with as little memory usage as possible.  The
- * minimum amount of memory that is required to store two scheme objects
- * (car and cdr of a pair) is the amount of memory required by two
- * scm_t_bits or SCM variables.  Therefore pairs in guile are stored in
- * two words, and are tagged with a bit pattern in the SCM value, not
- * with a type tag on the heap.
- *
- *
- * Garbage collection
- *
- * During garbage collection, unreachable objects on the heap will be
- * freed.  To determine the set of reachable objects, by default, the GC
- * just traces all words in all heap objects.  It is possible to
- * register custom tracing ("marking") procedures.
- *
- * If an object is unreachable, by default, the GC just notes this fact
- * and moves on.  Later allocations will clear out the memory associated
- * with the object, and re-use it.  It is possible to register custom
- * finalizers, however.
- *
- *
- * Run-time type introspection
- *
- * Guile's type system is designed to make it possible to determine a
- * the type of a heap object from the object's first scm_t_bits
- * variable.  (Given a SCM variable X holding a heap object, the macro
- * SCM_CELL_TYPE(X) will deliver the corresponding object's first
- * scm_t_bits variable.)
- *
- * If the object holds a scheme pair, then we already know that the
- * first scm_t_bits variable of the cell will hold a scheme object with
- * one of the following tc3-codes: #b000 (heap object), #b010 (small
- * integer), #b110 (small integer), #b100 (non-integer immediate).  All
- * these tc3-codes have in common, that their least significant bit is
- * #b0.  This fact is used by the garbage collector to identify cells
- * that hold pairs.  The remaining tc3-codes are assigned as follows:
- * #b001 (class instance or, more precisely, a struct, of which a class
- * instance is a special case), #b011 (closure), #b101/#b111 (all
- * remaining heap object types).
- *
- *
- * Summary of type codes of scheme objects (SCM variables)
- *
- * Here is a summary of tagging bits as they might occur in a scheme object.
- * The notation is as follows: tc stands for type code as before, tc<n> with n
- * being a number indicates a type code formed by the n least significant bits
- * of the SCM variables corresponding scm_t_bits value.
- *
- * Note that (as has been explained above) tc1==1 can only occur in the first
- * scm_t_bits variable of a cell belonging to a heap object that is
- * not a pair.  For an explanation of the tc tags with tc1==1, see the next
- * section with the summary of the type codes on the heap.
- *
- * tc1:
- *   0:  For scheme objects, tc1==0 must be fulfilled.
- *  (1:  This can never be the case for a scheme object.)
- *
- * tc2:
- *   00:  Either a heap object or some non-integer immediate
- *  (01:  This can never be the case for a scheme object.)
- *   10:  Small integer
- *  (11:  This can never be the case for a scheme object.)
- *
- * tc3:
- *   000:  a heap object (pair, closure, class instance etc.)
- *  (001:  This can never be the case for a scheme object.)
- *   010:  an even small integer (least significant bit is 0).
- *  (011:  This can never be the case for a scheme object.)
- *   100:  Non-integer immediate
- *  (101:  This can never be the case for a scheme object.)
- *   110:  an odd small integer (least significant bit is 1).
- *  (111:  This can never be the case for a scheme object.)
- *
- * The remaining bits of the heap objects form the pointer to the heap
- * cell.  The remaining bits of the small integers form the integer's
- * value and sign.  Thus, the only scheme objects for which a further
- * subdivision is of interest are the ones with tc3==100.
- *
- * tc8 (for objects with tc3==100):
- *   00000-100:  special objects ('flags')
- *   00001-100:  characters
- *   00010-100:  unused
- *   00011-100:  unused
- *
- *
- * Summary of type codes on the heap
- *
- * Here is a summary of tagging in scm_t_bits values as they might occur in
- * the first scm_t_bits variable of a heap cell.
- *
- * tc1:
- *   0:  the cell belongs to a pair.
- *   1:  the cell belongs to a non-pair.
- *
- * tc2:
- *   00:  the cell belongs to a pair with no short integer in its car.
- *   01:  the cell belongs to a non-pair (struct or some other heap object).
- *   10:  the cell belongs to a pair with a short integer in its car.
- *   11:  the cell belongs to a non-pair (closure or some other heap object).
- *
- * tc3:
- *   000:  the cell belongs to a pair with a heap object in its car.
- *   001:  the cell belongs to a struct
- *   010:  the cell belongs to a pair with an even short integer in its car.
- *   011:  the cell belongs to a closure
- *   100:  the cell belongs to a pair with a non-integer immediate in its car.
- *   101:  the cell belongs to some other heap object.
- *   110:  the cell belongs to a pair with an odd short integer in its car.
- *   111:  the cell belongs to some other heap object.
- *
- * tc7 (for tc3==1x1):
- *   See below for the list of types.  Three special tc7-codes are of
- *   interest: numbers, ports and smobs in fact each represent
- *   collections of types, which are subdivided using tc16-codes.
- *
- * tc16 (for tc7==scm_tc7_smob):
- *   The largest part of the space of smob types is not subdivided in a
- *   predefined way, since smobs can be added arbitrarily by user C code.
- */
-
-
-
-/* Checking if a SCM variable holds an immediate or a heap object:
- * This check can either be performed by checking for tc3==000 or tc3==00x,
- * since for a SCM variable it is known that tc1==0.  */
-#define SCM_IMP(x) 		(6 & SCM_UNPACK (x))
-#define SCM_NIMP(x) 		(!SCM_IMP (x))
-#define SCM_HEAP_OBJECT_P(x)    (SCM_NIMP (x))
-
-/* Checking if a SCM variable holds a pair (for historical reasons, in Guile
- * also known as a cons-cell): This is done by first checking that the SCM
- * variable holds a heap object, and second, by checking that tc1==0 holds
- * for the SCM_CELL_TYPE of the SCM variable.  
-*/
-
-#define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
-
-
-
-/* Definitions for tc2: */
-
-#define scm_tc2_int              2
-
-
-/* Definitions for tc3: */
-
-#define SCM_ITAG3(x) 		 (7 & SCM_UNPACK (x))
-#define SCM_TYP3(x) 		 (7 & SCM_CELL_TYPE (x))
-
-#define scm_tc3_cons	 	 0
-#define scm_tc3_struct    	 1
-#define scm_tc3_int_1		 (scm_tc2_int + 0)
-#define scm_tc3_unused		 3
-#define scm_tc3_imm24		 4
-#define scm_tc3_tc7_1		 5
-#define scm_tc3_int_2		 (scm_tc2_int + 4)
-#define scm_tc3_tc7_2		 7
-
-
-/* Definitions for tc7: */
-
-#define SCM_ITAG7(x) 		(0x7f & SCM_UNPACK (x))
-#define SCM_TYP7(x) 		(0x7f & SCM_CELL_TYPE (x))
-#define SCM_HAS_HEAP_TYPE(x, type, tag)                         \
-  (SCM_NIMP (x) && type (x) == (tag))
-#define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
-
-/* These type codes form part of the ABI and cannot be changed in a
-   stable series.  The low bits of each must have the tc3 of a heap
-   object type code (see above).  If you do change them in a development
-   series, change them also in (system vm assembler) and (system base
-   types).  Bonus points if you change the build to define these tag
-   values in only one place!  */
-
-#define scm_tc7_symbol		0x05
-#define scm_tc7_variable        0x07
-#define scm_tc7_vector		0x0d
-#define scm_tc7_wvect		0x0f
-#define scm_tc7_string		0x15
-#define scm_tc7_number		0x17
-#define scm_tc7_hashtable	0x1d
-#define scm_tc7_pointer		0x1f
-#define scm_tc7_fluid		0x25
-#define scm_tc7_stringbuf       0x27
-#define scm_tc7_dynamic_state	0x2d
-#define scm_tc7_frame		0x2f
-#define scm_tc7_keyword		0x35
-#define scm_tc7_atomic_box	0x37
-#define scm_tc7_syntax		0x3d
-#define scm_tc7_unused_3f	0x3f
-#define scm_tc7_program		0x45
-#define scm_tc7_vm_cont		0x47
-#define scm_tc7_bytevector	0x4d
-#define scm_tc7_unused_4f	0x4f
-#define scm_tc7_weak_set	0x55
-#define scm_tc7_weak_table	0x57
-#define scm_tc7_array		0x5d
-#define scm_tc7_bitvector	0x5f
-#define scm_tc7_unused_65	0x65
-#define scm_tc7_unused_67	0x67
-#define scm_tc7_unused_6d	0x6d
-#define scm_tc7_unused_6f	0x6f
-#define scm_tc7_unused_75	0x75
-#define scm_tc7_smob		0x77
-#define scm_tc7_port		0x7d
-#define scm_tc7_unused_7f	0x7f
-
-
-/* Definitions for tc16: */
-#define SCM_TYP16(x) 		(0xffff & SCM_CELL_TYPE (x))
-#define SCM_HAS_TYP16(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP16, tag))
-#define SCM_TYP16_PREDICATE(tag, x) (SCM_HAS_TYP16 (x, tag))
-
-
-
-
-/* {Immediate Values}
- */
-
-enum scm_tc8_tags
-{
-  scm_tc8_flag = scm_tc3_imm24 + 0x00,  /* special objects ('flags') */
-  scm_tc8_char = scm_tc3_imm24 + 0x08,  /* characters */
-  scm_tc8_unused_0 = scm_tc3_imm24 + 0x10,
-  scm_tc8_unused_1 = scm_tc3_imm24 + 0x18
-};
-
-#define SCM_ITAG8(X)		(SCM_UNPACK (X) & 0xff)
-#define SCM_MAKE_ITAG8_BITS(X, TAG) (((X) << 8) + TAG)
-#define SCM_MAKE_ITAG8(X, TAG)	(SCM_PACK (SCM_MAKE_ITAG8_BITS (X, TAG)))
-#define SCM_ITAG8_DATA(X)	(SCM_UNPACK (X) >> 8)
-
-
-
-/* Flags (special objects).  The indices of the flags must agree with the
- * declarations in print.c: iflagnames.  */
-
-#define SCM_IFLAGP(n)    (SCM_ITAG8 (n) == scm_tc8_flag)
-#define SCM_MAKIFLAG_BITS(n)  (SCM_MAKE_ITAG8_BITS ((n), scm_tc8_flag))
-#define SCM_IFLAGNUM(n)  (SCM_ITAG8_DATA (n))
-
-/*
- * IMPORTANT NOTE regarding IFLAG numbering!!!
- *
- * Several macros depend upon careful IFLAG numbering of SCM_BOOL_F,
- * SCM_BOOL_T, SCM_ELISP_NIL, SCM_EOL, and the two SCM_XXX_*_DONT_USE
- * constants.  In particular:
- *
- * - SCM_BOOL_F and SCM_BOOL_T must differ in exactly one bit position.
- *   (used to implement scm_is_bool_and_not_nil, aka scm_is_bool)
- *
- * - SCM_ELISP_NIL and SCM_BOOL_F must differ in exactly one bit position.
- *   (used to implement scm_is_false_or_nil and
- *    scm_is_true_and_not_nil)
- *
- * - SCM_ELISP_NIL and SCM_EOL must differ in exactly one bit position.
- *   (used to implement scm_is_null_or_nil)
- *
- * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE
- *   must all be equal except for two bit positions.
- *   (used to implement scm_is_lisp_false)
- *
- * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0
- *   must all be equal except for two bit positions.
- *   (used to implement scm_is_bool_or_nil)
- *
- * These properties allow the aforementioned macros to be implemented
- * by bitwise ANDing with a mask and then comparing with a constant,
- * using as a common basis the macro SCM_MATCHES_BITS_IN_COMMON,
- * defined below.  The properties are checked at compile-time using
- * `verify' macros near the top of boolean.c and pairs.c.
- */
-#define SCM_BOOL_F_BITS		SCM_MAKIFLAG_BITS (0)
-#define SCM_ELISP_NIL_BITS	SCM_MAKIFLAG_BITS (1)
-
-#define SCM_BOOL_F		SCM_PACK (SCM_BOOL_F_BITS)
-#define SCM_ELISP_NIL		SCM_PACK (SCM_ELISP_NIL_BITS)
-
-#ifdef BUILDING_LIBGUILE
-#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE	SCM_MAKIFLAG_BITS (2)
-#endif
-
-#define SCM_EOL_BITS		SCM_MAKIFLAG_BITS (3)
-#define SCM_BOOL_T_BITS 	SCM_MAKIFLAG_BITS (4)
-
-#define SCM_EOL			SCM_PACK (SCM_EOL_BITS)
-#define SCM_BOOL_T 		SCM_PACK (SCM_BOOL_T_BITS)
-
-#ifdef BUILDING_LIBGUILE
-#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0	SCM_MAKIFLAG_BITS (5)
-#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1	SCM_MAKIFLAG_BITS (6)
-#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2	SCM_MAKIFLAG_BITS (7)
-#endif
-
-#define SCM_UNSPECIFIED_BITS	SCM_MAKIFLAG_BITS (8)
-#define SCM_UNDEFINED_BITS	SCM_MAKIFLAG_BITS (9)
-#define SCM_EOF_VAL_BITS 	SCM_MAKIFLAG_BITS (10)
-
-#define SCM_UNSPECIFIED		SCM_PACK (SCM_UNSPECIFIED_BITS)
-#define SCM_UNDEFINED	 	SCM_PACK (SCM_UNDEFINED_BITS)
-#define SCM_EOF_VAL 		SCM_PACK (SCM_EOF_VAL_BITS)
-
-/* When a variable is unbound this is marked by the SCM_UNDEFINED
- * value.  The following is an unbound value which can be handled on
- * the Scheme level, i.e., it can be stored in and retrieved from a
- * Scheme variable.  This value is only intended to mark an unbound
- * slot in GOOPS.  It is needed now, but we should probably rewrite
- * the code which handles this value in C so that SCM_UNDEFINED can be
- * used instead.  It is not ideal to let this kind of unique and
- * strange values loose on the Scheme level.  */
-#define SCM_UNBOUND_BITS	SCM_MAKIFLAG_BITS (11)
-#define SCM_UNBOUND		SCM_PACK (SCM_UNBOUND_BITS)
-
-#define SCM_UNBNDP(x)		(scm_is_eq ((x), SCM_UNDEFINED))
-
-/*
- * SCM_MATCHES_BITS_IN_COMMON(x,a,b) returns 1 if and only if x
- * matches both a and b in every bit position where a and b are equal;
- * otherwise it returns 0.  Bit positions where a and b differ are
- * ignored.
- *
- * This is used to efficiently compare against two values which differ
- * in exactly one bit position, or against four values which differ in
- * exactly two bit positions.  It is the basis for the following
- * macros:
- *
- *   scm_is_null_or_nil,
- *   scm_is_false_or_nil,
- *   scm_is_true_and_not_nil,
- *   scm_is_lisp_false,
- *   scm_is_lisp_true,
- *   scm_is_bool_and_not_nil (aka scm_is_bool)
- *   scm_is_bool_or_nil.
- */
-#define SCM_MATCHES_BITS_IN_COMMON(x,a,b)				\
-  ((SCM_UNPACK(x) & ~(SCM_UNPACK(a) ^ SCM_UNPACK(b))) ==		\
-   (SCM_UNPACK(a) & SCM_UNPACK(b)))
-
-/*
- * These macros are used for compile-time verification that the
- * constants have the properties needed for the above macro to work
- * properly.
- */
-#ifdef BUILDING_LIBGUILE
-#define SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED(x)  ((x) & ((x)-1))
-#define SCM_HAS_EXACTLY_ONE_BIT_SET(x)					\
-  ((x) != 0 && SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x) == 0)
-#define SCM_HAS_EXACTLY_TWO_BITS_SET(x)					\
-  (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x)))
-
-#define SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b)		\
-  (SCM_HAS_EXACTLY_ONE_BIT_SET ((a) ^ (b)))
-#define SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d)		\
-  (SCM_HAS_EXACTLY_TWO_BITS_SET (((a) ^ (b)) |                          \
-                                 ((b) ^ (c)) |                          \
-                                 ((c) ^ (d))))
-#endif /* BUILDING_LIBGUILE */
-
-
-/* Dispatching aids:
-
-   When switching on SCM_TYP7 of a SCM value, use these fake case
-   labels to catch types that use fewer than 7 bits for tagging.  */
-
-/* For cons pairs with immediate values in the CAR
- */
-
-#define scm_tcs_cons_imcar \
-       scm_tc2_int + 0:   case scm_tc2_int + 4:   case scm_tc3_imm24 + 0:\
-  case scm_tc2_int + 8:   case scm_tc2_int + 12:  case scm_tc3_imm24 + 8:\
-  case scm_tc2_int + 16:  case scm_tc2_int + 20:  case scm_tc3_imm24 + 16:\
-  case scm_tc2_int + 24:  case scm_tc2_int + 28:  case scm_tc3_imm24 + 24:\
-  case scm_tc2_int + 32:  case scm_tc2_int + 36:  case scm_tc3_imm24 + 32:\
-  case scm_tc2_int + 40:  case scm_tc2_int + 44:  case scm_tc3_imm24 + 40:\
-  case scm_tc2_int + 48:  case scm_tc2_int + 52:  case scm_tc3_imm24 + 48:\
-  case scm_tc2_int + 56:  case scm_tc2_int + 60:  case scm_tc3_imm24 + 56:\
-  case scm_tc2_int + 64:  case scm_tc2_int + 68:  case scm_tc3_imm24 + 64:\
-  case scm_tc2_int + 72:  case scm_tc2_int + 76:  case scm_tc3_imm24 + 72:\
-  case scm_tc2_int + 80:  case scm_tc2_int + 84:  case scm_tc3_imm24 + 80:\
-  case scm_tc2_int + 88:  case scm_tc2_int + 92:  case scm_tc3_imm24 + 88:\
-  case scm_tc2_int + 96:  case scm_tc2_int + 100: case scm_tc3_imm24 + 96:\
-  case scm_tc2_int + 104: case scm_tc2_int + 108: case scm_tc3_imm24 + 104:\
-  case scm_tc2_int + 112: case scm_tc2_int + 116: case scm_tc3_imm24 + 112:\
-  case scm_tc2_int + 120: case scm_tc2_int + 124: case scm_tc3_imm24 + 120
-
-/* For cons pairs with heap objects in the SCM_CAR
- */
-#define scm_tcs_cons_nimcar \
-       scm_tc3_cons + 0:\
-  case scm_tc3_cons + 8:\
-  case scm_tc3_cons + 16:\
-  case scm_tc3_cons + 24:\
-  case scm_tc3_cons + 32:\
-  case scm_tc3_cons + 40:\
-  case scm_tc3_cons + 48:\
-  case scm_tc3_cons + 56:\
-  case scm_tc3_cons + 64:\
-  case scm_tc3_cons + 72:\
-  case scm_tc3_cons + 80:\
-  case scm_tc3_cons + 88:\
-  case scm_tc3_cons + 96:\
-  case scm_tc3_cons + 104:\
-  case scm_tc3_cons + 112:\
-  case scm_tc3_cons + 120
-
-/* For structs
- */
-#define scm_tcs_struct \
-       scm_tc3_struct + 0:\
-  case scm_tc3_struct + 8:\
-  case scm_tc3_struct + 16:\
-  case scm_tc3_struct + 24:\
-  case scm_tc3_struct + 32:\
-  case scm_tc3_struct + 40:\
-  case scm_tc3_struct + 48:\
-  case scm_tc3_struct + 56:\
-  case scm_tc3_struct + 64:\
-  case scm_tc3_struct + 72:\
-  case scm_tc3_struct + 80:\
-  case scm_tc3_struct + 88:\
-  case scm_tc3_struct + 96:\
-  case scm_tc3_struct + 104:\
-  case scm_tc3_struct + 112:\
-  case scm_tc3_struct + 120
-
-
-
-#endif  /* SCM_TAGS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#warning tags.h is gone, instead include <libguile.h>
diff --git a/libguile/threads.c b/libguile/threads.c
index 770f62c44..86ac5e84b 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,22 +1,21 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
- *   2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,50 +23,52 @@
 # include <config.h>
 #endif
 
-#include "libguile/bdw-gc.h"
-#include <gc/gc_mark.h>
-#include "libguile/_scm.h"
-#include "libguile/deprecation.h"
-
-#include <stdlib.h>
-#include <unistd.h>
+#include <assert.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <full-read.h>
+#include <nproc.h>
 #include <stdio.h>
-
-#ifdef HAVE_STRING_H
+#include <stdlib.h>
 #include <string.h>   /* for memset used by FD_ZERO on Solaris 10 */
-#endif
-
-#if HAVE_SYS_TIME_H
 #include <sys/time.h>
-#endif
+#include <unistd.h>
 
 #if HAVE_PTHREAD_NP_H
 # include <pthread_np.h>
 #endif
 
-#include <sys/select.h>
-
-#include <assert.h>
-#include <fcntl.h>
-#include <nproc.h>
-
-#include "libguile/validate.h"
-#include "libguile/eval.h"
-#include "libguile/async.h"
-#include "libguile/ports.h"
-#include "libguile/threads.h"
-#include "libguile/dynwind.h"
-#include "libguile/iselect.h"
-#include "libguile/fluids.h"
-#include "libguile/continuations.h"
-#include "libguile/gc.h"
-#include "libguile/gc-inline.h"
-#include "libguile/init.h"
-#include "libguile/scmsigs.h"
-#include "libguile/strings.h"
-#include "libguile/vm.h"
+#include "async.h"
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "continuations.h"
+#include "deprecation.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "extensions.h"
+#include "fluids.h"
+#include "gc-inline.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "hashtab.h"
+#include "init.h"
+#include "iselect.h"
+#include "jit.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "scmsigs.h"
+#include "strings.h"
+#include "symbols.h"
+#include "variable.h"
+#include "version.h"
+#include "vm.h"
+
+#include "threads.h"
 
-#include <full-read.h>
+#include <gc/gc_mark.h>
 
 
 
@@ -81,7 +82,7 @@ thread_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
              struct GC_ms_entry *mark_stack_limit, GC_word env)
 {
   int word;
-  const struct scm_i_thread *t = (struct scm_i_thread *) addr;
+  struct scm_thread *t = (struct scm_thread *) addr;
 
   if (SCM_UNPACK (t->handle) == 0)
     /* T must be on the free-list; ignore.  (See warning in
@@ -98,26 +99,21 @@ thread_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
      but GC doesn't know to trace them (as they are pointerless), so we
      need to do that here.  See the comments at the top of libgc's
      gc_inline.h.  */
-  if (t->pointerless_freelists)
+  for (size_t n = 0; n < SCM_INLINE_GC_FREELIST_COUNT; n++)
     {
-      size_t n;
-      for (n = 0; n < SCM_INLINE_GC_FREELIST_COUNT; n++)
+      void *chain = t->pointerless_freelists[n];
+      if (chain)
         {
-          void *chain = t->pointerless_freelists[n];
-          if (chain)
-            {
-              /* The first link is already marked by the freelist vector,
-                 so we just have to mark the tail.  */
-              while ((chain = *(void **)chain))
-                mark_stack_ptr = GC_mark_and_push (chain, mark_stack_ptr,
-                                                   mark_stack_limit, NULL);
-            }
+          /* The first link is already marked by the thread itsel, so we
+             just have to mark the tail.  */
+          while ((chain = *(void **)chain))
+            mark_stack_ptr = GC_mark_and_push (chain, mark_stack_ptr,
+                                               mark_stack_limit, NULL);
         }
     }
 
-  if (t->vp)
-    mark_stack_ptr = scm_i_vm_mark_stack (t->vp, mark_stack_ptr,
-                                          mark_stack_limit);
+  mark_stack_ptr = scm_i_vm_mark_stack (&t->vm, mark_stack_ptr,
+                                        mark_stack_limit);
 
   return mark_stack_ptr;
 }
@@ -251,11 +247,11 @@ thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
     unsigned short us;
     unsigned int   ui;
     unsigned long  ul;
-    scm_t_uintmax  um;
+    uintmax_t  um;
   } u;
-  scm_i_thread *t = SCM_I_THREAD_DATA (exp);
+  scm_thread *t = SCM_I_THREAD_DATA (exp);
   scm_i_pthread_t p = t->pthread;
-  scm_t_uintmax id;
+  uintmax_t id;
   u.p = p;
   if (sizeof (p) == sizeof (unsigned short))
     id = u.us;
@@ -303,7 +299,7 @@ static int
 block_self (SCM queue, scm_i_pthread_mutex_t *mutex,
 	    const scm_t_timespec *waittime)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   SCM q_handle;
   int err;
 
@@ -358,13 +354,13 @@ scm_i_pthread_key_t scm_i_thread_key;
    itself in TLS (rather than a pointer to some malloc'd memory) is not
    possible since thread objects may live longer than the actual thread they
    represent.  */
-SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread = NULL;
+SCM_THREAD_LOCAL scm_thread *scm_i_current_thread = NULL;
 
 #endif /* SCM_HAVE_THREAD_STORAGE_CLASS */
 
 
 static scm_i_pthread_mutex_t thread_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-static scm_i_thread *all_threads = NULL;
+static scm_thread *all_threads = NULL;
 static int thread_count;
 
 static SCM default_dynamic_state;
@@ -374,34 +370,25 @@ static SCM default_dynamic_state;
 static void
 guilify_self_1 (struct GC_stack_base *base, int needs_unregister)
 {
-  scm_i_thread t;
+  scm_thread t;
 
   /* We must arrange for SCM_I_CURRENT_THREAD to point to a valid value
      before allocating anything in this thread, because allocation could
      cause GC to run, and GC could cause finalizers, which could invoke
      Scheme functions, which need the current thread to be set.  */
 
+  memset (&t, 0, sizeof (t));
+
   t.pthread = scm_i_pthread_self ();
   t.handle = SCM_BOOL_F;
   t.result = SCM_BOOL_F;
-  t.freelists = NULL;
-  t.pointerless_freelists = NULL;
-  t.dynamic_state = NULL;
-  t.dynstack.base = NULL;
-  t.dynstack.top = NULL;
-  t.dynstack.limit = NULL;
   t.pending_asyncs = SCM_EOL;
   t.block_asyncs = 1;
   t.base = base->mem_base;
-#ifdef __ia64__
-  t.register_backing_store_base = base->reg_base;
-  t.pending_rbs_continuation = 0;
-#endif
   t.continuation_root = SCM_EOL;
   t.continuation_base = t.base;
   scm_i_pthread_cond_init (&t.sleep_cond, NULL);
-  t.wake = NULL;
-  t.vp = NULL;
+  scm_i_vm_prepare_stack (&t.vm);
 
   if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0)
     /* FIXME: Error conditions during the initialization phase are handled
@@ -415,7 +402,7 @@ guilify_self_1 (struct GC_stack_base *base, int needs_unregister)
 
   /* The switcheroo.  */
   {
-    scm_i_thread *t_ptr = &t;
+    scm_thread *t_ptr = &t;
     
     GC_disable ();
     t_ptr = GC_generic_malloc (sizeof (*t_ptr), thread_gc_kind);
@@ -443,7 +430,7 @@ guilify_self_1 (struct GC_stack_base *base, int needs_unregister)
 static void
 guilify_self_2 (SCM dynamic_state)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   t->guile_mode = 1;
 
@@ -452,12 +439,6 @@ guilify_self_2 (SCM dynamic_state)
   t->continuation_root = scm_cons (t->handle, SCM_EOL);
   t->continuation_base = t->base;
 
-  {
-    size_t size = SCM_INLINE_GC_FREELIST_COUNT * sizeof (void *);
-    t->freelists = scm_gc_malloc (size, "freelists");
-    t->pointerless_freelists = scm_gc_malloc (size, "atomic freelists");
-  }
-
   t->dynamic_state = scm_gc_typed_calloc (scm_t_dynamic_state);
   t->dynamic_state->thread_local_values = scm_c_make_hash_table (0);
   scm_set_current_dynamic_state (dynamic_state);
@@ -481,7 +462,7 @@ on_thread_exit (void *v)
   /* This handler is executed in non-guile mode.  Note that although
      libgc isn't guaranteed to see thread-locals, for this thread-local
      that isn't an issue as we have the all_threads list.  */
-  scm_i_thread *t = (scm_i_thread *) v, **tp;
+  scm_thread *t = (scm_thread *) v, **tp;
 
   t->exited = 1;
 
@@ -502,6 +483,10 @@ on_thread_exit (void *v)
       }
   thread_count--;
 
+  /* Prevent any concurrent or future marker from visiting this
+     thread.  */
+  t->handle = SCM_PACK (0);
+
   /* If there's only one other thread, it could be the signal delivery
      thread, so we need to notify it to shut down by closing its read pipe.
      If it's not the signal delivery thread, then closing the read pipe isn't
@@ -513,18 +498,17 @@ on_thread_exit (void *v)
 
   /* Although this thread has exited, the thread object might still be
      alive.  Release unused memory.  */
-  t->freelists = NULL;
-  t->pointerless_freelists = NULL;
+  for (size_t n = 0; n < SCM_INLINE_GC_FREELIST_COUNT; n++)
+    t->freelists[n] = t->pointerless_freelists[n] = NULL;
   t->dynamic_state = NULL;
   t->dynstack.base = NULL;
   t->dynstack.top = NULL;
   t->dynstack.limit = NULL;
-  {
-    struct scm_vm *vp = t->vp;
-    t->vp = NULL;
-    if (vp)
-      scm_i_vm_free_stack (vp);
-  }
+  scm_i_vm_free_stack (&t->vm);
+#if ENABLE_JIT
+  scm_jit_state_free (t->jit_state);
+#endif
+  t->jit_state = NULL;
 
 #ifdef SCM_HAVE_THREAD_STORAGE_CLASS
   scm_i_current_thread = NULL;
@@ -648,7 +632,7 @@ with_guile (struct GC_stack_base *base, void *data)
 {
   void *res;
   int new_thread;
-  scm_i_thread *t;
+  scm_thread *t;
   struct with_guile_args *args = data;
 
   new_thread = scm_i_init_thread_for_guile (base, args->dynamic_state);
@@ -714,7 +698,7 @@ void *
 scm_without_guile (void *(*func)(void *), void *data)
 {
   void *result;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   if (t->guile_mode)
     {
@@ -787,7 +771,7 @@ unprotect_launch_data (launch_data *data)
 static void *
 really_launch (void *d)
 {
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   unprotect_launch_data (d);
   /* The thread starts with asyncs blocked.  */
   t->block_asyncs++;
@@ -1007,7 +991,7 @@ scm_lock_mutex (SCM mx)
 
 static inline SCM
 lock_mutex (enum scm_mutex_kind kind, struct scm_mutex *m,
-            scm_i_thread *current_thread, scm_t_timespec *waittime)
+            scm_thread *current_thread, scm_t_timespec *waittime)
 #define FUNC_NAME "lock-mutex"
 {
   scm_i_scm_pthread_mutex_lock (&m->lock);
@@ -1078,7 +1062,7 @@ SCM_DEFINE (scm_timed_lock_mutex, "lock-mutex", 1, 1, 0,
 {
   scm_t_timespec cwaittime, *waittime = NULL;
   struct scm_mutex *m;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   SCM ret;
 
   SCM_VALIDATE_MUTEX (1, mutex);
@@ -1144,7 +1128,7 @@ scm_try_mutex (SCM mutex)
    against the mutex kind.  */
 static inline void
 unlock_mutex (enum scm_mutex_kind kind, struct scm_mutex *m,
-              scm_i_thread *current_thread)
+              scm_thread *current_thread)
 #define FUNC_NAME "unlock-mutex"
 {
   scm_i_scm_pthread_mutex_lock (&m->lock);
@@ -1185,7 +1169,7 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0, (SCM mutex),
 #define FUNC_NAME s_scm_unlock_mutex
 {
   struct scm_mutex *m;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
 
   SCM_VALIDATE_MUTEX (1, mutex);
 
@@ -1308,7 +1292,7 @@ SCM_DEFINE (scm_make_condition_variable, "make-condition-variable", 0, 0, 0,
 
 static inline SCM
 timed_wait (enum scm_mutex_kind kind, struct scm_mutex *m, struct scm_cond *c,
-            scm_i_thread *current_thread, scm_t_timespec *waittime)
+            scm_thread *current_thread, scm_t_timespec *waittime)
 #define FUNC_NAME "wait-condition-variable"
 {
   scm_i_scm_pthread_mutex_lock (&m->lock);
@@ -1417,7 +1401,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
   scm_t_timespec waittime_val, *waittime = NULL;
   struct scm_cond *c;
   struct scm_mutex *m;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   SCM ret;
 
   SCM_VALIDATE_CONDVAR (1, cond);
@@ -1532,7 +1516,7 @@ scm_std_select (int nfds,
 {
   fd_set my_readfds;
   int res, eno, wakeup_fd;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
   struct select_args args;
 
   if (readfds == NULL)
@@ -1696,7 +1680,7 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
      of the way GC is done.
   */
   int n = thread_count;
-  scm_i_thread *t;
+  scm_thread *t;
   SCM list = scm_c_make_list (n, SCM_UNSPECIFIED), *l;
 
   scm_i_pthread_mutex_lock (&thread_admin_mutex);
@@ -1729,7 +1713,7 @@ int
 scm_c_thread_exited_p (SCM thread)
 #define FUNC_NAME  s_scm_thread_exited_p
 {
-  scm_i_thread *t;
+  scm_thread *t;
   SCM_VALIDATE_THREAD (1, thread);
   t = SCM_I_THREAD_DATA (thread);
   return t->exited;
@@ -1808,7 +1792,7 @@ scm_t_bits scm_tc16_condvar;
 static void
 scm_init_ice_9_threads (void *unused)
 {
-#include "libguile/threads.x"
+#include "threads.x"
 
   cancel_thread_var =
     scm_module_variable (scm_current_module (),
@@ -1824,7 +1808,7 @@ scm_init_ice_9_threads (void *unused)
 void
 scm_init_threads ()
 {
-  scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_i_thread));
+  scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_thread));
   scm_set_smob_print (scm_tc16_thread, thread_print);
 
   scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (struct scm_mutex));
@@ -1850,65 +1834,4 @@ scm_init_threads_default_dynamic_state ()
 }
 
 
-/* IA64-specific things.  */
 
-#ifdef __ia64__
-# ifdef __hpux
-#  include <sys/param.h>
-#  include <sys/pstat.h>
-void *
-scm_ia64_register_backing_store_base (void)
-{
-  struct pst_vm_status vm_status;
-  int i = 0;
-  while (pstat_getprocvm (&vm_status, sizeof (vm_status), 0, i++) == 1)
-    if (vm_status.pst_type == PS_RSESTACK)
-      return (void *) vm_status.pst_vaddr;
-  abort ();
-}
-void *
-scm_ia64_ar_bsp (const void *ctx)
-{
-  uint64_t bsp;
-  __uc_get_ar_bsp (ctx, &bsp);
-  return (void *) bsp;
-}
-# endif /* hpux */
-# ifdef linux
-#  include <ucontext.h>
-void *
-scm_ia64_register_backing_store_base (void)
-{
-  extern void *__libc_ia64_register_backing_store_base;
-  return __libc_ia64_register_backing_store_base;
-}
-void *
-scm_ia64_ar_bsp (const void *opaque)
-{
-  const ucontext_t *ctx = opaque;
-  return (void *) ctx->uc_mcontext.sc_ar_bsp;
-}
-# endif /* linux */
-# ifdef __FreeBSD__
-#  include <ucontext.h>
-void *
-scm_ia64_register_backing_store_base (void)
-{
-  return (void *)0x8000000000000000;
-}
-void *
-scm_ia64_ar_bsp (const void *opaque)
-{
-  const ucontext_t *ctx = opaque;
-  return (void *)(ctx->uc_mcontext.mc_special.bspstore
-                  + ctx->uc_mcontext.mc_special.ndirty);
-}
-# endif /* __FreeBSD__ */
-#endif /* __ia64__ */
-
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/threads.h b/libguile/threads.h
index 55c566d23..337dc83a9 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -1,35 +1,33 @@
-/* classes: h_files */
-
 #ifndef SCM_THREADS_H
 #define SCM_THREADS_H
 
-/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1996-1998,2000-2004,2006-2009,2011-2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
 #include "libguile/procs.h"
 #include "libguile/throw.h"
 #include "libguile/dynstack.h"
 #include "libguile/iselect.h"
-#include "libguile/continuations.h"
+#include "libguile/smob.h"
+#include "libguile/vm.h"
 
 #if SCM_USE_PTHREAD_THREADS
 #include "libguile/pthread-threads.h"
@@ -41,6 +39,19 @@
 
 
 
+#define SCM_INLINE_GC_GRANULE_WORDS 2
+#define SCM_INLINE_GC_GRANULE_BYTES \
+  (sizeof(void *) * SCM_INLINE_GC_GRANULE_WORDS)
+
+/* A freelist set contains SCM_INLINE_GC_FREELIST_COUNT pointers to
+   singly linked lists of objects of different sizes, the ith one
+   containing objects i + 1 granules in size.  This setting of
+   SCM_INLINE_GC_FREELIST_COUNT will hold freelists for allocations of
+   up to 256 bytes.  */
+#define SCM_INLINE_GC_FREELIST_COUNT (256U / SCM_INLINE_GC_GRANULE_BYTES)
+
+
+
 /* smob tags for the thread datatypes */
 SCM_API scm_t_bits scm_tc16_thread;
 SCM_API scm_t_bits scm_tc16_mutex;
@@ -48,8 +59,22 @@ SCM_API scm_t_bits scm_tc16_condvar;
 
 struct scm_thread_wake_data;
 
-typedef struct scm_i_thread {
-  struct scm_i_thread *next_thread;
+struct scm_thread {
+  struct scm_thread *next_thread;
+
+  /* VM state for this thread.  */
+  struct scm_vm vm;
+
+  /* For system asyncs.
+   */
+  SCM pending_asyncs;            /* The thunks to be run at the next
+                                    safe point.  Accessed atomically. */
+  unsigned int block_asyncs;    /* Non-zero means that asyncs should
+                                   not be run. */
+
+  /* Thread-local freelists; see gc-inline.h.  */
+  void *freelists[SCM_INLINE_GC_FREELIST_COUNT];
+  void *pointerless_freelists[SCM_INLINE_GC_FREELIST_COUNT];
 
   SCM handle;
   scm_i_pthread_t pthread;
@@ -67,10 +92,6 @@ typedef struct scm_i_thread {
   scm_i_pthread_cond_t sleep_cond;
   int sleep_pipe[2];
 
-  /* Thread-local freelists; see gc-inline.h.  */
-  void **freelists;
-  void **pointerless_freelists;
-
   /* Other thread local things.
    */
   scm_t_dynamic_state *dynamic_state;
@@ -78,13 +99,6 @@ typedef struct scm_i_thread {
   /* The dynamic stack.  */
   scm_t_dynstack dynstack;
 
-  /* For system asyncs.
-   */
-  SCM pending_asyncs;            /* The thunks to be run at the next
-                                    safe point.  Accessed atomically. */
-  unsigned int block_asyncs;    /* Non-zero means that asyncs should
-                                   not be run. */
-
   /* The current continuation root and the stack base for it.
 
      The continuation root is an arbitrary but unique object that
@@ -101,18 +115,15 @@ typedef struct scm_i_thread {
   SCM continuation_root;
   SCM_STACKITEM *continuation_base;
 
-  /* For keeping track of the stack and registers. */
-  struct scm_vm *vp;
+  /* Stack base.  Used when checking for C stack overflow.  */
   SCM_STACKITEM *base;
-  scm_i_jmp_buf regs;
-#ifdef __ia64__
-  void *register_backing_store_base;
-  scm_t_contregs *pending_rbs_continuation;
-#endif
-} scm_i_thread;
+
+  /* JIT state; NULL until this thread needs to JIT-compile something.  */
+  struct scm_jit_state *jit_state;
+};
 
 #define SCM_I_IS_THREAD(x)    SCM_SMOB_PREDICATE (scm_tc16_thread, x)
-#define SCM_I_THREAD_DATA(x)  ((scm_i_thread *) SCM_SMOB_DATA (x))
+#define SCM_I_THREAD_DATA(x)  ((scm_thread *) SCM_SMOB_DATA (x))
 
 #define SCM_VALIDATE_THREAD(pos, a) \
   scm_assert_smob_type (scm_tc16_thread, (a))
@@ -175,13 +186,13 @@ SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key;
 
 # ifdef SCM_HAVE_THREAD_STORAGE_CLASS
 
-SCM_INTERNAL SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread;
+SCM_INTERNAL SCM_THREAD_LOCAL scm_thread *scm_i_current_thread;
 #  define SCM_I_CURRENT_THREAD (scm_i_current_thread)
 
 # else /* !SCM_HAVE_THREAD_STORAGE_CLASS */
 
 #  define SCM_I_CURRENT_THREAD						\
-    ((scm_i_thread *) scm_i_pthread_getspecific (scm_i_thread_key))
+    ((scm_thread *) scm_i_pthread_getspecific (scm_i_thread_key))
 
 # endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */
 
@@ -213,9 +224,3 @@ SCM_API SCM scm_total_processor_count (void);
 SCM_API SCM scm_current_processor_count (void);
 
 #endif  /* SCM_THREADS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/throw.c b/libguile/throw.c
index 123544e79..2fd25fcc6 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -25,25 +26,32 @@
 #include <alloca.h>
 #include <stdio.h>
 #include <unistdio.h>
-#include "libguile/_scm.h"
-#include "libguile/smob.h"
-#include "libguile/eval.h"
-#include "libguile/eq.h"
-#include "libguile/control.h"
-#include "libguile/deprecation.h"
-#include "libguile/backtrace.h"
-#include "libguile/debug.h"
-#include "libguile/stackchk.h"
-#include "libguile/stacks.h"
-#include "libguile/fluids.h"
-#include "libguile/ports.h"
-#include "libguile/validate.h"
-#include "libguile/vm.h"
-#include "libguile/throw.h"
-#include "libguile/init.h"
-#include "libguile/strings.h"
-
-#include "libguile/private-options.h"
+
+#include "backtrace.h"
+#include "boolean.h"
+#include "control.h"
+#include "debug.h"
+#include "deprecation.h"
+#include "eq.h"
+#include "eval.h"
+#include "fluids.h"
+#include "gsubr.h"
+#include "init.h"
+#include "list.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "private-options.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "stacks.h"
+#include "strings.h"
+#include "symbols.h"
+#include "variable.h"
+#include "vm.h"
+
+#include "throw.h"
 
 
 /* Pleasantly enough, the guts of catch are defined in Scheme, in terms
@@ -72,14 +80,15 @@ static SCM exception_handler_fluid;
 static SCM
 catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 {
-  struct scm_vm *vp;
   SCM eh, prompt_tag;
   SCM res;
-  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
-  scm_t_dynamic_state *dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
-  scm_i_jmp_buf registers;
-  const void *prev_cookie;
-  scm_t_ptrdiff saved_stack_depth;
+  scm_thread *t = SCM_I_CURRENT_THREAD;
+  scm_t_dynstack *dynstack = &t->dynstack;
+  scm_t_dynamic_state *dynamic_state = t->dynamic_state;
+  jmp_buf registers;
+  jmp_buf *prev_registers;
+  ptrdiff_t saved_stack_depth;
+  uint8_t *mra = NULL;
 
   if (!scm_is_eq (tag, SCM_BOOL_T) && !scm_is_symbol (tag))
     scm_wrong_type_arg ("catch", 1, tag);
@@ -101,32 +110,32 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
   scm_c_vector_set_x (eh, 1, prompt_tag);
   scm_c_vector_set_x (eh, 2, pre_unwind_handler);
 
-  vp = scm_the_vm ();
-  prev_cookie = vp->resumable_prompt_cookie;
-  saved_stack_depth = vp->stack_top - vp->sp;
+  prev_registers = t->vm.registers;
+  saved_stack_depth = t->vm.stack_top - t->vm.sp;
 
   /* Push the prompt and exception handler onto the dynamic stack. */
   scm_dynstack_push_prompt (dynstack,
                             SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
                             prompt_tag,
-                            vp->stack_top - vp->fp,
+                            t->vm.stack_top - t->vm.fp,
                             saved_stack_depth,
-                            vp->ip,
+                            t->vm.ip,
+                            mra,
                             &registers);
   scm_dynstack_push_fluid (dynstack, exception_handler_fluid, eh,
                            dynamic_state);
 
-  if (SCM_I_SETJMP (registers))
+  if (setjmp (registers))
     {
       /* A non-local return.  */
       SCM args;
 
-      vp->resumable_prompt_cookie = prev_cookie;
+      t->vm.registers = prev_registers;
       scm_gc_after_nonlocal_exit ();
 
       /* FIXME: We know where the args will be on the stack; we could
          avoid consing them.  */
-      args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
+      args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth);
 
       /* Cdr past the continuation. */
       args = scm_cdr (args);
@@ -178,22 +187,19 @@ default_exception_handler (SCM k, SCM args)
 static void
 abort_to_prompt (SCM prompt_tag, SCM tag, SCM args)
 {
-  SCM *argv;
+  SCM *tag_and_argv;
   size_t i;
   long n;
 
-  n = scm_ilength (args) + 1;
-  argv = alloca (sizeof (SCM)*n);
-  argv[0] = tag;
-  for (i = 1; i < n; i++, args = scm_cdr (args))
-    argv[i] = scm_car (args);
-
-  scm_c_abort (scm_the_vm (), prompt_tag, n, argv, NULL);
-
-  /* Oh, what, you're still here? The abort must have been reinstated. Actually,
-     that's quite impossible, given that we're already in C-land here, so...
-     abort! */
+  n = scm_ilength (args) + 2;
+  tag_and_argv = alloca (sizeof (SCM)*n);
+  tag_and_argv[0] = prompt_tag;
+  tag_and_argv[1] = tag;
+  for (i = 2; i < n; i++, args = scm_cdr (args))
+    tag_and_argv[i] = scm_car (args);
 
+  scm_i_vm_emergency_abort (tag_and_argv, n);
+  /* Unreachable.  */
   abort ();
 }
 
@@ -263,7 +269,9 @@ scm_with_throw_handler (SCM key, SCM thunk, SCM handler)
 SCM
 scm_throw (SCM key, SCM args)
 {
-  return scm_apply_1 (scm_variable_ref (throw_var), key, args);
+  scm_apply_1 (scm_variable_ref (throw_var), key, args);
+  /* Should not be reached.  */
+  abort ();
 }
 
 
@@ -608,7 +616,7 @@ scm_handle_by_throw (void *handler_data SCM_UNUSED, SCM tag, SCM args)
 SCM
 scm_ithrow (SCM key, SCM args, int no_return SCM_UNUSED)
 {
-  return scm_throw (key, args);
+  scm_throw (key, args);
 }
 
 SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow");
@@ -673,11 +681,5 @@ scm_init_throw ()
                                    SCM_BOOL_F,
                                    SCM_BOOL_F);
 
-#include "libguile/throw.x"
+#include "throw.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/throw.h b/libguile/throw.h
index f2020a331..ea206f900 100644
--- a/libguile/throw.h
+++ b/libguile/throw.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_THROW_H
 #define SCM_THROW_H
 
-/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2010, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000,2006,2008,2010,2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -84,7 +83,7 @@ SCM_API int scm_exit_status (SCM args);
 SCM_API SCM scm_catch_with_pre_unwind_handler (SCM tag, SCM thunk, SCM handler, SCM lazy_handler);
 SCM_API SCM scm_catch (SCM tag, SCM thunk, SCM handler);
 SCM_API SCM scm_with_throw_handler (SCM tag, SCM thunk, SCM handler);
-SCM_API SCM scm_ithrow (SCM key, SCM args, int no_return);
+SCM_API SCM scm_ithrow (SCM key, SCM args, int no_return) SCM_NORETURN;
 
 /* This throws to the `stack-overflow' key, without running pre-unwind
    handlers.  */
@@ -94,13 +93,7 @@ SCM_API void scm_report_stack_overflow (void);
    handlers.  */
 SCM_API void scm_report_out_of_memory (void);
 
-SCM_API SCM scm_throw (SCM key, SCM args);
+SCM_API SCM scm_throw (SCM key, SCM args) SCM_NORETURN;
 SCM_INTERNAL void scm_init_throw (void);
 
 #endif  /* SCM_THROW_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/trees.c b/libguile/trees.c
index 88adf8820..32ff984fa 100644
--- a/libguile/trees.c
+++ b/libguile/trees.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
- * Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,16 +23,16 @@
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
+#include <stdarg.h>
 
-#include "libguile/validate.h"
-#include "libguile/list.h"
-#include "libguile/vectors.h"
-#include "libguile/srcprop.h"
-#include "libguile/trees.h"
+#include "eq.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "srcprop.h"
+#include "vectors.h"
 
-#include <stdarg.h>
+#include "trees.h"
 
 
 /* scm_copy_tree creates deep copies of pairs and vectors, but not of any other
@@ -206,5 +206,5 @@ copy_tree (struct t_trace *const hare,
 void
 scm_init_trees ()
 {
-#include "libguile/trees.x"
+#include "trees.x"
 }
diff --git a/libguile/trees.h b/libguile/trees.h
index 70d32ad7d..aadc9e7d7 100644
--- a/libguile/trees.h
+++ b/libguile/trees.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_TREES_H
 #define SCM_TREES_H
 
-/* Copyright (C) 2009
- * Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -37,9 +35,3 @@ SCM_API SCM scm_copy_tree (SCM obj);
 SCM_INTERNAL void scm_init_trees (void);
 
 #endif  /* SCM_TREES_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/unicode.c b/libguile/unicode.c
index 65d319a1d..a48a2225a 100644
--- a/libguile/unicode.c
+++ b/libguile/unicode.c
@@ -1,35 +1,43 @@
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as
- * published by the Free Software Foundation, either version 3 of the
- * License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library.  If not, see
- * <http://www.gnu.org/licenses/>.
- */
+/* Copyright 2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <ctype.h>
 #include <limits.h>
+#include <string.h>
 #include <unicase.h>
 #include <unictype.h>
 #include <uniname.h>
 
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
+#include "chars.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "strings.h"
+#include "version.h"
+
+#include "unicode.h"
 
-#include "libguile/unicode.h"
 
 
 
@@ -75,7 +83,7 @@ static void
 scm_load_unicode (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/unicode.x"
+#include "unicode.x"
 #endif
 }
 
@@ -87,9 +95,3 @@ scm_init_unicode (void)
                             (scm_t_extension_init_func)scm_load_unicode,
                             NULL);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/unicode.h b/libguile/unicode.h
index 88261c109..4c82e85a2 100644
--- a/libguile/unicode.h
+++ b/libguile/unicode.h
@@ -1,37 +1,31 @@
-/* classes: h_files */
-
 #ifndef SCM_UNICODE_H
 #define SCM_UNICODE_H
 
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as
- * published by the Free Software Foundation, either version 3 of the
- * License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library.  If not, see
- * <http://www.gnu.org/licenses/>.
- */
+/* Copyright 2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 SCM_INTERNAL SCM scm_formal_name_to_char (SCM);
 SCM_INTERNAL SCM scm_char_to_formal_name (SCM);
 SCM_INTERNAL void scm_init_unicode (void);
 
 #endif  /* SCM_UNICODE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/uniform.c b/libguile/uniform.c
index 13ee18a0c..58307a793 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2006,2009-2010,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -23,10 +24,7 @@
 #  include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-
-#include "libguile/uniform.h"
+#include "uniform.h"
 
 
 const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = {
@@ -68,10 +66,10 @@ const void *
 scm_array_handle_uniform_elements (scm_t_array_handle *h)
 {
   size_t esize;
-  const scm_t_uint8 *ret;
+  const uint8_t *ret;
 
   esize = scm_array_handle_uniform_element_size (h);
-  ret = ((const scm_t_uint8 *) h->elements) + h->base * esize;
+  ret = ((const uint8_t *) h->elements) + h->base * esize;
   return ret;
 }
 
@@ -87,11 +85,5 @@ scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
 void
 scm_init_uniform (void)
 {
-#include "libguile/uniform.x"
+#include "uniform.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/uniform.h b/libguile/uniform.h
index ad8428f6f..9db44fdb8 100644
--- a/libguile/uniform.h
+++ b/libguile/uniform.h
@@ -1,30 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_UNIFORM_H
 #define SCM_UNIFORM_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
- * 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
 
 
 
@@ -48,9 +46,3 @@ SCM_INTERNAL void scm_init_uniform (void);
 
 
 #endif  /* SCM_UNIFORM_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/validate.h b/libguile/validate.h
index 237865547..e7c75920e 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -1,411 +1 @@
-/* classes: h_files */
-
-#ifndef SCM_VALIDATE_H
-#define SCM_VALIDATE_H
-
-/* Copyright (C) 1999-2002, 2004, 2006, 2007, 2009, 2011-2014,
- *   2018 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-/* Written by Greg J. Badros <gjb@cs.washington.edu>, Dec-1999 */
-
-
-
-#define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0)
-
-#define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0)
-
-#define SCM_SYSERROR_MSG(str, args, val) \
-  do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0)
-
-#define SCM_MISC_ERROR(str, args) \
-  do { scm_misc_error (FUNC_NAME, str, args); } while (0)
-
-#define SCM_WRONG_NUM_ARGS() \
-  do { scm_error_num_args_subr (FUNC_NAME); } while (0)
-
-#define SCM_WRONG_TYPE_ARG(pos, obj) \
-  do { scm_wrong_type_arg (FUNC_NAME, pos, obj); } while (0)
-
-#define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
-
-#define SCM_NUM2SIZE_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_size_t (arg))
-
-#define SCM_NUM2PTRDIFF(pos, arg) (scm_to_ssize_t (arg))
-
-#define SCM_NUM2PTRDIFF_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_ssize_t (arg))
-
-#define SCM_NUM2SHORT(pos, arg) (scm_to_short (arg))
-
-#define SCM_NUM2SHORT_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_short (arg))
-
-#define SCM_NUM2USHORT(pos, arg) (scm_to_ushort (arg))
-
-#define SCM_NUM2USHORT_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_ushort (arg))
-
-#define SCM_NUM2INT(pos, arg) (scm_to_int (arg))
-
-#define SCM_NUM2INT_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_int (arg))
-
-#define SCM_NUM2UINT(pos, arg) (scm_to_uint (arg))
-
-#define SCM_NUM2UINT_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_uint (arg))
-
-#define SCM_NUM2ULONG(pos, arg) (scm_to_ulong (arg))
-
-#define SCM_NUM2ULONG_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_ulong (arg))
-
-#define SCM_NUM2LONG(pos, arg) (scm_to_long (arg))
-
-#define SCM_NUM2LONG_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_long (arg))
-
-#define SCM_NUM2LONG_LONG(pos, arg) (scm_to_long_long (arg))
-
-#define SCM_NUM2LONG_LONG_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_long_long (arg))
-
-#define SCM_NUM2ULONG_LONG(pos, arg) (scm_to_ulong_long (arg))
-
-#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
-  (SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg))
-
-#define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
-
-#define SCM_NUM2FLOAT(pos, arg) ((float) scm_to_double (arg))
-
-#define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
-
-#define SCM_OUT_OF_RANGE(pos, arg) \
-  do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0)
-
-#define SCM_ASSERT_RANGE(pos, arg, f)					\
-  do { if (SCM_UNLIKELY (!(f)))					\
-         scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); }	\
-  while (0)
-
-#define SCM_MUST_MALLOC_TYPE(type) \
-  ((type *) scm_must_malloc (sizeof (type), FUNC_NAME))
-
-#define SCM_MUST_MALLOC_TYPE_NUM(type, num) \
-  ((type *) scm_must_malloc (sizeof (type) * (num), FUNC_NAME))
-
-#define SCM_MUST_MALLOC(size) (scm_must_malloc ((size), FUNC_NAME))
-
-#define SCM_MAKE_VALIDATE(pos, var, pred) \
-  do { \
-    SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \
-  } while (0)
-
-#define SCM_I_MAKE_VALIDATE_MSG2(pos, var, pred, msg) \
-  do { \
-    SCM_ASSERT_TYPE (pred (var), var, pos, FUNC_NAME, msg); \
-  } while (0)
-
-#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \
-  SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_ ## pred, msg)
-
-
-
-
-#define SCM_VALIDATE_REST_ARGUMENT(x) \
-  do { \
-    if (SCM_DEBUG_REST_ARGUMENT) { \
-      if (scm_ilength (x) < 0) { \
-        SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL); \
-      } \
-    } \
-  } while (0)
-
-#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate")
-
-#define SCM_VALIDATE_BOOL(pos, flag) \
-  do { \
-    SCM_ASSERT_TYPE (scm_is_bool (flag), flag, pos, FUNC_NAME, "boolean"); \
-  } while (0)
-
-#define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \
-  do { \
-    SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \
-    cvar = scm_to_bool (flag); \
-  } while (0)
-
-#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)			\
-  SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos),	\
-		   FUNC_NAME, "bytevector")
-
-#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character")
-
-#define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
-  do { \
-    SCM_ASSERT (SCM_CHARP (scm), scm, pos, FUNC_NAME); \
-    cvar = SCM_CHAR (scm); \
-  } while (0)
-
-#define SCM_VALIDATE_STRING(pos, str) \
-  do { \
-    SCM_ASSERT_TYPE (scm_is_string (str), str, pos, FUNC_NAME, "string"); \
-  } while (0)
-
-#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real")
-
-#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, NUMBERP, "number")
-
-#define SCM_VALIDATE_USHORT_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2USHORT (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_SHORT_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2SHORT (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_UINT_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2UINT (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_INT_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2INT (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_ULONG_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2ULONG (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_LONG_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2LONG (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_SIZE_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2SIZE (pos, k);              \
-  } while (0)
-
-#define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2FLOAT (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_DOUBLE_COPY(pos, k, cvar) \
-  do { \
-    cvar = SCM_NUM2DOUBLE (pos, k); \
-  } while (0)
-
-#define SCM_VALIDATE_DOUBLE_DEF_COPY(pos, k, default, cvar) \
-  do { \
-    if (SCM_UNBNDP (k)) \
-      { \
-        k = scm_make_real (default); \
-        cvar = default; \
-      } \
-    else \
-      { \
-        cvar = SCM_NUM2DOUBLE (pos, k); \
-      } \
-  } while (0)
-
-#define SCM_VALIDATE_NULL(pos, scm) \
-  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_null, "empty list")
-
-#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) \
-  SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "empty list")
-
-#define SCM_VALIDATE_CONS(pos, scm) \
-  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair")
-
-#ifdef BUILDING_LIBGUILE
-#define SCM_VALIDATE_MUTABLE_PAIR(pos, scm) \
-  SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_mutable_pair, "mutable pair")
-#endif /* BUILDING_LIBGUILE */
-
-#define SCM_VALIDATE_LIST(pos, lst) \
-  do { \
-    SCM_ASSERT (scm_ilength (lst) >= 0, lst, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_NONEMPTYLIST(pos, lst) \
-  do { \
-    SCM_ASSERT (scm_ilength (lst) > 0, lst, pos, FUNC_NAME); \
-  } while (0)
-
-/* Note: we use (cvar != -1) instead of (cvar >= 0) below
-   in case 'cvar' is of unsigned type. */
-#define SCM_VALIDATE_LIST_COPYLEN(pos, lst, cvar) \
-  do { \
-    cvar = scm_ilength (lst); \
-    SCM_ASSERT (cvar != -1, lst, pos, FUNC_NAME); \
-  } while (0)
-
-/* Note: we use (cvar != -1 && cvar != 0) instead of
-   (cvar >= 1) below in case 'cvar' is of unsigned type. */
-#define SCM_VALIDATE_NONEMPTYLIST_COPYLEN(pos, lst, cvar) \
-  do { \
-    cvar = scm_ilength (lst); \
-    SCM_ASSERT (cvar != -1 && cvar != 0, lst, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_ALISTCELL(pos, alist) \
-  do { \
-    SCM_ASSERT (scm_is_pair (alist) && scm_is_pair (SCM_CAR (alist)), \
-                alist, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_ALISTCELL_COPYSCM(pos, alist, cvar) \
-  do { \
-    SCM_ASSERT (scm_is_pair (alist), alist, pos, FUNC_NAME); \
-    cvar = SCM_CAR (alist); \
-    SCM_ASSERT (scm_is_pair (cvar), alist, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_OPORT_VALUE(pos, port) \
-  do { \
-    SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, PRINT_STATE_P, "print-state")
-
-#define SCM_VALIDATE_SMOB(pos, obj, type) \
-  do { \
-    SCM_ASSERT (SCM_SMOB_PREDICATE (scm_tc16_ ## type, obj), \
-                obj, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_THUNK(pos, thunk) \
-  do { \
-    SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_SYMBOL(pos, str) \
-  do { \
-    SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
-  } while (0)
-
-#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
-
-#define SCM_VALIDATE_ATOMIC_BOX(pos, var) \
-  do { \
-    SCM_ASSERT_TYPE (scm_is_atomic_box (var), var, pos, FUNC_NAME, \
-                     "atomic box");                                \
-  } while (0)
-
-#define SCM_VALIDATE_PROC(pos, proc) \
-  do { \
-    SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_NULLORCONS(pos, env) \
-  do { \
-    SCM_ASSERT (scm_is_null (env) || scm_is_pair (env), env, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook")
-
-#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp")
-
-#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port")
-
-#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port")
-
-#define SCM_VALIDATE_INPUT_PORT(pos, port) \
-  SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port")
-
-#define SCM_VALIDATE_OUTPUT_PORT(pos, port) \
-  SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port")
-
-#define SCM_VALIDATE_FPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port")
-
-#define SCM_VALIDATE_OPFPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port")
-
-#define SCM_VALIDATE_OPINPORT(pos, port) \
-  SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port")
-
-#define SCM_VALIDATE_OPENPORT(pos, port) \
-  do { \
-    SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \
-                port, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_OPPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port")
-
-#define SCM_VALIDATE_OPOUTPORT(pos, port) \
-  SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port")
-
-#define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \
-  SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port")
-
-#define SCM_VALIDATE_FLUID(pos, fluid) \
-  SCM_I_MAKE_VALIDATE_MSG2 (pos, fluid, scm_is_fluid, "fluid")
-
-#define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword")
-
-#define SCM_VALIDATE_STACK(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack")
-
-#define SCM_VALIDATE_FRAME(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame")
-
-#define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state")
-
-#define SCM_VALIDATE_ARRAY(pos, v) \
-  do { \
-    SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
-                && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
-                v, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_VECTOR(pos, v) \
-  do { \
-    SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
-  do { \
-    SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
-                v, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_STRUCT(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct")
-
-#define SCM_VALIDATE_VTABLE(pos, v) \
-  do { \
-    SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \
-  } while (0)
-
-#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
-  do { \
-    SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
-  } while (0)
-
-
-#endif  /* SCM_VALIDATE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#warning validate.h is gone, instead include <libguile.h>
diff --git a/libguile/values.c b/libguile/values.c
index 131784a4e..522a8f5e5 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,77 +1,57 @@
-/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011-2013, 2016, 2018
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2000-2001,2006,2008-2009,2011-2013,2016-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/feature.h"
-#include "libguile/gc.h"
-#include "libguile/numbers.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/struct.h"
-#include "libguile/validate.h"
+#include "feature.h"
+#include "gc.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
 
-#include "libguile/values.h"
+#include "values.h"
 
-SCM scm_values_vtable;
 
 /* OBJ must be a values object containing exactly two values.
    scm_i_extract_values_2 puts those two values into *p1 and *p2.  */
 void
 scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2)
 {
-  SCM values;
-
-  SCM_ASSERT_TYPE (SCM_VALUESP (obj), obj, SCM_ARG1,
+  SCM_ASSERT_TYPE (scm_is_values (obj), obj, SCM_ARG1,
 		   "scm_i_extract_values_2", "values");
-  values = scm_struct_ref (obj, SCM_INUM0);
-  if (scm_ilength (values) != 2)
+  if (scm_i_nvalues (obj) != 2)
     scm_wrong_type_arg_msg
       ("scm_i_extract_values_2", SCM_ARG1, obj,
        "a values object containing exactly two values");
-  *p1 = SCM_CAR (values);
-  *p2 = SCM_CADR (values);
-}
-
-static SCM
-print_values (SCM obj, SCM pwps)
-{
-  SCM values = scm_struct_ref (obj, SCM_INUM0);
-  SCM port = SCM_PORT_WITH_PS_PORT (pwps);
-  scm_print_state *ps = SCM_PRINT_STATE (SCM_PORT_WITH_PS_PS (pwps));
-
-  scm_puts ("#<values ", port);
-  scm_iprin1 (values, port, ps);
-  scm_puts (">", port);
 
-  return SCM_UNSPECIFIED;
+  *p1 = scm_i_value_ref (obj, 0);
+  *p2 = scm_i_value_ref (obj, 1);
 }
 
 size_t
 scm_c_nvalues (SCM obj)
 {
-  if (SCM_LIKELY (SCM_VALUESP (obj)))
-    return scm_ilength (scm_struct_ref (obj, SCM_INUM0));
+  if (SCM_LIKELY (scm_is_values (obj)))
+    return scm_i_nvalues (obj);
   else
     return 1;
 }
@@ -79,20 +59,16 @@ scm_c_nvalues (SCM obj)
 SCM
 scm_c_value_ref (SCM obj, size_t idx)
 {
-  if (SCM_LIKELY (SCM_VALUESP (obj)))
+  if (scm_is_values (obj))
     {
-      SCM values = scm_struct_ref (obj, SCM_INUM0);
-      size_t i = idx;
-      while (SCM_LIKELY (scm_is_pair (values)))
-        {
-          if (i == 0)
-            return SCM_CAR (values);
-          values = SCM_CDR (values);
-          i--;
-        }
+      if (idx < scm_i_nvalues (obj))
+        return scm_i_value_ref (obj, idx);
+    }
+  else
+    {
+      if (idx == 0)
+        return obj;
     }
-  else if (idx == 0)
-    return obj;
 
   scm_error (scm_out_of_range_key,
 	     "scm_c_value_ref",
@@ -117,7 +93,17 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
   if (n == 1)
     result = SCM_CAR (args);
   else
-    result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
+    {
+      size_t i;
+
+      if ((size_t) n > (size_t) (UINTPTR_MAX >> 8))
+        scm_error (scm_out_of_range_key, FUNC_NAME, "Too many values",
+                   SCM_EOL, SCM_EOL);
+
+      result = scm_words ((((scm_t_bits) n) << 8) | scm_tc7_values, n + 1);
+      for (i = 0; i < n; i++, args = SCM_CDR (args))
+        SCM_SET_CELL_OBJECT (result, i + 1, SCM_CAR (args));
+    }
 
   return result;
 }
@@ -126,31 +112,53 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
 SCM
 scm_c_values (SCM *base, size_t nvalues)
 {
-  SCM ret, *walk;
+  SCM ret;
+  size_t i;
 
   if (nvalues == 1)
     return *base;
 
-  for (ret = SCM_EOL, walk = base + nvalues - 1; walk >= base; walk--)
-    ret = scm_cons (*walk, ret);
+  if ((uintptr_t) nvalues > (UINTPTR_MAX >> 8))
+    scm_error (scm_out_of_range_key, "scm_c_values", "Too many values",
+               SCM_EOL, SCM_EOL);
+
+  ret = scm_words ((((scm_t_bits) nvalues) << 8) | scm_tc7_values, nvalues + 1);
 
-  return scm_values (ret);
+  for (i = 0; i < nvalues; i++)
+    SCM_SET_CELL_OBJECT (ret, i + 1, base[i]);
+
+  return ret;
 }
 
-void
-scm_init_values (void)
+SCM
+scm_values_2 (SCM a, SCM b)
 {
-  SCM print = scm_c_define_gsubr ("%print-values", 2, 0, 0, print_values);
+  SCM ret;
 
-  scm_values_vtable = scm_make_vtable (scm_from_utf8_string ("pr"), print);
+  ret = scm_words ((2 << 8) | scm_tc7_values, 3);
+  SCM_SET_CELL_OBJECT_1 (ret, a);
+  SCM_SET_CELL_OBJECT_2 (ret, b);
 
-  scm_add_feature ("values");
+  return ret;
+}
+
+SCM
+scm_values_3 (SCM a, SCM b, SCM c)
+{
+  SCM ret;
+
+  ret = scm_words ((3 << 8) | scm_tc7_values, 4);
+  SCM_SET_CELL_OBJECT_1 (ret, a);
+  SCM_SET_CELL_OBJECT_2 (ret, b);
+  SCM_SET_CELL_OBJECT_3 (ret, c);
 
-#include "libguile/values.x"
+  return ret;
 }
 
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+void
+scm_init_values (void)
+{
+  scm_add_feature ("values");
+
+#include "values.x"
+}
diff --git a/libguile/values.h b/libguile/values.h
index 3dbd0b742..e5f004332 100644
--- a/libguile/values.h
+++ b/libguile/values.h
@@ -1,47 +1,59 @@
-/* classes: h_files */
-
 #ifndef SCM_VALUES_H
 #define SCM_VALUES_H
 
-/* Copyright (C) 2000,2001, 2006, 2008, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2000-2001,2006,2008,2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/gc.h"
+
+static inline int
+scm_is_values (SCM x)
+{
+  return SCM_HAS_TYP7 (x, scm_tc7_values);
+}
 
-SCM_API SCM scm_values_vtable;
+#ifdef BUILDING_LIBGUILE
+static inline size_t
+scm_i_nvalues (SCM x)
+{
+  return SCM_CELL_WORD_0 (x) >> 8;
+}
 
-#define SCM_VALUESP(x) (SCM_STRUCTP (x)\
-                        && scm_is_eq (scm_struct_vtable (x), scm_values_vtable))
+static inline SCM
+scm_i_value_ref (SCM x, size_t n)
+{
+  return SCM_CELL_OBJECT (x, n+1);
+}
+#endif
+
+#define SCM_VALUESP(x) (scm_is_values (x))
 
 SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2);
 
 SCM_API SCM scm_values (SCM args);
 SCM_API SCM scm_c_values (SCM *base, size_t n);
+SCM_API SCM scm_values_2 (SCM a, SCM b);
+SCM_API SCM scm_values_3 (SCM a, SCM b, SCM c);
 SCM_API size_t scm_c_nvalues (SCM obj);
 SCM_API SCM scm_c_value_ref (SCM obj, size_t idx);
 SCM_INTERNAL void scm_init_values (void);
 
 #endif  /* SCM_VALUES_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/variable.c b/libguile/variable.c
index c329bca1a..96c6bfe7d 100644
--- a/libguile/variable.c
+++ b/libguile/variable.c
@@ -1,35 +1,40 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008, 2011 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1998,2000-2001,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
-#include "libguile/ports.h"
-#include "libguile/smob.h"
-#include "libguile/deprecation.h"
+#include "boolean.h"
+#include "deprecation.h"
+#include "eq.h"
+#include "gsubr.h"
+#include "list.h"
+#include "ports.h"
+#include "smob.h"
+
+#include "variable.h"
+
 
-#include "libguile/validate.h"
-#include "libguile/variable.h"
 
 
 void
@@ -137,11 +142,5 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
 void
 scm_init_variable ()
 {
-#include "libguile/variable.x"
+#include "variable.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/variable.h b/libguile/variable.h
index c024c8519..07d265843 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -1,30 +1,30 @@
-/* classes: h_files */
-
 #ifndef SCM_VARIABLE_H
 #define SCM_VARIABLE_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2006,2008,2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
-#include "libguile/smob.h"
+#include <libguile/error.h>
+#include <libguile/gc.h>
+#include <libguile/snarf.h>
 
 
 
@@ -35,6 +35,29 @@
 #define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X)
 #define SCM_VARIABLE_LOC(V)   (SCM_CELL_OBJECT_LOC ((V), 1))
 
+#define SCM_VALIDATE_VARIABLE(pos, var) \
+  SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
+
+
+
+
+#define SCM_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
+
+#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
+
+#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
+
+#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
+
+
 
 
 SCM_API SCM scm_make_variable (SCM init);
@@ -50,9 +73,3 @@ SCM_INTERNAL void scm_i_variable_print (SCM var, SCM port, scm_print_state *psta
 SCM_INTERNAL void scm_init_variable (void);
 
 #endif  /* SCM_VARIABLE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vectors.c b/libguile/vectors.c
index acdda5dcd..87a50a3dd 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,41 +1,40 @@
-/* Copyright (C) 1995, 1996, 1998-2001, 2006, 2008-2012, 2014, 2019
- *   Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2001,2006,2008-2012,2014,2018-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/eq.h"
-#include "libguile/strings.h"
-
-#include "libguile/validate.h"
-#include "libguile/vectors.h"
-#include "libguile/arrays.h" /* Hit me with the ugly stick */
-#include "libguile/generalized-vectors.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/dynwind.h"
+#include "array-handle.h"
+#include "bdw-gc.h"
+#include "boolean.h"
+#include "eq.h"
+#include "gsubr.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "vectors.h"
 
-#include "libguile/bdw-gc.h"
+#include "generalized-vectors.h"
 
 
 
@@ -64,11 +63,13 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
 		     size_t *lenp, ssize_t *incp)
 {
-  /* it's unsafe to access the memory of a weak vector */
-  if (SCM_I_WVECTP (vec))
-    scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
-  scm_generalized_vector_get_handle (vec, h);
+  scm_array_get_handle (vec, h);
+  if (1 != scm_array_handle_rank (h))
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array of Scheme values");
+    }
+  
   if (lenp)
     {
       scm_t_array_dim *dim = scm_array_handle_dims (h);
@@ -436,12 +437,6 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector)
 void
 scm_init_vectors ()
 {
-#include "libguile/vectors.x"
+#include "vectors.x"
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vectors.h b/libguile/vectors.h
index d279787c8..41e2c8909 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -1,29 +1,30 @@
-/* classes: h_files */
-
 #ifndef SCM_VECTORS_H
 #define SCM_VECTORS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2002,2004-2006,2008-2009,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+#include <libguile/error.h>
+#include "libguile/gc.h"
 
 
 
@@ -54,6 +55,16 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 					   scm_t_array_handle *h,
 					   size_t *lenp, ssize_t *incp);
 
+#define SCM_VALIDATE_VECTOR(pos, v) \
+  do { \
+    SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
+  } while (0)
+
+#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
+  do { \
+    SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
+  } while (0)
+
 /* Fast, non-checking accessors for simple vectors.
  */
 #define SCM_SIMPLE_VECTOR_LENGTH(x)      SCM_I_VECTOR_LENGTH(x)
@@ -82,9 +93,3 @@ SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
 SCM_INTERNAL void scm_init_vectors (void);
 
 #endif  /* SCM_VECTORS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/version.c b/libguile/version.c
index f1bd3c3f9..32d0a03e3 100644
--- a/libguile/version.c
+++ b/libguile/version.c
@@ -1,32 +1,38 @@
-/*	Copyright (C) 1995,1996, 1999, 2000, 2001, 2006, 2008, 2010 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1999-2001,2006,2008,2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <stdio.h>
-#include "libguile/_scm.h"
-#include "libguile/strings.h"
 
-#include "libguile/version.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "strings.h"
+
+#include "version.h"
+
+
 
 
 #define SCM_TMP_MACRO_MKSTR(x) #x
@@ -115,11 +121,5 @@ SCM_DEFINE (scm_effective_version, "effective-version", 0, 0, 0,
 void
 scm_init_version ()
 {
-#include "libguile/version.x"
+#include "version.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/version.h.in b/libguile/version.h.in
index 427afaede..ac29af3f9 100644
--- a/libguile/version.h.in
+++ b/libguile/version.h.in
@@ -1,9 +1,8 @@
-/* classes: h_files */
-
 #ifndef SCM_VERSION_H
 #define SCM_VERSION_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
+/* Copyright 1995-1996,1998-2001,2006,2008,2010,2018
+ *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -23,7 +22,7 @@
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -40,10 +39,3 @@ SCM_API SCM scm_version (void);
 SCM_INTERNAL void scm_init_version (void);
 
 #endif  /* SCM_VERSION_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  mode: c
-  End:
-*/
diff --git a/libguile/vm-builtins.h b/libguile/vm-builtins.h
index 5e31a04d8..1f8cdf6c6 100644
--- a/libguile/vm-builtins.h
+++ b/libguile/vm-builtins.h
@@ -1,20 +1,21 @@
-/* Copyright (C) 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2013,2018
+    Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_VM_BUILTINS_H_
 #define _SCM_VM_BUILTINS_H_
@@ -38,6 +39,7 @@ enum scm_vm_builtins
   SCM_VM_BUILTIN_COUNT
 };
 
+SCM_INTERNAL SCM scm_vm_builtin_ref (unsigned idx);
 SCM_INTERNAL SCM scm_vm_builtin_name_to_index (SCM name);
 SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx);
 SCM_INTERNAL void scm_init_vm_builtin_properties (void);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 931017e2d..469a31cea 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 2001, 2009-2015, 2018, 2019
- *   Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* This file is included in vm.c multiple times.  */
 
@@ -37,14 +37,6 @@
     }                                     \
   while (0)
 
-#define UNPACK_16_8(op,a,b)               \
-  do                                      \
-    {                                     \
-      a = (op >> 8) & 0xffff;             \
-      b = op >> 24;                       \
-    }                                     \
-  while (0)
-
 #define UNPACK_12_12(op,a,b)              \
   do                                      \
     {                                     \
@@ -60,6 +52,21 @@
     }                                     \
   while (0)
 
+#define UNPACK_8_24(op,a,b)               \
+  do                                      \
+    {                                     \
+      a = op & 0xff;                      \
+      b = op >> 8;                        \
+    }                                     \
+  while (0)
+
+#define UNPACK_16_16(op,a,b)              \
+  do                                      \
+    {                                     \
+      a = op & 0xffff;                    \
+      b = op >> 16;                       \
+    }                                     \
+  while (0)
 
 /* Assign some registers by hand.  There used to be a bigger list here,
    but it was never tested, and in the case of x86-32, was a source of
@@ -85,6 +92,8 @@
 # define JT_REG
 #endif
 
+#define VP (&thread->vm)
+
 #define VM_ASSERT(condition, handler)     \
   do {                                    \
     if (SCM_UNLIKELY (!(condition)))      \
@@ -101,31 +110,23 @@
 #endif
 
 #if VM_USE_HOOKS
-#define RUN_HOOK(exp)                                   \
-  do {                                                  \
-    if (SCM_UNLIKELY (vp->trace_level > 0))             \
-      {                                                 \
-        SYNC_IP ();                                     \
-        exp;                                            \
-        CACHE_SP ();                                    \
-      }                                                 \
+#define RUN_HOOK(h)                                          \
+  do {                                                       \
+    if (SCM_UNLIKELY (VP->h##_hook_enabled))                 \
+      {                                                      \
+        SYNC_IP ();                                          \
+        invoke_##h##_hook (thread);                          \
+        CACHE_SP ();                                         \
+      }                                                      \
   } while (0)
 #else
-#define RUN_HOOK(exp)
+#define RUN_HOOK(h)
 #endif
-#define RUN_HOOK0(h)      RUN_HOOK (vm_dispatch_##h##_hook (vp))
-#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vp, arg))
 
-#define APPLY_HOOK()                            \
-  RUN_HOOK0 (apply)
-#define PUSH_CONTINUATION_HOOK()                \
-  RUN_HOOK0 (push_continuation)
-#define POP_CONTINUATION_HOOK(old_fp)           \
-  RUN_HOOK1 (pop_continuation, old_fp)
-#define NEXT_HOOK()                             \
-  RUN_HOOK0 (next)
-#define ABORT_CONTINUATION_HOOK()               \
-  RUN_HOOK0 (abort)
+#define APPLY_HOOK()                  RUN_HOOK (apply)
+#define RETURN_HOOK()                 RUN_HOOK (return)
+#define NEXT_HOOK()                   RUN_HOOK (next)
+#define ABORT_HOOK()                  RUN_HOOK (abort)
 
 
 
@@ -138,12 +139,12 @@
    the VM.  We do the same for SP.  The FP is used more by code outside
    the VM than by the VM itself, we don't bother caching it locally.
 
-   Keeping vp->ip in sync with the local IP would be a big lose, as it
-   is updated so often.  Instead of updating vp->ip all the time, we
+   Keeping VP->ip in sync with the local IP would be a big lose, as it
+   is updated so often.  Instead of updating VP->ip all the time, we
    call SYNC_IP whenever we would need to know the IP of the top frame.
    In practice, we need to SYNC_IP whenever we call out of the VM to a
    function that would like to walk the stack, perhaps as the result of
-   an exception.  On the other hand, we do always keep vp->sp in sync
+   an exception.  On the other hand, we do always keep VP->sp in sync
    with the local SP.
 
    One more thing.  We allow the stack to move, when it expands.
@@ -151,16 +152,19 @@
    code, or otherwise push anything on the stack, you will need to
    CACHE_SP afterwards to restore the possibly-changed stack pointer.  */
 
-#define SYNC_IP() vp->ip = (ip)
+#define SYNC_IP() VP->ip = (ip)
 
-#define CACHE_SP() sp = vp->sp
+#define CACHE_SP() sp = VP->sp
 #define CACHE_REGISTER()                        \
   do {                                          \
-    ip = vp->ip;                                \
+    ip = VP->ip;                                \
     CACHE_SP ();                                \
   } while (0)
 
 
+#define CALL_INTRINSIC(x, args) \
+  (((struct scm_vm_intrinsics *) (void*) intrinsics)->x args)
+
 /* Reserve stack space for a frame.  Will check that there is sufficient
    stack space for N locals, including the procedure.  Invoke after
    preparing the new frame and setting the fp and ip.
@@ -171,42 +175,43 @@
    FP is valid across an ALLOC_FRAME call.  Be careful!  */
 #define ALLOC_FRAME(n)                                              \
   do {                                                              \
-    sp = vp->fp - (n);                                              \
-    if (sp < vp->sp_min_since_gc)                                   \
+    sp = VP->fp - (n);                                              \
+    if (sp < VP->sp_min_since_gc)                                   \
       {                                                             \
-        if (SCM_UNLIKELY (sp < vp->stack_limit))                    \
+        if (SCM_UNLIKELY (sp < VP->stack_limit))                    \
           {                                                         \
             SYNC_IP ();                                             \
-            vm_expand_stack (vp, sp);                               \
+            CALL_INTRINSIC (expand_stack, (thread, sp));            \
             CACHE_SP ();                                            \
           }                                                         \
         else                                                        \
-          vp->sp_min_since_gc = vp->sp = sp;                        \
+          VP->sp_min_since_gc = VP->sp = sp;                        \
       }                                                             \
     else                                                            \
-      vp->sp = sp;                                                  \
+      VP->sp = sp;                                                  \
   } while (0)
 
 /* Reset the current frame to hold N locals.  Used when we know that no
-   stack expansion is needed.  */
+   stack expansion is needed.  Note that in some cases this may lower
+   SP, e.g. after a return but where there are more locals below, but we
+   know it was preceded by an alloc-frame in that case, so no stack need
+   be allocated.
+
+   As an optimization, we don't update sp_min_since_gc in this case; the
+   principal place stacks are expanded is in ALLOC_FRAME. it doesn't
+   need to strictly be the min since GC, as it's just an optimization to
+   prevent passing too-large of a range to madvise.  */
 #define RESET_FRAME(n)                                              \
   do {                                                              \
-    vp->sp = sp = vp->fp - (n);                                     \
-    if (sp < vp->sp_min_since_gc)                                   \
-      vp->sp_min_since_gc = sp;                                     \
+    VP->sp = sp = VP->fp - (n);                                     \
   } while (0)
 
 /* Compute the number of locals in the frame.  At a call, this is equal
    to the number of actual arguments when a function is first called,
    plus one for the function.  */
-#define FRAME_LOCALS_COUNT() (vp->fp - sp)
+#define FRAME_LOCALS_COUNT() (VP->fp - sp)
 #define FRAME_LOCALS_COUNT_FROM(slot) (FRAME_LOCALS_COUNT () - slot)
 
-/* Restore registers after returning from a frame.  */
-#define RESTORE_FRAME()                                             \
-  do {                                                              \
-  } while (0)
-
 
 #ifdef HAVE_LABELS_AS_VALUES
 # define BEGIN_DISPATCH_SWITCH /* */
@@ -243,9 +248,9 @@
   case opcode:
 #endif
 
-#define FP_SLOT(i)	        SCM_FRAME_SLOT (vp->fp, i)
-#define FP_REF(i)		SCM_FRAME_LOCAL (vp->fp, i)
-#define FP_SET(i,o)		SCM_FRAME_LOCAL (vp->fp, i) = o
+#define FP_SLOT(i)	        SCM_FRAME_SLOT (VP->fp, i)
+#define FP_REF(i)		SCM_FRAME_LOCAL (VP->fp, i)
+#define FP_SET(i,o)		SCM_FRAME_LOCAL (VP->fp, i) = o
 
 #define SP_REF_SLOT(i)		(sp[i])
 #define SP_SET_SLOT(i,o)	(sp[i] = o)
@@ -262,197 +267,19 @@
 #define SP_REF_S64(i)		(sp[i].as_s64)
 #define SP_SET_S64(i,o)		(sp[i].as_s64 = o)
 
-#define VARIABLE_REF(v)		SCM_VARIABLE_REF (v)
-#define VARIABLE_SET(v,o)	SCM_VARIABLE_SET (v, o)
-#define VARIABLE_BOUNDP(v)      (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
-
-#define BR_NARGS(rel)                           \
-  scm_t_uint32 expected;                        \
-  UNPACK_24 (op, expected);                     \
-  if (FRAME_LOCALS_COUNT() rel expected)        \
-    {                                           \
-      scm_t_int32 offset = ip[1];               \
-      offset >>= 8; /* Sign-extending shift. */ \
-      NEXT (offset);                            \
-    }                                           \
-  NEXT (2)
-
-#define BR_UNARY(x, exp)                        \
-  scm_t_uint32 test;                            \
-  SCM x;                                        \
-  UNPACK_24 (op, test);                         \
-  x = SP_REF (test);                            \
-  if ((ip[1] & 0x1) ? !(exp) : (exp))           \
-    {                                           \
-      scm_t_int32 offset = ip[1];               \
-      offset >>= 8; /* Sign-extending shift. */ \
-      NEXT (offset);                            \
-    }                                           \
-  NEXT (2)
-
-#define BR_BINARY(x, y, exp)                    \
-  scm_t_uint32 a, b;                            \
-  SCM x, y;                                     \
-  UNPACK_24 (op, a);                            \
-  UNPACK_24 (ip[1], b);                         \
-  x = SP_REF (a);                               \
-  y = SP_REF (b);                               \
-  if ((ip[2] & 0x1) ? !(exp) : (exp))           \
-    {                                           \
-      scm_t_int32 offset = ip[2];               \
-      offset >>= 8; /* Sign-extending shift. */ \
-      NEXT (offset);                            \
-    }                                           \
-  NEXT (3)
-
-#define BR_ARITHMETIC(crel,srel)                                        \
-  {                                                                     \
-    scm_t_uint32 a, b;                                                  \
-    SCM x, y;                                                           \
-    UNPACK_24 (op, a);                                                  \
-    UNPACK_24 (ip[1], b);                                               \
-    x = SP_REF (a);                                                     \
-    y = SP_REF (b);                                                     \
-    if (SCM_I_INUMP (x) && SCM_I_INUMP (y))                             \
-      {                                                                 \
-        scm_t_signed_bits x_bits = SCM_UNPACK (x);                      \
-        scm_t_signed_bits y_bits = SCM_UNPACK (y);                      \
-        if ((ip[2] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
-          {                                                             \
-            scm_t_int32 offset = ip[2];                                 \
-            offset >>= 8; /* Sign-extending shift. */                   \
-            NEXT (offset);                                              \
-          }                                                             \
-        NEXT (3);                                                       \
-      }                                                                 \
-    else                                                                \
-      {                                                                 \
-        SCM res;                                                        \
-        SYNC_IP ();                                                     \
-        res = srel (x, y);                                              \
-        CACHE_SP ();                                                \
-        if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res))     \
-          {                                                             \
-            scm_t_int32 offset = ip[2];                                 \
-            offset >>= 8; /* Sign-extending shift. */                   \
-            NEXT (offset);                                              \
-          }                                                             \
-        NEXT (3);                                                       \
-      }                                                                 \
-  }
-
-#define BR_U64_ARITHMETIC(crel)                                         \
-  {                                                                     \
-    scm_t_uint32 a, b;                                                  \
-    scm_t_uint64 x, y;                                                  \
-    UNPACK_24 (op, a);                                                  \
-    UNPACK_24 (ip[1], b);                                               \
-    x = SP_REF_U64 (a);                                                 \
-    y = SP_REF_U64 (b);                                                 \
-    if ((ip[2] & 0x1) ? !(x crel y) : (x crel y))                       \
-      {                                                                 \
-        scm_t_int32 offset = ip[2];                                     \
-        offset >>= 8; /* Sign-extending shift. */                       \
-        NEXT (offset);                                                  \
-      }                                                                 \
-    NEXT (3);                                                           \
-  }
-
-#define BR_F64_ARITHMETIC(crel)                                         \
-  {                                                                     \
-    scm_t_uint32 a, b;                                                  \
-    double x, y;                                                        \
-    UNPACK_24 (op, a);                                                  \
-    UNPACK_24 (ip[1], b);                                               \
-    x = SP_REF_F64 (a);                                                 \
-    y = SP_REF_F64 (b);                                                 \
-    if ((ip[2] & 0x1) ? !(x crel y) : (x crel y))                       \
-      {                                                                 \
-        scm_t_int32 offset = ip[2];                                     \
-        offset >>= 8; /* Sign-extending shift. */                       \
-        NEXT (offset);                                                  \
-      }                                                                 \
-    NEXT (3);                                                           \
-  }
-
-
-#define ARGS1(a1)                               \
-  scm_t_uint16 dst, src;                        \
-  SCM a1;                                       \
-  UNPACK_12_12 (op, dst, src);                  \
-  a1 = SP_REF (src)
-#define ARGS2(a1, a2)                           \
-  scm_t_uint8 dst, src1, src2;                  \
-  SCM a1, a2;                                   \
-  UNPACK_8_8_8 (op, dst, src1, src2);           \
-  a1 = SP_REF (src1);                           \
-  a2 = SP_REF (src2)
-#define RETURN(x)                               \
-  do { SP_SET (dst, x); NEXT (1); } while (0)
-#define RETURN_EXP(exp)                         \
-  do { SCM __x; SYNC_IP (); __x = exp; CACHE_SP (); RETURN (__x); } while (0)
-
-/* The maximum/minimum tagged integers.  */
-#define INUM_MAX  \
-  ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
-#define INUM_MIN  \
-  ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
-#define INUM_STEP                                \
-  ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1)    \
-   - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
-
-#define BINARY_INTEGER_OP(CFUNC,SFUNC)                          \
-  {                                                             \
-    ARGS2 (x, y);						\
-    if (SCM_I_INUMP (x) && SCM_I_INUMP (y))                     \
-      {                                                         \
-        scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);    \
-        if (SCM_FIXABLE (n))                                    \
-          RETURN (SCM_I_MAKINUM (n));                           \
-      }                                                         \
-    RETURN_EXP (SFUNC (x, y));                                  \
-  }
-
-#define VM_VALIDATE(x, pred, proc, what)                                \
-  VM_ASSERT (pred (x), vm_error_not_a_ ## what (proc, x))
-
-#define VM_VALIDATE_ATOMIC_BOX(x, proc)                                 \
-  VM_VALIDATE (x, scm_is_atomic_box, proc, atomic_box)
-#define VM_VALIDATE_BYTEVECTOR(x, proc)                                 \
-  VM_VALIDATE (x, SCM_BYTEVECTOR_P, proc, bytevector)
-#define VM_VALIDATE_MUTABLE_BYTEVECTOR(obj, proc)                       \
-  VM_VALIDATE (obj, SCM_MUTABLE_BYTEVECTOR_P, proc, mutable_bytevector)
-#define VM_VALIDATE_CHAR(x, proc)                                       \
-  VM_VALIDATE (x, SCM_CHARP, proc, char)
-#define VM_VALIDATE_PAIR(x, proc)                                       \
-  VM_VALIDATE (x, scm_is_pair, proc, pair)
-#define VM_VALIDATE_MUTABLE_PAIR(x, proc)                               \
-  VM_VALIDATE (x, scm_is_mutable_pair, proc, mutable_pair)
-#define VM_VALIDATE_STRING(obj, proc)                                   \
-  VM_VALIDATE (obj, scm_is_string, proc, string)
-#define VM_VALIDATE_STRUCT(obj, proc)                                   \
-  VM_VALIDATE (obj, SCM_STRUCTP, proc, struct)
-#define VM_VALIDATE_VARIABLE(obj, proc)                                 \
-  VM_VALIDATE (obj, SCM_VARIABLEP, proc, variable)
-#define VM_VALIDATE_VECTOR(obj, proc)                                   \
-  VM_VALIDATE (obj, SCM_I_IS_VECTOR, proc, vector)
-#define VM_VALIDATE_MUTABLE_VECTOR(obj, proc)                           \
-  VM_VALIDATE (obj, SCM_I_IS_MUTABLE_VECTOR, proc, mutable_vector)
-
-#define VM_VALIDATE_INDEX(u64, size, proc)                              \
-  VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64))
+#define SP_REF_PTR(i)		(sp[i].as_ptr)
+#define SP_SET_PTR(i,o)		(sp[i].as_ptr = o)
 
 /* Return true (non-zero) if PTR has suitable alignment for TYPE.  */
 #define ALIGNED_P(ptr, type)			\
-  ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
+  ((uintptr_t) (ptr) % alignof_type (type) == 0)
 
 static SCM
-VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
-         scm_i_jmp_buf *registers, int resume)
+VM_NAME (scm_thread *thread)
 {
   /* Instruction pointer: A pointer to the opcode that is currently
      running.  */
-  register scm_t_uint32 *ip IP_REG;
+  register uint32_t *ip IP_REG;
 
   /* Stack pointer: A pointer to the hot end of the stack, off of which
      we index arguments and local variables.  Pushed at function calls,
@@ -460,7 +287,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
   register union scm_vm_stack_element *sp FP_REG;
 
   /* Current opcode: A cache of *ip.  */
-  register scm_t_uint32 op;
+  register uint32_t op;
+
+  void **intrinsics = (void**) &scm_vm_intrinsics;
 
 #ifdef HAVE_LABELS_AS_VALUES
   static const void *jump_table_[256] = {
@@ -477,20 +306,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
   /* Load VM registers. */
   CACHE_REGISTER ();
 
-  /* Usually a call to the VM happens on application, with the boot
-     continuation on the next frame.  Sometimes it happens after a
-     non-local exit however; in that case the VM state is all set up,
-     and we have but to jump to the next opcode.  */
-  if (SCM_UNLIKELY (resume))
-    NEXT (0);
-
-  if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
-    ip = SCM_PROGRAM_CODE (FP_REF (0));
-  else
-    ip = (scm_t_uint32 *) vm_apply_non_program_code;
-
-  APPLY_HOOK ();
-
+  /* Start processing!  */
   NEXT (0);
 
   BEGIN_DISPATCH_SWITCH;
@@ -498,44 +314,131 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
 
   
 
-  /*
-   * Call and return
-   */
-
   /* halt _:24
    *
    * Bring the VM to a halt, returning all the values from the stack.
    */
   VM_DEFINE_OP (0, halt, "halt", OP1 (X32))
     {
-      /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4.  */
-
-      scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
+      size_t frame_size = 3;
+      /* Empty frame, then values.  */
+      size_t first_value = frame_size;
+      uint32_t nvals = FRAME_LOCALS_COUNT_FROM (first_value);
+      union scm_vm_stack_element *fp;
       SCM ret;
 
       if (nvals == 1)
-        ret = FP_REF (4);
+        ret = FP_REF (first_value);
       else
         {
-          scm_t_uint32 n;
-          ret = SCM_EOL;
+          uint32_t n;
           SYNC_IP ();
-          for (n = nvals; n > 0; n--)
-            ret = scm_inline_cons (thread, FP_REF (4 + n - 1), ret);
-          ret = scm_values (ret);
+          VM_ASSERT (nvals <= (UINTPTR_MAX >> 8), abort ());
+          ret = scm_words ((nvals << 8) | scm_tc7_values, nvals + 1);
+          for (n = 0; n < nvals; n++)
+            SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (first_value + n));
         }
 
-      vp->ip = SCM_FRAME_RETURN_ADDRESS (vp->fp);
-      vp->sp = SCM_FRAME_PREVIOUS_SP (vp->fp);
-      vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp);
+      fp = VP->fp;
+      VP->fp = SCM_FRAME_DYNAMIC_LINK (fp);
+      VP->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp);
+      VP->sp = SCM_FRAME_PREVIOUS_SP (fp);
 
       return ret;
     }
 
+  /* instrument-entry _:24 data:32
+   *
+   * Increase execution counter for this function and potentially tier
+   * up to the next JIT level.  DATA is an offset to a structure
+   * recording execution counts and the next-level JIT code
+   * corresponding to this function.  Also run the apply hook.
+   */
+  VM_DEFINE_OP (1, instrument_entry, "instrument-entry", OP2 (X32, N32))
+    {
+#if ENABLE_JIT
+      if (!VP->disable_mcode)
+        {
+          struct scm_jit_function_data *data;
+
+          int32_t data_offset = ip[1];
+          data = (struct scm_jit_function_data *) (ip + data_offset);
+
+          if (data->mcode)
+            {
+              SYNC_IP ();
+              scm_jit_enter_mcode (thread, data->mcode);
+              CACHE_REGISTER ();
+              NEXT (0);
+            }
+
+          if (data->counter >= scm_jit_counter_threshold)
+            {
+              const uint8_t *mcode;
+
+              SYNC_IP ();
+              mcode = scm_jit_compute_mcode (thread, data);
+
+              if (mcode)
+                {
+                  scm_jit_enter_mcode (thread, mcode);
+                  CACHE_REGISTER ();
+                  NEXT (0);
+                }
+            }
+          else
+            data->counter += SCM_JIT_COUNTER_ENTRY_INCREMENT;
+        }
+#endif
+
+      APPLY_HOOK ();
+
+      NEXT (2);
+    }
+
+  /* instrument-loop _:24 data:32
+   *
+   * Increase execution counter for this function and potentially tier
+   * up to the next JIT level.  DATA is an offset to a structure
+   * recording execution counts and the next-level JIT code
+   * corresponding to this function.
+   */
+  VM_DEFINE_OP (2, instrument_loop, "instrument-loop", OP2 (X32, N32))
+    {
+#if ENABLE_JIT
+      if (!VP->disable_mcode)
+        {
+          int32_t data_offset = ip[1];
+          struct scm_jit_function_data *data;
+
+          data = (struct scm_jit_function_data *) (ip + data_offset);
+
+          if (data->counter >= scm_jit_counter_threshold)
+            {
+              const uint8_t *mcode;
+
+              SYNC_IP ();
+              mcode = scm_jit_compute_mcode (thread, data);
+
+              if (mcode)
+                {
+                  scm_jit_enter_mcode (thread, mcode);
+                  CACHE_REGISTER ();
+                  NEXT (0);
+                }
+            }
+          else
+            data->counter += SCM_JIT_COUNTER_LOOP_INCREMENT;
+        }
+#endif
+
+      NEXT (2);
+    }
+
   /* call proc:24 _:8 nlocals:24
    *
    * Call a procedure.  PROC is the local corresponding to a procedure.
-   * The two values below PROC will be overwritten by the saved call
+   * The three values below PROC will be overwritten by the saved call
    * frame data.  The new frame will have space for NLOCALS locals: one
    * for the procedure, and the rest for the arguments which should
    * already have been pushed on.
@@ -543,32 +446,26 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * When the call returns, execution proceeds with the next
    * instruction.  There may be any number of values on the return
    * stack; the precise number can be had by subtracting the address of
-   * PROC from the post-call SP.
+   * slot PROC-1 from the post-call SP.
    */
-  VM_DEFINE_OP (1, call, "call", OP2 (X8_F24, X8_C24))
+  VM_DEFINE_OP (3, call, "call", OP2 (X8_F24, X8_C24))
     {
-      scm_t_uint32 proc, nlocals;
+      uint32_t proc, nlocals;
       union scm_vm_stack_element *old_fp, *new_fp;
 
       UNPACK_24 (op, proc);
       UNPACK_24 (ip[1], nlocals);
 
-      PUSH_CONTINUATION_HOOK ();
-
-      old_fp = vp->fp;
+      old_fp = VP->fp;
       new_fp = SCM_FRAME_SLOT (old_fp, proc - 1);
       SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
-      SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip + 2);
-      vp->fp = new_fp;
+      SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 2);
+      SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0);
+      VP->fp = new_fp;
 
       RESET_FRAME (nlocals);
-
-      if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
-        ip = SCM_PROGRAM_CODE (FP_REF (0));
-      else
-        ip = (scm_t_uint32 *) vm_apply_non_program_code;
-
-      APPLY_HOOK ();
+      ip = CALL_INTRINSIC (get_callee_vcode, (thread));
+      CACHE_SP ();
 
       NEXT (0);
     }
@@ -580,110 +477,90 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * This instruction is just like "call", except that instead of
    * dereferencing PROC to find the call target, the call target is
    * known to be at LABEL, a signed 32-bit offset in 32-bit units from
-   * the current IP.  Since PROC is not dereferenced, it may be some
-   * other representation of the closure.
+   * the current IP.  Since PROC is not used to compute the callee code,
+   * it may be some other representation of the closure.
    */
-  VM_DEFINE_OP (2, call_label, "call-label", OP3 (X8_F24, X8_C24, L32))
+  VM_DEFINE_OP (4, call_label, "call-label", OP3 (X8_F24, X8_C24, L32))
     {
-      scm_t_uint32 proc, nlocals;
-      scm_t_int32 label;
+      uint32_t proc, nlocals;
+      int32_t label;
       union scm_vm_stack_element *old_fp, *new_fp;
 
       UNPACK_24 (op, proc);
       UNPACK_24 (ip[1], nlocals);
       label = ip[2];
 
-      PUSH_CONTINUATION_HOOK ();
-
-      old_fp = vp->fp;
+      old_fp = VP->fp;
       new_fp = SCM_FRAME_SLOT (old_fp, proc - 1);
       SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
-      SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip + 3);
-      vp->fp = new_fp;
+      SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 3);
+      SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0);
+      VP->fp = new_fp;
 
       RESET_FRAME (nlocals);
 
       ip += label;
 
-      APPLY_HOOK ();
-
       NEXT (0);
     }
 
-  /* tail-call nlocals:24
+  /* tail-call _:24
    *
-   * Tail-call a procedure.  Requires that the procedure and all of the
-   * arguments have already been shuffled into position.  Will reset the
-   * frame to NLOCALS.
+   * Tail-call the procedure in slot 0 with the arguments in the current
+   * stack frame.  Requires that the procedure and all of the arguments
+   * have already been shuffled into position.
    */
-  VM_DEFINE_OP (3, tail_call, "tail-call", OP1 (X8_C24))
+  VM_DEFINE_OP (5, tail_call, "tail-call", OP1 (X32))
     {
-      scm_t_uint32 nlocals;
-      
-      UNPACK_24 (op, nlocals);
-
-      RESET_FRAME (nlocals);
-
-      if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
-        ip = SCM_PROGRAM_CODE (FP_REF (0));
-      else
-        ip = (scm_t_uint32 *) vm_apply_non_program_code;
-
-      APPLY_HOOK ();
-
+      ip = CALL_INTRINSIC (get_callee_vcode, (thread));
+      CACHE_SP ();
       NEXT (0);
     }
 
-  /* tail-call-label nlocals:24 label:32
+  /* tail-call-label _:24 label:32
    *
    * Tail-call a known procedure.  As call is to call-label, tail-call
    * is to tail-call-label.
    */
-  VM_DEFINE_OP (4, tail_call_label, "tail-call-label", OP2 (X8_C24, L32))
+  VM_DEFINE_OP (6, tail_call_label, "tail-call-label", OP2 (X32, L32))
     {
-      scm_t_uint32 nlocals;
-      scm_t_int32 label;
+      int32_t label;
       
-      UNPACK_24 (op, nlocals);
       label = ip[1];
 
-      RESET_FRAME (nlocals);
-
       ip += label;
 
-      APPLY_HOOK ();
-
       NEXT (0);
     }
 
-  /* tail-call/shuffle from:24
+  /* return-values _:24
    *
-   * Tail-call a procedure.  The procedure should already be set to slot
-   * 0.  The rest of the args are taken from the frame, starting at
-   * FROM, shuffled down to start at slot 0.  This is part of the
-   * implementation of the call-with-values builtin.
+   * Return all values from a call frame.
    */
-  VM_DEFINE_OP (5, tail_call_shuffle, "tail-call/shuffle", OP1 (X8_F24))
+  VM_DEFINE_OP (7, return_values, "return-values", OP1 (X32))
     {
-      scm_t_uint32 n, from, nlocals;
-
-      UNPACK_24 (op, from);
-
-      VM_ASSERT (from > 0, abort ());
-      nlocals = FRAME_LOCALS_COUNT ();
-
-      for (n = 0; from + n < nlocals; n++)
-        FP_SET (n + 1, FP_REF (from + n));
+      union scm_vm_stack_element *old_fp;
+      uint8_t *mcode;
 
-      RESET_FRAME (n + 1);
+      RETURN_HOOK ();
 
-      if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
-        ip = SCM_PROGRAM_CODE (FP_REF (0));
-      else
-        ip = (scm_t_uint32 *) vm_apply_non_program_code;
+      old_fp = VP->fp;
+      VP->fp = SCM_FRAME_DYNAMIC_LINK (old_fp);
 
-      APPLY_HOOK ();
+#if ENABLE_JIT
+      if (!VP->disable_mcode)
+        {
+          mcode = SCM_FRAME_MACHINE_RETURN_ADDRESS (old_fp);
+          if (mcode && mcode != scm_jit_return_to_interpreter_trampoline)
+            {
+              scm_jit_enter_mcode (thread, mcode);
+              CACHE_REGISTER ();
+              NEXT (0);
+            }
+        }
+#endif
 
+      ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (old_fp);
       NEXT (0);
     }
 
@@ -693,14 +570,15 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * PROC, asserting that the call actually returned at least one
    * value.  Afterwards, resets the frame to NLOCALS locals.
    */
-  VM_DEFINE_OP (6, receive, "receive", OP2 (X8_F12_F12, X8_C24) | OP_DST)
+  VM_DEFINE_OP (8, receive, "receive", DOP2 (X8_F12_F12, X8_C24))
     {
-      scm_t_uint16 dst, proc;
-      scm_t_uint32 nlocals;
+      uint16_t dst, proc;
+      uint32_t nlocals;
       UNPACK_12_12 (op, dst, proc);
       UNPACK_24 (ip[1], nlocals);
-      VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ());
-      FP_SET (dst, FP_REF (proc + 1));
+      VM_ASSERT (FRAME_LOCALS_COUNT () > proc,
+                 CALL_INTRINSIC (error_no_values, ()));
+      FP_SET (dst, FP_REF (proc));
       RESET_FRAME (nlocals);
       NEXT (2);
     }
@@ -713,416 +591,296 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * return values equals NVALUES exactly.  After receive-values has
    * run, the values can be copied down via `mov'.
    */
-  VM_DEFINE_OP (7, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24))
+  VM_DEFINE_OP (9, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24))
     {
-      scm_t_uint32 proc, nvalues;
+      uint32_t proc, nvalues;
       UNPACK_24 (op, proc);
       UNPACK_24 (ip[1], nvalues);
       if (ip[1] & 0x1)
-        VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
-                   vm_error_not_enough_values ());
+        VM_ASSERT (FRAME_LOCALS_COUNT () >= proc + nvalues,
+                   CALL_INTRINSIC (error_not_enough_values, ()));
       else
-        VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues,
-                   vm_error_wrong_number_of_values (nvalues));
+        VM_ASSERT (FRAME_LOCALS_COUNT () == proc + nvalues,
+                   CALL_INTRINSIC (error_wrong_number_of_values, (nvalues)));
       NEXT (2);
     }
 
-  VM_DEFINE_OP (8, unused_8, NULL, NOP)
-    {
-      vm_error_bad_instruction (op);
-      abort (); /* never reached */
-    }
-
-  /* return-values nlocals:24
+  /* assert-nargs-ee expected:24
+   * assert-nargs-ge expected:24
+   * assert-nargs-le expected:24
    *
-   * Return a number of values from a call frame.  This opcode
-   * corresponds to an application of `values' in tail position.  As
-   * with tail calls, we expect that the values have already been
-   * shuffled down to a contiguous array starting at slot 1.
-   * If NLOCALS is not zero, we also reset the frame to hold NLOCALS
-   * values.
+   * If the number of actual arguments is not ==, >=, or <= EXPECTED,
+   * respectively, signal an error.
    */
-  VM_DEFINE_OP (9, return_values, "return-values", OP1 (X8_C24))
+  VM_DEFINE_OP (10, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24))
     {
-      union scm_vm_stack_element *old_fp;
-      scm_t_uint32 nlocals;
-
-      UNPACK_24 (op, nlocals);
-      if (nlocals)
-        RESET_FRAME (nlocals);
-
-      old_fp = vp->fp;
-      ip = SCM_FRAME_RETURN_ADDRESS (vp->fp);
-      vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp);
-
-      /* Clear stack frame.  */
-      old_fp[0].as_scm = SCM_BOOL_F;
-      old_fp[1].as_scm = SCM_BOOL_F;
-
-      POP_CONTINUATION_HOOK (old_fp);
-
-      NEXT (0);
+      uint32_t expected;
+      UNPACK_24 (op, expected);
+      VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
+                 CALL_INTRINSIC (error_wrong_num_args, (thread)));
+      NEXT (1);
+    }
+  VM_DEFINE_OP (11, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24))
+    {
+      uint32_t expected;
+      UNPACK_24 (op, expected);
+      VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
+                 CALL_INTRINSIC (error_wrong_num_args, (thread)));
+      NEXT (1);
+    }
+  VM_DEFINE_OP (12, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24))
+    {
+      uint32_t expected;
+      UNPACK_24 (op, expected);
+      VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
+                 CALL_INTRINSIC (error_wrong_num_args, (thread)));
+      NEXT (1);
     }
 
-
-  
-
-  /*
-   * Specialized call stubs
-   */
-
-  /* subr-call _:24
+  /* assert-nargs-ee/locals expected:12 nlocals:12
    *
-   * Call a subr, passing all locals in this frame as arguments.  Return
-   * from the calling frame.  This instruction is part of the
-   * trampolines created in gsubr.c, and is not generated by the
-   * compiler.
+   * Equivalent to a sequence of assert-nargs-ee and reserve-locals.  The
+   * number of locals reserved is EXPECTED + NLOCALS.
    */
-  VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X32))
+  VM_DEFINE_OP (13, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12))
     {
-      SCM ret;
-
-      SYNC_IP ();
-      ret = scm_apply_subr (sp, FRAME_LOCALS_COUNT ());
-      CACHE_SP ();
+      uint16_t expected, nlocals;
+      UNPACK_12_12 (op, expected, nlocals);
+      VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
+                 CALL_INTRINSIC (error_wrong_num_args, (thread)));
+      ALLOC_FRAME (expected + nlocals);
 
-      if (SCM_UNLIKELY (SCM_VALUESP (ret)))
-        {
-          SCM vals = scm_struct_ref (ret, SCM_INUM0);
-          long len = scm_ilength (vals);
-          ALLOC_FRAME (1 + len);
-          while (len--)
-            {
-              SP_SET (len, SCM_CAR (vals));
-              vals = SCM_CDR (vals);
-            }
-          NEXT (1);
-        }
-      else
-        {
-          ALLOC_FRAME (2);
-          SP_SET (0, ret);
-          NEXT (1);
-        }
+      NEXT (1);
     }
 
-  /* foreign-call cif-idx:12 ptr-idx:12
+  /* arguments<=? expected:24
    *
-   * Call a foreign function.  Fetch the CIF and foreign pointer from
-   * CIF-IDX and PTR-IDX, both free variables.  Return from the calling
-   * frame.  Arguments are taken from the stack.  This instruction is
-   * part of the trampolines created by the FFI, and is not generated by
-   * the compiler.
+   * Set the LESS_THAN, EQUAL, or NONE comparison result values if the
+   * number of arguments is respectively less than, equal to, or greater
+   * than EXPECTED.
    */
-  VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (X8_C12_C12))
+  VM_DEFINE_OP (14, check_arguments, "arguments<=?", OP1 (X8_C24))
     {
-      scm_t_uint16 cif_idx, ptr_idx;
-      int err = 0;
-      SCM closure, cif, pointer, ret;
+      uint8_t compare_result;
+      uint32_t expected;
+      ptrdiff_t nargs;
 
-      UNPACK_12_12 (op, cif_idx, ptr_idx);
-
-      closure = FP_REF (0);
-      cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
-      pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
+      UNPACK_24 (op, expected);
+      nargs = FRAME_LOCALS_COUNT ();
 
-      SYNC_IP ();
-      ret = scm_i_foreign_call (cif, pointer, &err, sp);
-      CACHE_SP ();
+      if (nargs < (ptrdiff_t) expected)
+        compare_result = SCM_F_COMPARE_LESS_THAN;
+      else if (nargs == (ptrdiff_t) expected)
+        compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        compare_result = SCM_F_COMPARE_NONE;
 
-      ALLOC_FRAME (3);
-      SP_SET (1, ret);
-      SP_SET (0, scm_from_int (err));
+      VP->compare_result = compare_result;
 
       NEXT (1);
     }
 
-  /* continuation-call contregs:24
+  /* positional-arguments<=? nreq:24 _:8 expected:24
    *
-   * Return to a continuation, nonlocally.  The arguments to the
-   * continuation are taken from the stack.  CONTREGS is a free variable
-   * containing the reified continuation.  This instruction is part of
-   * the implementation of undelimited continuations, and is not
-   * generated by the compiler.
+   * Set the LESS_THAN, EQUAL, or NONE comparison result values if the
+   * number of positional arguments is less than, equal to, or greater
+   * than EXPECTED.  The first NREQ arguments are positional arguments,
+   * as are the subsequent arguments that are not keywords.
    */
-  VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (X8_C24))
+  VM_DEFINE_OP (15, check_positional_arguments, "positional-arguments<=?", OP2 (X8_C24, X8_C24))
     {
-      SCM contregs;
-      scm_t_uint32 contregs_idx;
-
-      UNPACK_24 (op, contregs_idx);
+      uint8_t compare_result;
+      uint32_t nreq, expected;
+      ptrdiff_t nargs, npos;
 
-      contregs =
-        SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx);
-
-      SYNC_IP ();
-      scm_i_check_continuation (contregs);
-      vm_return_to_continuation (scm_i_contregs_vp (contregs),
-                                 scm_i_contregs_vm_cont (contregs),
-                                 FRAME_LOCALS_COUNT_FROM (1),
-                                 sp);
-      scm_i_reinstate_continuation (contregs);
+      UNPACK_24 (op, nreq);
+      UNPACK_24 (ip[1], expected);
+      nargs = FRAME_LOCALS_COUNT ();
 
-      /* no NEXT */
-      abort ();
-    }
+      /* Precondition: at least NREQ arguments.  */
+      for (npos = nreq; npos < nargs && npos <= expected; npos++)
+        if (scm_is_keyword (FP_REF (npos)))
+          break;
 
-  /* compose-continuation cont:24
-   *
-   * Compose a partial continuation with the current continuation.  The
-   * arguments to the continuation are taken from the stack.  CONT is a
-   * free variable containing the reified continuation.  This
-   * instruction is part of the implementation of partial continuations,
-   * and is not generated by the compiler.
-   */
-  VM_DEFINE_OP (13, compose_continuation, "compose-continuation", OP1 (X8_C24))
-    {
-      SCM vmcont;
-      scm_t_uint32 cont_idx;
+      if (npos < (ptrdiff_t) expected)
+        compare_result = SCM_F_COMPARE_LESS_THAN;
+      else if (npos == (ptrdiff_t) expected)
+        compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        compare_result = SCM_F_COMPARE_NONE;
 
-      UNPACK_24 (op, cont_idx);
-      vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx);
+      VP->compare_result = compare_result;
 
-      SYNC_IP ();
-      VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
-                 vm_error_continuation_not_rewindable (vmcont));
-      vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
-                                         &thread->dynstack, registers);
-      CACHE_REGISTER ();
-      NEXT (0);
+      NEXT (2);
     }
 
-  /* tail-apply _:24
+  /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
+   *
+   * flags := allow-other-keys:1 has-rest:1 _:6
    *
-   * Tail-apply the procedure in local slot 0 to the rest of the
-   * arguments.  This instruction is part of the implementation of
-   * `apply', and is not generated by the compiler.
+   * Find the last positional argument, and shuffle all the rest above
+   * NTOTAL.  Initialize the intervening locals to SCM_UNDEFINED.  Then
+   * load the constant at KW-OFFSET words from the current IP, and use it
+   * to bind keyword arguments.  If HAS-REST, collect all shuffled
+   * arguments into a list, and store it in NREQ-AND-OPT.  Finally, clear
+   * the arguments that we shuffled up.
+   *
+   * A macro-mega-instruction.
    */
-  VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (X32))
+  VM_DEFINE_OP (16, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32))
     {
-      int i, list_idx, list_len, nlocals;
-      SCM list;
-
-      nlocals = FRAME_LOCALS_COUNT ();
-      // At a minimum, there should be apply, f, and the list.
-      VM_ASSERT (nlocals >= 3, abort ());
-      list_idx = nlocals - 1;
-      list = FP_REF (list_idx);
-      list_len = scm_ilength (list);
-
-      VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list));
-
-      nlocals = nlocals - 2 + list_len;
-      ALLOC_FRAME (nlocals);
+      uint32_t nreq, nreq_and_opt, ntotal, npositional;
+      int32_t kw_offset;
+      scm_t_bits kw_bits;
+      SCM kw;
+      uint8_t allow_other_keys, has_rest;
 
-      for (i = 1; i < list_idx; i++)
-        FP_SET (i - 1, FP_REF (i));
+      UNPACK_24 (op, nreq);
+      allow_other_keys = ip[1] & 0x1;
+      has_rest = ip[1] & 0x2;
+      UNPACK_24 (ip[1], nreq_and_opt);
+      UNPACK_24 (ip[2], ntotal);
+      kw_offset = ip[3];
+      kw_bits = (scm_t_bits) (ip + kw_offset);
+      VM_ASSERT (!(kw_bits & 0x7), abort());
+      kw = SCM_PACK (kw_bits);
 
-      /* Null out these slots, just in case there are less than 2 elements
-         in the list. */
-      FP_SET (list_idx - 1, SCM_UNDEFINED);
-      FP_SET (list_idx, SCM_UNDEFINED);
+      /* Note that if nopt == 0 then npositional = nreq.  */
+      npositional = CALL_INTRINSIC (compute_kwargs_npositional,
+                                    (thread, nreq, nreq_and_opt - nreq));
 
-      for (i = 0; i < list_len; i++, list = SCM_CDR (list))
-        FP_SET (list_idx - 1 + i, SCM_CAR (list));
+      SYNC_IP ();
+      CALL_INTRINSIC (bind_kwargs,
+                      (thread, npositional, ntotal, kw, !has_rest,
+                       allow_other_keys));
+      CACHE_SP ();
 
-      if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
-        ip = SCM_PROGRAM_CODE (FP_REF (0));
-      else
-        ip = (scm_t_uint32 *) vm_apply_non_program_code;
+      if (has_rest)
+        FP_SET (nreq_and_opt, CALL_INTRINSIC (cons_rest, (thread, ntotal)));
 
-      APPLY_HOOK ();
+      RESET_FRAME (ntotal);
 
-      NEXT (0);
+      NEXT (4);
     }
 
-  /* call/cc _:24
+  /* bind-rest dst:24
    *
-   * Capture the current continuation, and tail-apply the procedure in
-   * local slot 1 to it.  This instruction is part of the implementation
-   * of `call/cc', and is not generated by the compiler.
+   * Collect any arguments at or above DST into a list, and store that
+   * list at DST.
    */
-  VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (X32))
+  VM_DEFINE_OP (17, bind_rest, "bind-rest", DOP1 (X8_F24))
     {
-      SCM vm_cont, cont;
-      scm_t_dynstack *dynstack;
-      int first;
-
-      SYNC_IP ();
-      dynstack = scm_dynstack_capture_all (&thread->dynstack);
-      vm_cont = scm_i_vm_capture_stack (vp->stack_top,
-                                        SCM_FRAME_DYNAMIC_LINK (vp->fp),
-                                        SCM_FRAME_PREVIOUS_SP (vp->fp),
-                                        SCM_FRAME_RETURN_ADDRESS (vp->fp),
-                                        dynstack,
-                                        0);
-      /* FIXME: Seems silly to capture the registers here, when they are
-         already captured in the registers local, which here we are
-         copying out to the heap; and likewise, the setjmp(&registers)
-         code already has the non-local return handler.  But oh
-         well!  */
-      cont = scm_i_make_continuation (&first, vp, vm_cont);
-
-      if (first)
-        {
-          RESET_FRAME (2);
-
-          SP_SET (1, SP_REF (0));
-          SP_SET (0, cont);
+      uint32_t dst, nargs;
 
-          if (SCM_LIKELY (SCM_PROGRAM_P (SP_REF (1))))
-            ip = SCM_PROGRAM_CODE (SP_REF (1));
-          else
-            ip = (scm_t_uint32 *) vm_apply_non_program_code;
-
-          APPLY_HOOK ();
+      UNPACK_24 (op, dst);
+      nargs = FRAME_LOCALS_COUNT ();
 
-          NEXT (0);
+      if (nargs <= dst)
+        {
+          VM_ASSERT (nargs == dst, abort ());
+          ALLOC_FRAME (dst + 1);
+          SP_SET (0, SCM_EOL);
         }
       else
         {
-          CACHE_REGISTER ();
-          ABORT_CONTINUATION_HOOK ();
-          NEXT (0);
+          SYNC_IP ();
+          SCM rest = CALL_INTRINSIC (cons_rest, (thread, dst));
+          RESET_FRAME (dst + 1);
+          SP_SET (0, rest);
         }
-    }
 
-  /* abort _:24
-   *
-   * Abort to a prompt handler.  The tag is expected in r1, and the rest
-   * of the values in the frame are returned to the prompt handler.
-   * This corresponds to a tail application of abort-to-prompt.
-   */
-  VM_DEFINE_OP (16, abort, "abort", OP1 (X32))
-    {
-      scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
-
-      ASSERT (nlocals >= 2);
-      /* FIXME: Really we should capture the caller's registers.  Until
-         then, manually advance the IP so that when the prompt resumes,
-         it continues with the next instruction.  */
-      ip++;
-      SYNC_IP ();
-      vm_abort (vp, FP_REF (1), nlocals - 2, registers);
-
-      /* vm_abort should not return */
-      abort ();
+      NEXT (1);
     }
 
-  /* builtin-ref dst:12 idx:12
+  /* alloc-frame nlocals:24
    *
-   * Load a builtin stub by index into DST.
+   * Ensure that there is space on the stack for NLOCALS local variables.
    */
-  VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (X8_S12_C12) | OP_DST)
+  VM_DEFINE_OP (18, alloc_frame, "alloc-frame", OP1 (X8_C24))
     {
-      scm_t_uint16 dst, idx;
-
-      UNPACK_12_12 (op, dst, idx);
-      SP_SET (dst, scm_vm_builtin_ref (idx));
-
+      uint32_t nlocals;
+      UNPACK_24 (op, nlocals);
+      ALLOC_FRAME (nlocals);
       NEXT (1);
     }
 
-
-  
-
-  /*
-   * Function prologues
-   */
-
-  /* br-if-nargs-ne expected:24 _:8 offset:24
-   * br-if-nargs-lt expected:24 _:8 offset:24
-   * br-if-nargs-gt expected:24 _:8 offset:24
+  /* reset-frame nlocals:24
    *
-   * If the number of actual arguments is not equal, less than, or greater
-   * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
-   * the current instruction pointer.
+   * Like alloc-frame, but doesn't check that the stack is big enough.
+   * Used to reset the frame size to something less than the size that
+   * was previously set via alloc-frame.
    */
-  VM_DEFINE_OP (18, br_if_nargs_ne, "br-if-nargs-ne", OP2 (X8_C24, X8_L24))
-    {
-      BR_NARGS (!=);
-    }
-  VM_DEFINE_OP (19, br_if_nargs_lt, "br-if-nargs-lt", OP2 (X8_C24, X8_L24))
-    {
-      BR_NARGS (<);
-    }
-  VM_DEFINE_OP (20, br_if_nargs_gt, "br-if-nargs-gt", OP2 (X8_C24, X8_L24))
+  VM_DEFINE_OP (19, reset_frame, "reset-frame", OP1 (X8_C24))
     {
-      BR_NARGS (>);
+      uint32_t nlocals;
+      UNPACK_24 (op, nlocals);
+      RESET_FRAME (nlocals);
+      NEXT (1);
     }
 
-  /* assert-nargs-ee expected:24
-   * assert-nargs-ge expected:24
-   * assert-nargs-le expected:24
+  /* mov dst:12 src:12
    *
-   * If the number of actual arguments is not ==, >=, or <= EXPECTED,
-   * respectively, signal an error.
+   * Copy a value from one local slot to another.
    */
-  VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24))
-    {
-      scm_t_uint32 expected;
-      UNPACK_24 (op, expected);
-      VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
-                 vm_error_wrong_num_args (FP_REF (0)));
-      NEXT (1);
-    }
-  VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24))
+  VM_DEFINE_OP (20, mov, "mov", DOP1 (X8_S12_S12))
     {
-      scm_t_uint32 expected;
-      UNPACK_24 (op, expected);
-      VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
-                 vm_error_wrong_num_args (FP_REF (0)));
-      NEXT (1);
-    }
-  VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24))
-    {
-      scm_t_uint32 expected;
-      UNPACK_24 (op, expected);
-      VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
-                 vm_error_wrong_num_args (FP_REF (0)));
+      uint16_t dst;
+      uint16_t src;
+
+      UNPACK_12_12 (op, dst, src);
+      /* FIXME: The compiler currently emits "mov" for SCM, F64, U64,
+         and S64 variables.  However SCM values are the usual case, and
+         on a 32-bit machine it might be cheaper to move a SCM than to
+         move a 64-bit number.  */
+      SP_SET_SLOT (dst, SP_REF_SLOT (src));
+
       NEXT (1);
     }
 
-  /* alloc-frame nlocals:24
+  /* long-mov dst:24 _:8 src:24
    *
-   * Ensure that there is space on the stack for NLOCALS local variables,
-   * setting them all to SCM_UNDEFINED, except those nargs values that
-   * were passed as arguments and procedure.
+   * Copy a value from one local slot to another.
    */
-  VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (X8_C24))
+  VM_DEFINE_OP (21, long_mov, "long-mov", DOP2 (X8_S24, X8_S24))
     {
-      scm_t_uint32 nlocals, nargs;
-      UNPACK_24 (op, nlocals);
+      uint32_t dst;
+      uint32_t src;
 
-      nargs = FRAME_LOCALS_COUNT ();
-      ALLOC_FRAME (nlocals);
-      while (nlocals-- > nargs)
-        FP_SET (nlocals, SCM_UNDEFINED);
+      UNPACK_24 (op, dst);
+      UNPACK_24 (ip[1], src);
+      /* FIXME: The compiler currently emits "long-mov" for SCM, F64,
+         U64, and S64 variables.  However SCM values are the usual case,
+         and on a 32-bit machine it might be cheaper to move a SCM than
+         to move a 64-bit number.  */
+      SP_SET_SLOT (dst, SP_REF_SLOT (src));
 
-      NEXT (1);
+      NEXT (2);
     }
 
-  /* reset-frame nlocals:24
+  /* long-fmov dst:24 _:8 src:24
    *
-   * Like alloc-frame, but doesn't check that the stack is big enough.
-   * Used to reset the frame size to something less than the size that
-   * was previously set via alloc-frame.
+   * Copy a value from one local slot to another.  Slot indexes are
+   * relative to the FP.
    */
-  VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (X8_C24))
+  VM_DEFINE_OP (22, long_fmov, "long-fmov", DOP2 (X8_F24, X8_F24))
     {
-      scm_t_uint32 nlocals;
-      UNPACK_24 (op, nlocals);
-      RESET_FRAME (nlocals);
-      NEXT (1);
+      uint32_t dst;
+      uint32_t src;
+
+      UNPACK_24 (op, dst);
+      UNPACK_24 (ip[1], src);
+      FP_SET (dst, FP_REF (src));
+
+      NEXT (2);
     }
 
   /* push src:24
    *
    * Push SRC onto the stack.
    */
-  VM_DEFINE_OP (26, push, "push", OP1 (X8_S24))
+  VM_DEFINE_OP (23, push, "push", OP1 (X8_S24))
     {
-      scm_t_uint32 src;
+      uint32_t src;
       union scm_vm_stack_element val;
 
       /* FIXME: The compiler currently emits "push" for SCM, F64, U64,
@@ -1140,9 +898,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    *
    * Pop the stack, storing to DST.
    */
-  VM_DEFINE_OP (27, pop, "pop", OP1 (X8_S24) | OP_DST)
+  VM_DEFINE_OP (24, pop, "pop", DOP1 (X8_S24))
     {
-      scm_t_uint32 dst;
+      uint32_t dst;
       union scm_vm_stack_element val;
 
       /* FIXME: The compiler currently emits "pop" for SCM, F64, U64,
@@ -1151,7 +909,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
          move a 64-bit number.  */
       UNPACK_24 (op, dst);
       val = SP_REF_SLOT (0);
-      vp->sp = sp = sp + 1;
+      VP->sp = sp = sp + 1;
       SP_SET_SLOT (dst, val);
       NEXT (1);
     }
@@ -1160,550 +918,744 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    *
    * Drop some number of values from the stack.
    */
-  VM_DEFINE_OP (28, drop, "drop", OP1 (X8_C24))
+  VM_DEFINE_OP (25, drop, "drop", OP1 (X8_C24))
     {
-      scm_t_uint32 count;
+      uint32_t count;
 
       UNPACK_24 (op, count);
-      vp->sp = sp = sp + count;
+      VP->sp = sp = sp + count;
       NEXT (1);
     }
 
-  /* assert-nargs-ee/locals expected:12 nlocals:12
+  /* shuffle-down from:12 to:12
    *
-   * Equivalent to a sequence of assert-nargs-ee and reserve-locals.  The
-   * number of locals reserved is EXPECTED + NLOCALS.
+   * Shuffle down values from FROM to TO, reducing the frame size by
+   * (FROM-TO) slots.  Part of the internal implementation of
+   * call-with-values, values, and apply.
    */
-  VM_DEFINE_OP (29, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12))
+  VM_DEFINE_OP (26, shuffle_down, "shuffle-down", OP1 (X8_F12_F12))
     {
-      scm_t_uint16 expected, nlocals;
-      UNPACK_12_12 (op, expected, nlocals);
-      VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
-                 vm_error_wrong_num_args (FP_REF (0)));
-      ALLOC_FRAME (expected + nlocals);
-      while (nlocals--)
-        SP_SET (nlocals, SCM_UNDEFINED);
+      uint32_t n, from, to, nlocals;
+
+      UNPACK_12_12 (op, from, to);
+
+      VM_ASSERT (from > to, abort ());
+      nlocals = FRAME_LOCALS_COUNT ();
+
+      for (n = 0; from + n < nlocals; n++)
+        FP_SET (to + n, FP_REF (from + n));
+
+      RESET_FRAME (to + n);
 
       NEXT (1);
     }
 
-  /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
+  /* expand-apply-argument _:24
    *
-   * Find the first positional argument after NREQ.  If it is greater
-   * than NPOS, jump to OFFSET.
+   * Take the last local in a frame and expand it out onto the stack, as
+   * for the last argument to "apply".
+   */
+  VM_DEFINE_OP (27, expand_apply_argument, "expand-apply-argument", OP1 (X32))
+    {
+      SYNC_IP ();
+      CALL_INTRINSIC (expand_apply_argument, (thread));
+      CACHE_SP ();
+
+      NEXT (1);
+    }
+
+  /* subr-call idx:24
    *
-   * This instruction is only emitted for functions with multiple
-   * clauses, and an earlier clause has keywords and no rest arguments.
-   * See "Case-lambda" in the manual, for more on how case-lambda
-   * chooses the clause to apply.
+   * Call a subr, passing all locals in this frame as arguments, and
+   * storing the results on the stack, ready to be returned.  This
+   * instruction is part of the trampolines created in gsubr.c, and is
+   * not generated by the compiler.
    */
-  VM_DEFINE_OP (30, br_if_npos_gt, "br-if-npos-gt", OP3 (X8_C24, X8_C24, X8_L24))
+  VM_DEFINE_OP (28, subr_call, "subr-call", OP1 (X8_C24))
     {
-      scm_t_uint32 nreq, npos;
+      SCM ret;
+      uint32_t idx;
 
-      UNPACK_24 (op, nreq);
-      UNPACK_24 (ip[1], npos);
+      UNPACK_24 (op, idx);
+
+      SYNC_IP ();
+      ret = scm_apply_subr (sp, idx, FRAME_LOCALS_COUNT ());
 
-      /* We can only have too many positionals if there are more
-         arguments than NPOS.  */
-      if (FRAME_LOCALS_COUNT() > npos)
+      if (SCM_UNLIKELY (scm_is_values (ret)))
         {
-          scm_t_uint32 n;
-          for (n = nreq; n < npos; n++)
-            if (scm_is_keyword (FP_REF (n)))
-              break;
-          if (n == npos && !scm_is_keyword (FP_REF (n)))
-            {
-              scm_t_int32 offset = ip[2];
-              offset >>= 8; /* Sign-extending shift. */
-              NEXT (offset);
-            }
+          CALL_INTRINSIC (unpack_values_object, (thread, ret));
+          CACHE_SP ();
+          NEXT (1);
+        }
+      else
+        {
+          RESET_FRAME (1);
+          SP_SET (0, ret);
+          NEXT (1);
         }
-      NEXT (3);
     }
 
-  /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
-   *
-   * flags := allow-other-keys:1 has-rest:1 _:6
-   *
-   * Find the last positional argument, and shuffle all the rest above
-   * NTOTAL.  Initialize the intervening locals to SCM_UNDEFINED.  Then
-   * load the constant at KW-OFFSET words from the current IP, and use it
-   * to bind keyword arguments.  If HAS-REST, collect all shuffled
-   * arguments into a list, and store it in NREQ-AND-OPT.  Finally, clear
-   * the arguments that we shuffled up.
+  /* foreign-call cif-idx:12 ptr-idx:12
    *
-   * A macro-mega-instruction.
+   * Call a foreign function.  Fetch the CIF and foreign pointer from
+   * the CIF-IDX and PTR-IDX closure slots of the callee.  Arguments are
+   * taken from the stack, and results placed on the stack, ready to be
+   * returned.  This instruction is part of the trampolines created by
+   * the FFI, and is not generated by the compiler.
    */
-  VM_DEFINE_OP (31, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32))
+  VM_DEFINE_OP (29, foreign_call, "foreign-call", OP1 (X8_C12_C12))
     {
-      scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
-      scm_t_int32 kw_offset;
-      scm_t_bits kw_bits;
-      SCM kw;
-      char allow_other_keys, has_rest;
+      uint16_t cif_idx, ptr_idx;
+      SCM closure, cif, pointer;
 
-      UNPACK_24 (op, nreq);
-      allow_other_keys = ip[1] & 0x1;
-      has_rest = ip[1] & 0x2;
-      UNPACK_24 (ip[1], nreq_and_opt);
-      UNPACK_24 (ip[2], ntotal);
-      kw_offset = ip[3];
-      kw_bits = (scm_t_bits) (ip + kw_offset);
-      VM_ASSERT (!(kw_bits & 0x7), abort());
-      kw = SCM_PACK (kw_bits);
+      UNPACK_12_12 (op, cif_idx, ptr_idx);
 
-      nargs = FRAME_LOCALS_COUNT ();
+      closure = FP_REF (0);
+      cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
+      pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
 
-      /* look in optionals for first keyword or last positional */
-      /* starting after the last required positional arg */
-      npositional = nreq;
-      while (/* while we have args */
-             npositional < nargs
-             /* and we still have positionals to fill */
-             && npositional < nreq_and_opt
-             /* and we haven't reached a keyword yet */
-             && !scm_is_keyword (FP_REF (npositional)))
-        /* bind this optional arg (by leaving it in place) */
-        npositional++;
-      nkw = nargs - npositional;
-      /* shuffle non-positional arguments above ntotal */
-      ALLOC_FRAME (ntotal + nkw);
-      n = nkw;
-      while (n--)
-        FP_SET (ntotal + n, FP_REF (npositional + n));
-      /* and fill optionals & keyword args with SCM_UNDEFINED */
-      n = npositional;
-      while (n < ntotal)
-        FP_SET (n++, SCM_UNDEFINED);
-
-      /* Now bind keywords, in the order given.  */
-      for (n = 0; n < nkw; n++)
-        if (scm_is_keyword (FP_REF (ntotal + n)))
-          {
-            SCM walk;
-            for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk))
-              if (scm_is_eq (SCM_CAAR (walk), FP_REF (ntotal + n)))
-                {
-                  SCM si = SCM_CDAR (walk);
-                  if (n + 1 < nkw)
-                    {
-                      FP_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si),
-                              FP_REF (ntotal + n + 1));
-                    }
-                  else
-                    vm_error_kwargs_missing_value (FP_REF (0),
-                                                   FP_REF (ntotal + n));
-                  break;
-                }
-            VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
-                       vm_error_kwargs_unrecognized_keyword (FP_REF (0),
-                                                             FP_REF (ntotal + n)));
-            n++;
-          }
-        else
-          VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (FP_REF (0),
-                                                                FP_REF (ntotal + n)));
+      SYNC_IP ();
+      CALL_INTRINSIC (foreign_call, (thread, cif, pointer));
+      CACHE_SP ();
 
-      if (has_rest)
-        {
-          SCM rest = SCM_EOL;
-          n = nkw;
-          SYNC_IP ();
-          while (n--)
-            rest = scm_inline_cons (thread, FP_REF (ntotal + n), rest);
-          FP_SET (nreq_and_opt, rest);
-        }
+      NEXT (1);
+    }
 
-      RESET_FRAME (ntotal);
+  /* continuation-call contregs:24
+   *
+   * Return to a continuation, nonlocally.  The arguments to the
+   * continuation are taken from the stack.  CONTREGS is a free variable
+   * containing the reified continuation.  This instruction is part of
+   * the implementation of undelimited continuations, and is not
+   * generated by the compiler.
+   */
+  VM_DEFINE_OP (30, continuation_call, "continuation-call", OP1 (X8_C24))
+    {
+      SCM contregs;
+      uint32_t contregs_idx;
 
-      NEXT (4);
+      UNPACK_24 (op, contregs_idx);
+
+      contregs =
+        SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx);
+
+      SYNC_IP ();
+      CALL_INTRINSIC (reinstate_continuation_x, (thread, contregs));
+
+      /* no NEXT */
+      abort ();
     }
 
-  /* bind-rest dst:24
+  /* compose-continuation cont:24
    *
-   * Collect any arguments at or above DST into a list, and store that
-   * list at DST.
+   * Compose a partial continuation with the current continuation.  The
+   * arguments to the continuation are taken from the stack.  CONT is a
+   * free variable containing the reified continuation.  This
+   * instruction is part of the implementation of partial continuations,
+   * and is not generated by the compiler.
    */
-  VM_DEFINE_OP (32, bind_rest, "bind-rest", OP1 (X8_F24) | OP_DST)
+  VM_DEFINE_OP (31, compose_continuation, "compose-continuation", OP1 (X8_C24))
     {
-      scm_t_uint32 dst, nargs;
-      SCM rest = SCM_EOL;
+      SCM vmcont;
+      uint32_t cont_idx;
+      uint8_t *mcode;
 
-      UNPACK_24 (op, dst);
-      nargs = FRAME_LOCALS_COUNT ();
+      UNPACK_24 (op, cont_idx);
+      vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx);
 
-      if (nargs <= dst)
+      SYNC_IP ();
+      mcode = CALL_INTRINSIC (compose_continuation, (thread, vmcont));
+
+#if ENABLE_JIT
+      if (mcode && !VP->disable_mcode)
         {
-          ALLOC_FRAME (dst + 1);
-          while (nargs < dst)
-            FP_SET (nargs++, SCM_UNDEFINED);
+          scm_jit_enter_mcode (thread, mcode);
+          CACHE_REGISTER ();
+          NEXT (0);
         }
       else
+#endif
         {
-          SYNC_IP ();
+          CACHE_REGISTER ();
+          NEXT (0);
+        }
+    }
 
-          while (nargs-- > dst)
-            {
-              rest = scm_inline_cons (thread, FP_REF (nargs), rest);
-              FP_SET (nargs, SCM_UNDEFINED);
-            }
+  /* capture-continuation dst:24
+   *
+   * Capture the current continuation.  This instruction is part of the
+   * implementation of `call/cc', and is not generated by the compiler.
+   */
+  VM_DEFINE_OP (32, capture_continuation, "capture-continuation", DOP1 (X8_S24))
+    {
+      uint32_t dst;
 
-          RESET_FRAME (dst + 1);
-        }
+      UNPACK_24 (op, dst);
 
-      FP_SET (dst, rest);
+      SYNC_IP ();
+      SP_SET (dst, CALL_INTRINSIC (capture_continuation, (thread)));
 
       NEXT (1);
     }
 
-
-  
-
-  /*
-   * Branching instructions
-   */
-
-  /* br offset:24
+  /* abort _:24
    *
-   * Add OFFSET, a signed 24-bit number, to the current instruction
-   * pointer.
+   * Abort to a prompt handler.  The tag is expected in r1, and the rest
+   * of the values in the frame are returned to the prompt handler.
+   * This corresponds to a tail application of abort-to-prompt.
    */
-  VM_DEFINE_OP (33, br, "br", OP1 (X8_L24))
+  VM_DEFINE_OP (33, abort, "abort", OP1 (X32))
     {
-      scm_t_int32 offset = op;
-      offset >>= 8; /* Sign-extending shift. */
-      NEXT (offset);
+      uint8_t *mcode = NULL;
+
+      /* FIXME: Really we should capture the caller's registers.  Until
+         then, manually advance the IP so that when the prompt resumes,
+         it continues with the next instruction.  */
+      ip++;
+      SYNC_IP ();
+      mcode = CALL_INTRINSIC (abort_to_prompt, (thread, mcode));
+
+      /* If abort_to_prompt returned, that means there were no
+         intervening C frames to jump over, so we just continue
+         directly.  */
+
+      CACHE_REGISTER ();
+      ABORT_HOOK ();
+
+#if ENABLE_JIT
+      if (mcode && !VP->disable_mcode)
+        {
+          scm_jit_enter_mcode (thread, mcode);
+          CACHE_REGISTER ();
+        }
+#endif
+
+      NEXT (0);
     }
 
-  /* br-if-true test:24 invert:1 _:7 offset:24
+  /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
    *
-   * If the value in TEST is true for the purposes of Scheme, add
-   * OFFSET, a signed 24-bit number, to the current instruction pointer.
+   * Push a new prompt on the dynamic stack, with a tag from TAG and a
+   * handler at HANDLER-OFFSET words from the current IP.  The handler
+   * will expect a multiple-value return as if from a call with the
+   * procedure at PROC-SLOT.
    */
-  VM_DEFINE_OP (34, br_if_true, "br-if-true", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (34, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24))
     {
-      BR_UNARY (x, scm_is_true (x));
+      uint32_t tag, proc_slot;
+      int32_t offset;
+      uint8_t escape_only_p;
+      uint8_t *mra = NULL;
+
+      UNPACK_24 (op, tag);
+      escape_only_p = ip[1] & 0x1;
+      UNPACK_24 (ip[1], proc_slot);
+      offset = ip[2];
+      offset >>= 8; /* Sign extension */
+  
+      /* Push the prompt onto the dynamic stack. */
+      SYNC_IP ();
+      CALL_INTRINSIC (push_prompt, (thread, escape_only_p, SP_REF (tag),
+                                    VP->fp - proc_slot, ip + offset, mra));
+
+      NEXT (3);
     }
 
-  /* br-if-null test:24 invert:1 _:7 offset:24
+  /* builtin-ref dst:12 idx:12
    *
-   * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Load a builtin stub by index into DST.
    */
-  VM_DEFINE_OP (35, br_if_null, "br-if-null", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (35, builtin_ref, "builtin-ref", DOP1 (X8_S12_C12))
     {
-      BR_UNARY (x, scm_is_null (x));
+      uint16_t dst, idx;
+
+      UNPACK_12_12 (op, dst, idx);
+      SP_SET (dst, scm_vm_builtin_ref (idx));
+
+      NEXT (1);
     }
 
-  /* br-if-nil test:24 invert:1 _:7 offset:24
+  /* throw key:12 args:12
    *
-   * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
-   * number, to the current instruction pointer.
+   * Throw to KEY and ARGS.  ARGS should be a list.
    */
-  VM_DEFINE_OP (36, br_if_nil, "br-if-nil", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (36, throw, "throw", OP1 (X8_S12_S12))
     {
-      BR_UNARY (x, scm_is_lisp_false (x));
+      uint16_t a, b;
+      SCM key, args;
+
+      UNPACK_12_12 (op, a, b);
+
+      key = SP_REF (a);
+      args = SP_REF (b);
+
+      SYNC_IP ();
+      CALL_INTRINSIC (throw_, (key, args));
+
+      abort (); /* never reached */
     }
 
-  /* br-if-pair test:24 invert:1 _:7 offset:24
+  /* throw/value val:24 key-subr-and-message:32
    *
-   * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
-   * to the current instruction pointer.
+   * Raise an error, indicating VAL as the bad value.
+   * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is
+   * the symbol to which to throw, the second is the procedure in which
+   * to signal the error (a string) or #f, and the third is a format
+   * string for the message, with one template.
    */
-  VM_DEFINE_OP (37, br_if_pair, "br-if-pair", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (37, throw_value, "throw/value", OP2 (X8_S24, N32))
     {
-      BR_UNARY (x, scm_is_pair (x));
+      uint32_t a;
+      int32_t offset;
+      scm_t_bits key_subr_and_message_bits;
+      SCM val, key_subr_and_message;
+
+      UNPACK_24 (op, a);
+      val = SP_REF (a);
+
+      offset = ip[1];
+      key_subr_and_message_bits = (scm_t_bits) (ip + offset);
+      VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort());
+      key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
+
+      SYNC_IP ();
+      CALL_INTRINSIC (throw_with_value, (val, key_subr_and_message));
+
+      abort (); /* never reached */
     }
 
-  /* br-if-struct test:24 invert:1 _:7 offset:24
+  /* throw/value+data val:24 key-subr-and-message:32
    *
-   * If the value in TEST is a struct, add OFFSET, a signed 24-bit
-   * number, to the current instruction pointer.
+   * Raise an error, indicating VAL as the bad value.
+   * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is
+   * the symbol to which to throw, the second is the procedure in which
+   * to signal the error (a string) or #f, and the third is a format
+   * string for the message, with one template.
    */
-  VM_DEFINE_OP (38, br_if_struct, "br-if-struct", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (38, throw_value_and_data, "throw/value+data", OP2 (X8_S24, N32))
     {
-      BR_UNARY (x, SCM_STRUCTP (x));
+      uint32_t a;
+      int32_t offset;
+      scm_t_bits key_subr_and_message_bits;
+      SCM val, key_subr_and_message;
+
+      UNPACK_24 (op, a);
+      val = SP_REF (a);
+
+      offset = ip[1];
+      key_subr_and_message_bits = (scm_t_bits) (ip + offset);
+      VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort());
+      key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
+
+      SYNC_IP ();
+      CALL_INTRINSIC (throw_with_value_and_data, (val, key_subr_and_message));
+
+      abort (); /* never reached */
     }
 
-  /* br-if-char test:24 invert:1 _:7 offset:24
+  /* handle-interrupts _:24
    *
-   * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
-   * to the current instruction pointer.
+   * Handle pending interrupts.
    */
-  VM_DEFINE_OP (39, br_if_char, "br-if-char", OP2 (X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (39, handle_interrupts, "handle-interrupts", OP1 (X32))
     {
-      BR_UNARY (x, SCM_CHARP (x));
+      if (SCM_LIKELY (scm_is_null
+                      (scm_atomic_ref_scm (&thread->pending_asyncs))))
+        NEXT (1);
+
+      if (thread->block_asyncs > 0)
+        NEXT (1);
+
+      SYNC_IP ();
+      CALL_INTRINSIC (push_interrupt_frame, (thread, 0));
+      CACHE_SP ();
+      ip = scm_vm_intrinsics.handle_interrupt_code;
+
+      NEXT (0);
     }
 
-  /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
+  /* return-from-interrupt _:24
    *
-   * If the value in TEST has the TC7 given in the second word, add
-   * OFFSET, a signed 24-bit number, to the current instruction pointer.
+   * Return from handling an interrupt, discarding any return values and
+   * stripping away the interrupt frame.
    */
-  VM_DEFINE_OP (40, br_if_tc7, "br-if-tc7", OP2 (X8_S24, B1_C7_L24))
+  VM_DEFINE_OP (40, return_from_interrupt, "return-from-interrupt", OP1 (X32))
     {
-      BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
+      union scm_vm_stack_element *fp = VP->fp;
+
+      ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp);
+      VP->fp = SCM_FRAME_DYNAMIC_LINK (fp);
+      VP->sp = sp = SCM_FRAME_PREVIOUS_SP (fp);
+
+      NEXT (0);
     }
 
-  /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
+  /* call-thread _:24 IDX:32
    *
-   * If the value in A is eq? to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Call the void-returning instrinsic with index IDX, passing the
+   * current scm_thread* as the argument.
    */
-  VM_DEFINE_OP (41, br_if_eq, "br-if-eq", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (41, call_thread, "call-thread", OP2 (X32, C32))
     {
-      BR_BINARY (x, y, scm_is_eq (x, y));
+      scm_t_thread_intrinsic intrinsic;
+
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      intrinsic (thread);
+      CACHE_SP ();
+
+      NEXT (2);
     }
 
-  /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
+  /* call-thread-scm a:24 IDX:32
    *
-   * If the value in A is eqv? to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Call the void-returning instrinsic with index IDX, passing the
+   * current scm_thread* and the SCM local A as arguments.
    */
-  VM_DEFINE_OP (42, br_if_eqv, "br-if-eqv", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (42, call_thread_scm, "call-thread-scm", OP2 (X8_S24, C32))
     {
-      BR_BINARY (x, y,
-                 scm_is_eq (x, y)
-                 || (SCM_NIMP (x) && SCM_NIMP (y)
-                     && scm_is_true (scm_eqv_p (x, y))));
-    }
+      uint32_t a;
+      scm_t_thread_scm_intrinsic intrinsic;
 
-  VM_DEFINE_OP (43, unused_43, NULL, NOP)
-    {
-      abort ();
+      UNPACK_24 (op, a);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      intrinsic (thread, SP_REF (a));
+      CACHE_SP ();
+
+      NEXT (2);
     }
 
-  /* br-if-logtest a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* call-thread-scm-scm a:12 b:12 IDX:32
    *
-   * If the exact integer in A has any bits in common with the exact
-   * integer in B, add OFFSET, a signed 24-bit number, to the current
-   * instruction pointer.
+   * Call the void-returning instrinsic with index IDX, passing the
+   * current scm_thread* and the SCM locals A and B as arguments.
    */
-  VM_DEFINE_OP (44, br_if_logtest, "br-if-logtest", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (43, call_thread_scm_scm, "call-thread-scm-scm", OP2 (X8_S12_S12, C32))
     {
+      uint16_t a, b;
+      scm_t_thread_scm_scm_intrinsic intrinsic;
+
+      UNPACK_12_12 (op, a, b);
+      intrinsic = intrinsics[ip[1]];
+
       SYNC_IP ();
-      {
-        BR_BINARY (x, y,
-                   ((SCM_I_INUMP (x) && SCM_I_INUMP (y))
-                    ? (SCM_UNPACK (x) & SCM_UNPACK (y) & ~scm_tc2_int)
-                    : scm_is_true (scm_logtest (x, y))));
-      }
+      intrinsic (thread, SP_REF (a), SP_REF (b));
+      CACHE_SP ();
+
+      NEXT (2);
     }
 
-  /* br-if-= a:12 b:12 invert:1 _:7 offset:24
+  /* call-scm-sz-u32 a:8 b:8 c:8 IDX:32
    *
-   * If the value in A is = to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Call the void-returning instrinsic with index IDX, passing the
+   * locals A, B, and C as arguments.  A is a SCM value, while B and C
+   * are raw u64 values which fit into size_t and uint32_t types,
+   * respectively.
    */
-  VM_DEFINE_OP (45, br_if_ee, "br-if-=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (44, call_scm_sz_u32, "call-scm-sz-u32", OP2 (X8_S8_S8_S8, C32))
     {
-      BR_ARITHMETIC (==, scm_num_eq_p);
+      uint8_t a, b, c;
+      scm_t_scm_sz_u32_intrinsic intrinsic;
+
+      UNPACK_8_8_8 (op, a, b, c);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      intrinsic (SP_REF (a), SP_REF_U64 (b), SP_REF_U64 (c));
+      CACHE_SP ();
+
+      NEXT (2);
     }
 
-  /* br-if-< a:12 b:12 invert:1 _:7 offset:24
+  /* call-scm<-thread dst:24 IDX:32
    *
-   * If the value in A is < to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Call the SCM-returning instrinsic with index IDX, passing the
+   * current scm_thread* as argument.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (46, br_if_lt, "br-if-<", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (45, call_scm_from_thread, "call-scm<-thread", DOP2 (X8_S24, C32))
     {
-      BR_ARITHMETIC (<, scm_less_p);
+      uint32_t dst;
+      scm_t_scm_from_thread_intrinsic intrinsic;
+      SCM res;
+
+      UNPACK_24 (op, dst);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (thread);
+      CACHE_SP ();
+
+      SP_SET (dst, res);
+
+      NEXT (2);
     }
 
-  /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
+  /* call-s64<-scm dst:12 a:12 IDX:32
    *
-   * If the value in A is <= to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Call the int64_t-returning instrinsic with index IDX, passing the
+   * SCM local A as argument.  Place the s64 result in DST.
    */
-  VM_DEFINE_OP (47, br_if_le, "br-if-<=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (46, call_s64_from_scm, "call-s64<-scm", DOP2 (X8_S12_S12, C32))
     {
-      BR_ARITHMETIC (<=, scm_leq_p);
-    }
+      uint16_t dst, src;
+      scm_t_s64_from_scm_intrinsic intrinsic;
 
+      UNPACK_12_12 (op, dst, src);
+      intrinsic = intrinsics[ip[1]];
 
-  
+      SYNC_IP ();
+#if INDIRECT_INT64_INTRINSICS
+      intrinsic (& SP_REF_S64 (dst), SP_REF (src));
+#else
+      {
+        int64_t res = intrinsic (SP_REF (src));
+        SP_SET_S64 (dst, res);
+      }
+#endif
 
-  /*
-   * Lexical binding instructions
-   */
+      /* No CACHE_SP () after the intrinsic, as the indirect variants
+         have an out argument that points at the stack; stack relocation
+         during this kind of intrinsic is not supported!  */
 
-  /* mov dst:12 src:12
+      NEXT (2);
+    }
+
+  /* call-scm<-u64 dst:12 a:12 IDX:32
    *
-   * Copy a value from one local slot to another.
+   * Call the SCM-returning instrinsic with index IDX, passing the
+   * uint64_t local A as argument.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (48, mov, "mov", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (47, call_scm_from_u64, "call-scm<-u64", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint16 dst;
-      scm_t_uint16 src;
+      uint16_t dst, src;
+      SCM res;
+      scm_t_scm_from_u64_intrinsic intrinsic;
 
       UNPACK_12_12 (op, dst, src);
-      /* FIXME: The compiler currently emits "mov" for SCM, F64, U64,
-         and S64 variables.  However SCM values are the usual case, and
-         on a 32-bit machine it might be cheaper to move a SCM than to
-         move a 64-bit number.  */
-      SP_SET_SLOT (dst, SP_REF_SLOT (src));
+      intrinsic = intrinsics[ip[1]];
 
-      NEXT (1);
+      SYNC_IP ();
+#if INDIRECT_INT64_INTRINSICS
+      res = intrinsic (& SP_REF_U64 (src));
+#else
+      res = intrinsic (SP_REF_U64 (src));
+#endif
+      SP_SET (dst, res);
+
+      /* No CACHE_SP () after the intrinsic, as the indirect variants
+         pass stack pointers directly; stack relocation during this kind
+         of intrinsic is not supported!  */
+
+      NEXT (2);
     }
 
-  /* long-mov dst:24 _:8 src:24
+  /* call-scm<-s64 dst:12 a:12 IDX:32
    *
-   * Copy a value from one local slot to another.
+   * Call the SCM-returning instrinsic with index IDX, passing the
+   * int64_t local A as argument.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (49, long_mov, "long-mov", OP2 (X8_S24, X8_S24) | OP_DST)
+  VM_DEFINE_OP (48, call_scm_from_s64, "call-scm<-s64", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint32 dst;
-      scm_t_uint32 src;
+      uint16_t dst, src;
+      SCM res;
+      scm_t_scm_from_s64_intrinsic intrinsic;
 
-      UNPACK_24 (op, dst);
-      UNPACK_24 (ip[1], src);
-      /* FIXME: The compiler currently emits "long-mov" for SCM, F64,
-         U64, and S64 variables.  However SCM values are the usual case,
-         and on a 32-bit machine it might be cheaper to move a SCM than
-         to move a 64-bit number.  */
-      SP_SET_SLOT (dst, SP_REF_SLOT (src));
+      UNPACK_12_12 (op, dst, src);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+#if INDIRECT_INT64_INTRINSICS
+      res = intrinsic (& SP_REF_S64 (src));
+#else
+      res = intrinsic (SP_REF_S64 (src));
+#endif
+      CACHE_SP ();
+      SP_SET (dst, res);
 
       NEXT (2);
     }
 
-  /* long-fmov dst:24 _:8 src:24
+  /* call-scm<-scm dst:12 a:12 IDX:32
    *
-   * Copy a value from one local slot to another.  Slot indexes are
-   * relative to the FP.
+   * Call the SCM-returning instrinsic with index IDX, passing the SCM
+   * local A as argument.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (50, long_fmov, "long-fmov", OP2 (X8_F24, X8_F24) | OP_DST)
+  VM_DEFINE_OP (49, call_scm_from_scm, "call-scm<-scm", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint32 dst;
-      scm_t_uint32 src;
+      uint16_t dst, src;
+      SCM res;
+      scm_t_scm_from_scm_intrinsic intrinsic;
 
-      UNPACK_24 (op, dst);
-      UNPACK_24 (ip[1], src);
-      FP_SET (dst, FP_REF (src));
+      UNPACK_12_12 (op, dst, src);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (SP_REF (src));
+      CACHE_SP ();
+      SP_SET (dst, res);
 
       NEXT (2);
     }
 
-  /* box dst:12 src:12
+  /* call-f64<-scm dst:12 a:12 IDX:32
    *
-   * Create a new variable holding SRC, and place it in DST.
+   * Call the double-returning instrinsic with index IDX, passing the
+   * SCM local A as argument.  Place the f64 result in DST.
    */
-  VM_DEFINE_OP (51, box, "box", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (50, call_f64_from_scm, "call-f64<-scm", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint16 dst, src;
+      uint16_t dst, src;
+      double res;
+      scm_t_f64_from_scm_intrinsic intrinsic;
+
       UNPACK_12_12 (op, dst, src);
+      intrinsic = intrinsics[ip[1]];
+
       SYNC_IP ();
-      SP_SET (dst, scm_inline_cell (thread, scm_tc7_variable,
-                                       SCM_UNPACK (SP_REF (src))));
-      NEXT (1);
+      res = intrinsic (SP_REF (src));
+      CACHE_SP ();
+      SP_SET_F64 (dst, res);
+
+      NEXT (2);
     }
 
-  /* box-ref dst:12 src:12
+  /* call-u64<-scm dst:12 a:12 IDX:32
    *
-   * Unpack the variable at SRC into DST, asserting that the variable is
-   * actually bound.
+   * Call the uint64_t-returning instrinsic with index IDX, passing the
+   * SCM local A as argument.  Place the u64 result in DST.
    */
-  VM_DEFINE_OP (52, box_ref, "box-ref", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (51, call_u64_from_scm, "call-u64<-scm", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint16 dst, src;
-      SCM var;
+      uint16_t dst, src;
+      scm_t_u64_from_scm_intrinsic intrinsic;
+
       UNPACK_12_12 (op, dst, src);
-      var = SP_REF (src);
-      VM_VALIDATE_VARIABLE (var, "variable-ref");
-      VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var));
-      SP_SET (dst, VARIABLE_REF (var));
-      NEXT (1);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+#if INDIRECT_INT64_INTRINSICS
+      intrinsic (& SP_REF_U64 (dst), SP_REF (src));
+#else
+      {
+        uint64_t res = intrinsic (SP_REF (src));
+        SP_SET_U64 (dst, res);
+      }
+#endif
+
+      /* No CACHE_SP () after the intrinsic, as the indirect variants
+         have an out argument that points at the stack; stack relocation
+         during this kind of intrinsic is not supported!  */
+
+      NEXT (2);
     }
 
-  /* box-set! dst:12 src:12
+  /* call-scm<-scm-scm dst:8 a:8 b:8 IDX:32
    *
-   * Set the contents of the variable at DST to SET.
+   * Call the SCM-returning instrinsic with index IDX, passing the SCM
+   * locals A and B as arguments.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (53, box_set, "box-set!", OP1 (X8_S12_S12))
+  VM_DEFINE_OP (52, call_scm_from_scm_scm, "call-scm<-scm-scm", DOP2 (X8_S8_S8_S8, C32))
     {
-      scm_t_uint16 dst, src;
-      SCM var;
-      UNPACK_12_12 (op, dst, src);
-      var = SP_REF (dst);
-      VM_VALIDATE_VARIABLE (var, "variable-set!");
-      VARIABLE_SET (var, SP_REF (src));
-      NEXT (1);
+      uint8_t dst, a, b;
+      SCM res;
+      scm_t_scm_from_scm_scm_intrinsic intrinsic;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (SP_REF (a), SP_REF (b));
+      CACHE_SP ();
+      SP_SET (dst, res);
+
+      NEXT (2);
     }
 
-  /* make-closure dst:24 offset:32 _:8 nfree:24
+  /* call-scm<-scm-uimm dst:8 a:8 b:8 IDX:32
    *
-   * Make a new closure, and write it to DST.  The code for the closure
-   * will be found at OFFSET words from the current IP.  OFFSET is a
-   * signed 32-bit integer.  Space for NFREE free variables will be
-   * allocated.
+   * Call the SCM-returning instrinsic with index IDX, passing the SCM
+   * local A and the uint8_t immediate B as arguments.  Place the SCM
+   * result in DST.
    */
-  VM_DEFINE_OP (54, make_closure, "make-closure", OP3 (X8_S24, L32, X8_C24) | OP_DST)
+  VM_DEFINE_OP (53, call_scm_from_scm_uimm, "call-scm<-scm-uimm", DOP2 (X8_S8_S8_C8, C32))
     {
-      scm_t_uint32 dst, nfree, n;
-      scm_t_int32 offset;
-      SCM closure;
+      uint8_t dst, a, b;
+      SCM res;
+      scm_t_scm_from_scm_uimm_intrinsic intrinsic;
 
-      UNPACK_24 (op, dst);
-      offset = ip[1];
-      UNPACK_24 (ip[2], nfree);
+      UNPACK_8_8_8 (op, dst, a, b);
+      intrinsic = intrinsics[ip[1]];
 
-      // FIXME: Assert range of nfree?
       SYNC_IP ();
-      closure = scm_inline_words (thread, scm_tc7_program | (nfree << 16),
-                                  nfree + 2);
-      SCM_SET_CELL_WORD_1 (closure, ip + offset);
-      // FIXME: Elide these initializations?
-      for (n = 0; n < nfree; n++)
-        SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
-      SP_SET (dst, closure);
-      NEXT (3);
+      res = intrinsic (SP_REF (a), b);
+      CACHE_SP ();
+      SP_SET (dst, res);
+
+      NEXT (2);
     }
 
-  /* free-ref dst:12 src:12 _:8 idx:24
+  /* call-scm<-thread-scm dst:12 a:12 IDX:32
    *
-   * Load free variable IDX from the closure SRC into local slot DST.
+   * Call the SCM-returning instrinsic with index IDX, passing the
+   * current scm_thread* and SCM local A as arguments.  Place the SCM
+   * result in DST.
    */
-  VM_DEFINE_OP (55, free_ref, "free-ref", OP2 (X8_S12_S12, X8_C24) | OP_DST)
+  VM_DEFINE_OP (54, call_scm_from_thread_scm, "call-scm<-thread-scm", DOP2 (X8_S12_S12, C32))
     {
-      scm_t_uint16 dst, src;
-      scm_t_uint32 idx;
+      uint16_t dst, src;
+      scm_t_scm_from_thread_scm_intrinsic intrinsic;
+      SCM res;
+
       UNPACK_12_12 (op, dst, src);
-      UNPACK_24 (ip[1], idx);
-      /* CHECK_FREE_VARIABLE (src); */
-      SP_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (SP_REF (src), idx));
+      intrinsic = intrinsics[ip[1]];
+
+      SYNC_IP ();
+      res = intrinsic (thread, SP_REF (src));
+      CACHE_SP ();
+
+      SP_SET (dst, res);
+
       NEXT (2);
     }
 
-  /* free-set! dst:12 src:12 _:8 idx:24
+  /* call-scm<-scm-u64 dst:8 a:8 b:8 IDX:32
    *
-   * Set free variable IDX from the closure DST to SRC.
+   * Call the SCM-returning instrinsic with index IDX, passing SCM local
+   * A and u64 local B as arguments.  Place the SCM result in DST.
    */
-  VM_DEFINE_OP (56, free_set, "free-set!", OP2 (X8_S12_S12, X8_C24))
+  VM_DEFINE_OP (55, call_scm_from_scm_u64, "call-scm<-scm-u64", DOP2 (X8_S8_S8_S8, C32))
     {
-      scm_t_uint16 dst, src;
-      scm_t_uint32 idx;
-      UNPACK_12_12 (op, dst, src);
-      UNPACK_24 (ip[1], idx);
-      /* CHECK_FREE_VARIABLE (src); */
-      SCM_PROGRAM_FREE_VARIABLE_SET (SP_REF (dst), idx, SP_REF (src));
-      NEXT (2);
-    }
+      uint8_t dst, a, b;
+      SCM res;
+      scm_t_scm_from_scm_u64_intrinsic intrinsic;
 
+      UNPACK_8_8_8 (op, dst, a, b);
+      intrinsic = intrinsics[ip[1]];
 
-  
+      SYNC_IP ();
+#if INDIRECT_INT64_INTRINSICS
+      res = intrinsic (SP_REF (a), & SP_REF_U64 (b));
+#else
+      res = intrinsic (SP_REF (a), SP_REF_U64 (b));
+#endif
+      CACHE_SP ();
 
-  /*
-   * Immediates and statically allocated non-immediates
-   */
+      SP_SET (dst, res);
+
+      NEXT (2);
+    }
 
   /* make-short-immediate dst:8 low-bits:16
    *
    * Make an immediate whose low bits are LOW-BITS, and whose top bits are
    * 0.
    */
-  VM_DEFINE_OP (57, make_short_immediate, "make-short-immediate", OP1 (X8_S8_I16) | OP_DST)
+  VM_DEFINE_OP (56, make_short_immediate, "make-short-immediate", DOP1 (X8_S8_I16))
     {
-      scm_t_uint8 dst;
+      uint8_t dst;
       scm_t_bits val;
 
       UNPACK_8_16 (op, dst, val);
@@ -1716,9 +1668,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Make an immediate whose low bits are LOW-BITS, and whose top bits are
    * 0.
    */
-  VM_DEFINE_OP (58, make_long_immediate, "make-long-immediate", OP2 (X8_S24, I32) | OP_DST)
+  VM_DEFINE_OP (57, make_long_immediate, "make-long-immediate", DOP2 (X8_S24, I32))
     {
-      scm_t_uint32 dst;
+      uint32_t dst;
       scm_t_bits val;
 
       UNPACK_24 (op, dst);
@@ -1731,13 +1683,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    *
    * Make an immediate with HIGH-BITS and LOW-BITS.
    */
-  VM_DEFINE_OP (59, make_long_long_immediate, "make-long-long-immediate", OP3 (X8_S24, A32, B32) | OP_DST)
+  VM_DEFINE_OP (58, make_long_long_immediate, "make-long-long-immediate", DOP3 (X8_S24, A32, B32))
     {
-      scm_t_uint32 dst;
+      uint32_t dst;
       scm_t_bits val;
 
       UNPACK_24 (op, dst);
-#if SIZEOF_SCM_T_BITS > 4
+#if SIZEOF_UINTPTR_T > 4
       val = ip[1];
       val <<= 32;
       val |= ip[2];
@@ -1762,11 +1714,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Whether the object is mutable or immutable depends on where it was
    * allocated by the compiler, and loaded by the loader.
    */
-  VM_DEFINE_OP (60, make_non_immediate, "make-non-immediate", OP2 (X8_S24, N32) | OP_DST)
+  VM_DEFINE_OP (59, make_non_immediate, "make-non-immediate", DOP2 (X8_S24, N32))
     {
-      scm_t_uint32 dst;
-      scm_t_int32 offset;
-      scm_t_uint32* loc;
+      uint32_t dst;
+      int32_t offset;
+      uint32_t* loc;
       scm_t_bits unpacked;
 
       UNPACK_24 (op, dst);
@@ -1781,1374 +1733,786 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       NEXT (2);
     }
 
-  /* static-ref dst:24 offset:32
-   *
-   * Load a SCM value into DST.  The SCM value will be fetched from
-   * memory, OFFSET 32-bit words away from the current instruction
-   * pointer.  OFFSET is a signed value.
+  /* load-label dst:24 offset:32
    *
-   * The intention is for this instruction to be used to load constants
-   * that the compiler is unable to statically allocate, like symbols.
-   * These values would be initialized when the object file loads.
+   * Load a label OFFSET words away from the current IP and write it to
+   * DST.  OFFSET is a signed 32-bit integer.
    */
-  VM_DEFINE_OP (61, static_ref, "static-ref", OP2 (X8_S24, R32) | OP_DST)
+  VM_DEFINE_OP (60, load_label, "load-label", DOP2 (X8_S24, L32))
     {
-      scm_t_uint32 dst;
-      scm_t_int32 offset;
-      scm_t_uint32* loc;
-      scm_t_uintptr loc_bits;
+      uint32_t dst;
+      int32_t offset;
 
       UNPACK_24 (op, dst);
       offset = ip[1];
-      loc = ip + offset;
-      loc_bits = (scm_t_uintptr) loc;
-      VM_ASSERT (ALIGNED_P (loc, SCM), abort());
 
-      SP_SET (dst, *((SCM *) loc_bits));
+      SP_SET_U64 (dst, (uintptr_t) (ip + offset));
 
       NEXT (2);
     }
 
-  /* static-set! src:24 offset:32
+  /* load-f64 dst:24 high-bits:32 low-bits:32
    *
-   * Store a SCM value into memory, OFFSET 32-bit words away from the
-   * current instruction pointer.  OFFSET is a signed value.
+   * Make a double-precision floating-point value with HIGH-BITS and
+   * LOW-BITS.
    */
-  VM_DEFINE_OP (62, static_set, "static-set!", OP2 (X8_S24, LO32))
+  VM_DEFINE_OP (61, load_f64, "load-f64", DOP3 (X8_S24, AF32, BF32))
     {
-      scm_t_uint32 src;
-      scm_t_int32 offset;
-      scm_t_uint32* loc;
+      uint32_t dst;
+      uint64_t val;
 
-      UNPACK_24 (op, src);
-      offset = ip[1];
-      loc = ip + offset;
-      VM_ASSERT (ALIGNED_P (loc, SCM), abort());
-
-      *((SCM *) loc) = SP_REF (src);
-
-      NEXT (2);
+      UNPACK_24 (op, dst);
+      val = ip[1];
+      val <<= 32;
+      val |= ip[2];
+      SP_SET_U64 (dst, val);
+      NEXT (3);
     }
 
-  /* static-patch! _:24 dst-offset:32 src-offset:32
+  /* load-u64 dst:24 high-bits:32 low-bits:32
    *
-   * Patch a pointer at DST-OFFSET to point to SRC-OFFSET.  Both offsets
-   * are signed 32-bit values, indicating a memory address as a number
-   * of 32-bit words away from the current instruction pointer.
+   * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
    */
-  VM_DEFINE_OP (63, static_patch, "static-patch!", OP3 (X32, LO32, L32))
+  VM_DEFINE_OP (62, load_u64, "load-u64", DOP3 (X8_S24, AU32, BU32))
     {
-      scm_t_int32 dst_offset, src_offset;
-      void *src;
-      void** dst_loc;
-
-      dst_offset = ip[1];
-      src_offset = ip[2];
-
-      dst_loc = (void **) (ip + dst_offset);
-      src = ip + src_offset;
-      VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
-
-      *dst_loc = src;
+      uint32_t dst;
+      uint64_t val;
 
+      UNPACK_24 (op, dst);
+      val = ip[1];
+      val <<= 32;
+      val |= ip[2];
+      SP_SET_U64 (dst, val);
       NEXT (3);
     }
 
-  
-
-  /*
-   * Mutable top-level bindings
-   */
-
-  /* There are three slightly different ways to resolve toplevel
-     variables.
-
-     1. A toplevel reference outside of a function.  These need to be
-        looked up when the expression is evaluated -- no later, and no
-        before.  They are looked up relative to the module that is
-        current when the expression is evaluated.  For example:
-
-          (if (foo) a b)
-
-        The "resolve" instruction resolves the variable (box), and then
-        access is via box-ref or box-set!.
-
-     2. A toplevel reference inside a function.  These are looked up
-        relative to the module that was current when the function was
-        defined.  Unlike code at the toplevel, which is usually run only
-        once, these bindings benefit from memoized lookup, in which the
-        variable resulting from the lookup is cached in the function.
-
-          (lambda () (if (foo) a b))
-
-        The toplevel-box instruction is equivalent to "resolve", but
-        caches the resulting variable in statically allocated memory.
-
-     3. A reference to an identifier with respect to a particular
-        module.  This can happen for primitive references, and
-        references residualized by macro expansions.  These can always
-        be cached.  Use module-box for these.
-     */
-
-  /* current-module dst:24
+  /* load-s64 dst:24 high-bits:32 low-bits:32
    *
-   * Store the current module in DST.
+   * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
    */
-  VM_DEFINE_OP (64, current_module, "current-module", OP1 (X8_S24) | OP_DST)
+  VM_DEFINE_OP (63, load_s64, "load-s64", DOP3 (X8_S24, AS32, BS32))
     {
-      scm_t_uint32 dst;
+      uint32_t dst;
+      uint64_t val;
 
       UNPACK_24 (op, dst);
-
-      SYNC_IP ();
-      SP_SET (dst, scm_current_module ());
-
-      NEXT (1);
+      val = ip[1];
+      val <<= 32;
+      val |= ip[2];
+      SP_SET_U64 (dst, val);
+      NEXT (3);
     }
 
-  /* resolve dst:24 bound?:1 _:7 sym:24
+  /* current-thread dst:24
    *
-   * Resolve SYM in the current module, and place the resulting variable
-   * in DST.
+   * Write the current thread into DST.
    */
-  VM_DEFINE_OP (65, resolve, "resolve", OP2 (X8_S24, B1_X7_S24) | OP_DST)
+  VM_DEFINE_OP (64, current_thread, "current-thread", DOP1 (X8_S24))
     {
-      scm_t_uint32 dst;
-      scm_t_uint32 sym;
-      SCM var;
+      uint32_t dst;
 
       UNPACK_24 (op, dst);
-      UNPACK_24 (ip[1], sym);
-
-      SYNC_IP ();
-      var = scm_lookup (SP_REF (sym));
-      CACHE_SP ();
-      if (ip[1] & 0x1)
-        VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (SP_REF (sym)));
-      SP_SET (dst, var);
+      SP_SET (dst, thread->handle);
 
-      NEXT (2);
+      NEXT (1);
     }
 
-  /* define! dst:12 sym:12
+  /* allocate-words dst:12 count:12
    *
-   * Look up a binding for SYM in the current module, creating it if
-   * necessary.  Set its value to VAL.
+   * Allocate a fresh GC-traced object consisting of COUNT words and
+   * store it into DST.  COUNT is a u64 local.
    */
-  VM_DEFINE_OP (66, define, "define!", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (65, allocate_words, "allocate-words", DOP1 (X8_S12_S12))
     {
-      scm_t_uint16 dst, sym;
-      SCM var;
-      UNPACK_12_12 (op, dst, sym);
+      uint16_t dst, size;
+
+      UNPACK_12_12 (op, dst, size);
+
       SYNC_IP ();
-      var = scm_module_ensure_local_variable (scm_current_module (),
-                                              SP_REF (sym));
-      CACHE_SP ();
-      SP_SET (dst, var);
+      SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, SP_REF_U64 (size))));
       NEXT (1);
     }
 
-  /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
-   *
-   * Load a SCM value.  The SCM value will be fetched from memory,
-   * VAR-OFFSET 32-bit words away from the current instruction pointer.
-   * VAR-OFFSET is a signed value.  Up to here, toplevel-box is like
-   * static-ref.
-   *
-   * Then, if the loaded value is a variable, it is placed in DST, and control
-   * flow continues.
+  /* allocate-words/immediate dst:12 count:12
    *
-   * Otherwise, we have to resolve the variable.  In that case we load
-   * the module from MOD-OFFSET, just as we loaded the variable.
-   * Usually the module gets set when the closure is created.  The name
-   * is an offset to a symbol.
-   *
-   * We use the module and the symbol to resolve the variable, placing it in
-   * DST, and caching the resolved variable so that we will hit the cache next
-   * time.
+   * Allocate a fresh GC-traced object consisting of COUNT words and
+   * store it into DST.  COUNT is an immediate.
    */
-  VM_DEFINE_OP (67, toplevel_box, "toplevel-box", OP5 (X8_S24, R32, R32, N32, B1_X31) | OP_DST)
+  VM_DEFINE_OP (66, allocate_words_immediate, "allocate-words/immediate", DOP1 (X8_S12_C12))
     {
-      scm_t_uint32 dst;
-      scm_t_int32 var_offset;
-      scm_t_uint32* var_loc_u32;
-      SCM *var_loc;
-      SCM var;
+      uint16_t dst, size;
 
-      UNPACK_24 (op, dst);
-      var_offset = ip[1];
-      var_loc_u32 = ip + var_offset;
-      VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
-      var_loc = (SCM *) var_loc_u32;
-      var = *var_loc;
+      UNPACK_12_12 (op, dst, size);
 
-      if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
-        {
-          SCM mod, sym;
-          scm_t_int32 mod_offset = ip[2]; /* signed */
-          scm_t_int32 sym_offset = ip[3]; /* signed */
-          scm_t_uint32 *mod_loc = ip + mod_offset;
-          scm_t_uint32 *sym_loc = ip + sym_offset;
-          
-          SYNC_IP ();
-
-          VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort());
-          VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
-
-          mod = *((SCM *) mod_loc);
-          sym = *((SCM *) sym_loc);
-
-          /* If the toplevel scope was captured before modules were
-             booted, use the root module.  */
-          if (scm_is_false (mod))
-            mod = scm_the_root_module ();
-
-          var = scm_module_lookup (mod, sym);
-          CACHE_SP ();
-          if (ip[4] & 0x1)
-            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
-
-          *var_loc = var;
-        }
+      SYNC_IP ();
+      SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, size)));
 
-      SP_SET (dst, var);
-      NEXT (5);
+      NEXT (1);
     }
 
-  /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
+  /* scm-ref dst:8 obj:8 idx:8
    *
-   * Like toplevel-box, except MOD-OFFSET points at the name of a module
-   * instead of the module itself.
+   * Load the SCM object at word offset IDX from local OBJ, and store it
+   * to DST.
    */
-  VM_DEFINE_OP (68, module_box, "module-box", OP5 (X8_S24, R32, N32, N32, B1_X31) | OP_DST)
+  VM_DEFINE_OP (67, scm_ref, "scm-ref", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint32 dst;
-      scm_t_int32 var_offset;
-      scm_t_uint32* var_loc_u32;
-      SCM *var_loc;
-      SCM var;
-
-      UNPACK_24 (op, dst);
-      var_offset = ip[1];
-      var_loc_u32 = ip + var_offset;
-      VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
-      var_loc = (SCM *) var_loc_u32;
-      var = *var_loc;
+      uint8_t dst, obj, idx;
 
-      if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
-        {
-          SCM modname, sym;
-          scm_t_int32 modname_offset = ip[2]; /* signed */
-          scm_t_int32 sym_offset = ip[3]; /* signed */
-          scm_t_uint32 *modname_words = ip + modname_offset;
-          scm_t_uint32 *sym_loc = ip + sym_offset;
-
-          SYNC_IP ();
+      UNPACK_8_8_8 (op, dst, obj, idx);
 
-          VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort());
-          VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
+      SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx)));
 
-          modname = SCM_PACK ((scm_t_bits) modname_words);
-          sym = *((SCM *) sym_loc);
-
-          if (!scm_module_system_booted_p)
-            {
-              ASSERT (scm_is_true
-                      scm_equal_p (modname,
-                                   scm_list_2
-                                   (SCM_BOOL_T,
-                                    scm_from_utf8_symbol ("guile"))));
-              var = scm_lookup (sym);
-            }
-          else if (scm_is_true (SCM_CAR (modname)))
-            var = scm_public_lookup (SCM_CDR (modname), sym);
-          else
-            var = scm_private_lookup (SCM_CDR (modname), sym);
-
-          CACHE_SP ();
-
-          if (ip[4] & 0x1)
-            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
-
-          *var_loc = var;
-        }
-
-      SP_SET (dst, var);
-      NEXT (5);
+      NEXT (1);
     }
 
-  
-
-  /*
-   * The dynamic environment
-   */
-
-  /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
+  /* scm-set! obj:8 idx:8 val:8
    *
-   * Push a new prompt on the dynamic stack, with a tag from TAG and a
-   * handler at HANDLER-OFFSET words from the current IP.  The handler
-   * will expect a multiple-value return as if from a call with the
-   * procedure at PROC-SLOT.
+   * Store the SCM local VAL into object OBJ at word offset IDX.
    */
-  VM_DEFINE_OP (69, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24))
+  VM_DEFINE_OP (68, scm_set, "scm-set!", OP1 (X8_S8_S8_S8))
     {
-      scm_t_uint32 tag, proc_slot;
-      scm_t_int32 offset;
-      scm_t_uint8 escape_only_p;
-      scm_t_dynstack_prompt_flags flags;
+      uint8_t obj, idx, val;
 
-      UNPACK_24 (op, tag);
-      escape_only_p = ip[1] & 0x1;
-      UNPACK_24 (ip[1], proc_slot);
-      offset = ip[2];
-      offset >>= 8; /* Sign extension */
-  
-      /* Push the prompt onto the dynamic stack. */
-      flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
-      SYNC_IP ();
-      scm_dynstack_push_prompt (&thread->dynstack, flags,
-                                SP_REF (tag),
-                                vp->stack_top - vp->fp,
-                                vp->stack_top - FP_SLOT (proc_slot),
-                                ip + offset,
-                                registers);
-      NEXT (3);
-    }
+      UNPACK_8_8_8 (op, obj, idx, val);
 
-  /* wind winder:12 unwinder:12
-   *
-   * Push wind and unwind procedures onto the dynamic stack. Note that
-   * neither are actually called; the compiler should emit calls to wind
-   * and unwind for the normal dynamic-wind control flow.  Also note that
-   * the compiler should have inserted checks that they wind and unwind
-   * procs are thunks, if it could not prove that to be the case.
-   */
-  VM_DEFINE_OP (70, wind, "wind", OP1 (X8_S12_S12))
-    {
-      scm_t_uint16 winder, unwinder;
-      UNPACK_12_12 (op, winder, unwinder);
-      SYNC_IP ();
-      scm_dynstack_push_dynwind (&thread->dynstack,
-                                 SP_REF (winder), SP_REF (unwinder));
-      NEXT (1);
-    }
+      SCM_SET_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx), SP_REF (val));
 
-  /* unwind _:24
-   *
-   * A normal exit from the dynamic extent of an expression. Pop the top
-   * entry off of the dynamic stack.
-   */
-  VM_DEFINE_OP (71, unwind, "unwind", OP1 (X32))
-    {
-      scm_dynstack_pop (&thread->dynstack);
       NEXT (1);
     }
 
-  /* push-fluid fluid:12 value:12
+  /* scm-ref/tag dst:8 obj:8 tag:8
    *
-   * Dynamically bind VALUE to FLUID.
+   * Load the first word of OBJ, subtract the immediate TAG, and store
+   * the resulting SCM to DST.
    */
-  VM_DEFINE_OP (72, push_fluid, "push-fluid", OP1 (X8_S12_S12))
+  VM_DEFINE_OP (69, scm_ref_tag, "scm-ref/tag", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint32 fluid, value;
+      uint8_t dst, obj, tag;
 
-      UNPACK_12_12 (op, fluid, value);
+      UNPACK_8_8_8 (op, dst, obj, tag);
 
-      SYNC_IP ();
-      scm_dynstack_push_fluid (&thread->dynstack,
-                               SP_REF (fluid), SP_REF (value),
-                               thread->dynamic_state);
-      NEXT (1);
-    }
+      SP_SET (dst, SCM_PACK (SCM_CELL_WORD_0 (SP_REF (obj)) - tag));
 
-  /* pop-fluid _:24
-   *
-   * Leave the dynamic extent of a with-fluid* expression, restoring the
-   * fluid to its previous value.
-   */
-  VM_DEFINE_OP (73, pop_fluid, "pop-fluid", OP1 (X32))
-    {
-      SYNC_IP ();
-      scm_dynstack_unwind_fluid (&thread->dynstack,
-                                 thread->dynamic_state);
       NEXT (1);
     }
 
-  /* fluid-ref dst:12 src:12
+  /* scm-set!/tag obj:8 tag:8 val:8
    *
-   * Reference the fluid in SRC, and place the value in DST.
+   * Set the first word of OBJ to the SCM value VAL plus the immediate
+   * value TAG.
    */
-  VM_DEFINE_OP (74, fluid_ref, "fluid-ref", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (70, scm_set_tag, "scm-set!/tag", OP1 (X8_S8_C8_S8))
     {
-      scm_t_uint16 dst, src;
-      SCM fluid;
-      struct scm_cache_entry *entry;
+      uint8_t obj, tag, val;
 
-      UNPACK_12_12 (op, dst, src);
-      fluid = SP_REF (src);
+      UNPACK_8_8_8 (op, obj, tag, val);
 
-      /* If we find FLUID in the cache, then it is indeed a fluid.  */
-      entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
-      if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)
-                      && !SCM_UNBNDP (SCM_PACK (entry->value))))
-        {
-          SP_SET (dst, SCM_PACK (entry->value));
-          NEXT (1);
-        }
-      else
-        {
-          SYNC_IP ();
-          SP_SET (dst, scm_fluid_ref (fluid));
-          NEXT (1);
-        }
+      SCM_SET_CELL_WORD_0 (SP_REF (obj), SCM_UNPACK (SP_REF (val)) + tag);
+
+      NEXT (1);
     }
 
-  /* fluid-set fluid:12 val:12
+  /* scm-ref/immediate dst:8 obj:8 idx:8
    *
-   * Set the value of the fluid in DST to the value in SRC.
+   * Load the SCM object at word offset IDX from local OBJ, and store it
+   * to DST.  IDX is a uint8_t immediate.
    */
-  VM_DEFINE_OP (75, fluid_set, "fluid-set!", OP1 (X8_S12_S12))
+  VM_DEFINE_OP (71, scm_ref_immediate, "scm-ref/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint16 a, b;
-      SCM fluid, value;
-      struct scm_cache_entry *entry;
-
-      UNPACK_12_12 (op, a, b);
-      fluid = SP_REF (a);
-      value = SP_REF (b);
-
-      /* If we find FLUID in the cache, then it is indeed a fluid.  */
-      entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
-      if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)))
-        {
-          entry->value = SCM_UNPACK (value);
-          NEXT (1);
-        }
-      else
-        {
-          SYNC_IP ();
-          scm_fluid_set_x (fluid, value);
-          NEXT (1);
-        }
-    }
+      uint8_t dst, obj, idx;
 
+      UNPACK_8_8_8 (op, dst, obj, idx);
 
-  
+      SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), idx));
 
-  /*
-   * Strings, symbols, and keywords
-   */
-
-  /* string-length dst:12 src:12
-   *
-   * Store the length of the string in SRC in DST.
-   */
-  VM_DEFINE_OP (76, string_length, "string-length", OP1 (X8_S12_S12) | OP_DST)
-    {
-      ARGS1 (str);
-      VM_VALIDATE_STRING (str, "string-length");
-      SP_SET_U64 (dst, scm_i_string_length (str));
       NEXT (1);
     }
 
-  /* string-ref dst:8 src:8 idx:8
+  /* scm-set!/immediate obj:8 idx:8 val:8
    *
-   * Fetch the character at position IDX in the string in SRC, and store
-   * it in DST.
+   * Store the SCM local VAL into object OBJ at word offset IDX.  IDX is
+   * a uint8_t immediate.
    */
-  VM_DEFINE_OP (77, string_ref, "string-ref", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (72, scm_set_immediate, "scm-set!/immediate", OP1 (X8_S8_C8_S8))
     {
-      scm_t_uint8 dst, src, idx;
-      SCM str;
-      scm_t_uint64 c_idx;
+      uint8_t obj, idx, val;
 
-      UNPACK_8_8_8 (op, dst, src, idx);
-      str = SP_REF (src);
-      c_idx = SP_REF_U64 (idx);
+      UNPACK_8_8_8 (op, obj, idx, val);
 
-      VM_VALIDATE_STRING (str, "string-ref");
-      VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref");
+      SCM_SET_CELL_OBJECT (SP_REF (obj), idx, SP_REF (val));
 
-      RETURN (scm_c_make_char (scm_i_string_ref (str, c_idx)));
+      NEXT (1);
     }
 
-  /* string-set! instruction is currently number 192.  Probably need to
-     reorder before releasing.  */
-
-  /* string->number dst:12 src:12
+  /* word-ref dst:8 obj:8 idx:8
    *
-   * Parse a string in SRC to a number, and store in DST.
+   * Load the word at offset IDX from local OBJ, and store it to u64
+   * DST.
    */
-  VM_DEFINE_OP (78, string_to_number, "string->number", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (73, word_ref, "word-ref", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint16 dst, src;
+      uint8_t dst, obj, idx;
 
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst,
-              scm_string_to_number (SP_REF (src),
-                                    SCM_UNDEFINED /* radix = 10 */));
-      NEXT (1);
-    }
+      UNPACK_8_8_8 (op, dst, obj, idx);
 
-  /* string->symbol dst:12 src:12
-   *
-   * Parse a string in SRC to a symbol, and store in DST.
-   */
-  VM_DEFINE_OP (79, string_to_symbol, "string->symbol", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
+      SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx)));
 
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst, scm_string_to_symbol (SP_REF (src)));
       NEXT (1);
     }
 
-  /* symbol->keyword dst:12 src:12
+  /* word-set! obj:8 idx:8 val:8
    *
-   * Make a keyword from the symbol in SRC, and store it in DST.
+   * Store the u64 local VAL into object OBJ at word offset IDX.
    */
-  VM_DEFINE_OP (80, symbol_to_keyword, "symbol->keyword", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (74, word_set, "word-set!", OP1 (X8_S8_S8_S8))
     {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst, scm_symbol_to_keyword (SP_REF (src)));
-      NEXT (1);
-    }
+      uint8_t obj, idx, val;
 
-  
+      UNPACK_8_8_8 (op, obj, idx, val);
 
-  /*
-   * Pairs
-   */
+      SCM_SET_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx), SP_REF_U64 (val));
 
-  /* cons dst:8 car:8 cdr:8
-   *
-   * Cons CAR and CDR, and store the result in DST.
-   */
-  VM_DEFINE_OP (81, cons, "cons", OP1 (X8_S8_S8_S8) | OP_DST)
-    {
-      ARGS2 (x, y);
-      SYNC_IP ();
-      RETURN (scm_inline_cons (thread, x, y));
+      NEXT (1);
     }
 
-  /* car dst:12 src:12
+  /* word-ref/immediate dst:8 obj:8 idx:8
    *
-   * Place the car of SRC in DST.
+   * Load the word at offset IDX from local OBJ, and store it to u64
+   * DST.  IDX is a uint8_t immediate.
    */
-  VM_DEFINE_OP (82, car, "car", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (75, word_ref_immediate, "word-ref/immediate", DOP1 (X8_S8_S8_C8))
     {
-      ARGS1 (x);
-      VM_VALIDATE_PAIR (x, "car");
-      RETURN (SCM_CAR (x));
-    }
+      uint8_t dst, obj, idx;
 
-  /* cdr dst:12 src:12
-   *
-   * Place the cdr of SRC in DST.
-   */
-  VM_DEFINE_OP (83, cdr, "cdr", OP1 (X8_S12_S12) | OP_DST)
-    {
-      ARGS1 (x);
-      VM_VALIDATE_PAIR (x, "cdr");
-      RETURN (SCM_CDR (x));
-    }
+      UNPACK_8_8_8 (op, dst, obj, idx);
+
+      SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), idx));
 
-  /* set-car! pair:12 car:12
-   *
-   * Set the car of DST to SRC.
-   */
-  VM_DEFINE_OP (84, set_car, "set-car!", OP1 (X8_S12_S12))
-    {
-      scm_t_uint16 a, b;
-      SCM x, y;
-      UNPACK_12_12 (op, a, b);
-      x = SP_REF (a);
-      y = SP_REF (b);
-      VM_VALIDATE_MUTABLE_PAIR (x, "set-car!");
-      SCM_SETCAR (x, y);
       NEXT (1);
     }
 
-  /* set-cdr! pair:12 cdr:12
+  /* word-set!/immediate obj:8 idx:8 val:8
    *
-   * Set the cdr of DST to SRC.
+   * Store the u64 local VAL into object OBJ at word offset IDX.  IDX is
+   * a uint8_t immediate.
    */
-  VM_DEFINE_OP (85, set_cdr, "set-cdr!", OP1 (X8_S12_S12))
+  VM_DEFINE_OP (76, word_set_immediate, "word-set!/immediate", OP1 (X8_S8_C8_S8))
     {
-      scm_t_uint16 a, b;
-      SCM x, y;
-      UNPACK_12_12 (op, a, b);
-      x = SP_REF (a);
-      y = SP_REF (b);
-      VM_VALIDATE_MUTABLE_PAIR (x, "set-cdr!");
-      SCM_SETCDR (x, y);
-      NEXT (1);
-    }
-
+      uint8_t obj, idx, val;
 
-  
+      UNPACK_8_8_8 (op, obj, idx, val);
 
-  /*
-   * Numeric operations
-   */
+      SCM_SET_CELL_WORD (SP_REF (obj), idx, SP_REF_U64 (val));
 
-  /* add dst:8 a:8 b:8
-   *
-   * Add A to B, and place the result in DST.
-   */
-  VM_DEFINE_OP (86, add, "add", OP1 (X8_S8_S8_S8) | OP_DST)
-    {
-      BINARY_INTEGER_OP (+, scm_sum);
+      NEXT (1);
     }
 
-  /* add/immediate dst:8 src:8 imm:8
+  /* pointer-ref/immediate dst:8 obj:8 idx:8
    *
-   * Add the unsigned 8-bit value IMM to the value from SRC, and place
-   * the result in DST.
+   * Load the pointer at offset IDX from local OBJ, and store it to DST.
+   * IDX is a uint8_t immediate.
    */
-  VM_DEFINE_OP (87, add_immediate, "add/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (77, pointer_ref_immediate, "pointer-ref/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint8 dst, src, imm;
-      SCM x;
+      uint8_t dst, obj, idx;
 
-      UNPACK_8_8_8 (op, dst, src, imm);
-      x = SP_REF (src);
-
-      if (SCM_LIKELY (SCM_I_INUMP (x)))
-        {
-          scm_t_signed_bits sum = SCM_I_INUM (x) + (scm_t_signed_bits) imm;
+      UNPACK_8_8_8 (op, dst, obj, idx);
 
-          if (SCM_LIKELY (SCM_POSFIXABLE (sum)))
-            RETURN (SCM_I_MAKINUM (sum));
-        }
+      SP_SET_PTR (dst, (void*) SCM_CELL_WORD (SP_REF (obj), idx));
 
-      RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (imm)));
+      NEXT (1);
     }
 
-  /* sub dst:8 a:8 b:8
+  /* pointer-set!/immediate obj:8 idx:8 val:8
    *
-   * Subtract B from A, and place the result in DST.
+   * Store the pointer local VAL into object OBJ at offset IDX.  IDX is
+   * a uint8_t immediate.
    */
-  VM_DEFINE_OP (88, sub, "sub", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (78, pointer_set_immediate, "pointer-set!/immediate", OP1 (X8_S8_C8_S8))
     {
-      BINARY_INTEGER_OP (-, scm_difference);
+      uint8_t obj, idx, val;
+
+      UNPACK_8_8_8 (op, obj, idx, val);
+
+      SCM_SET_CELL_WORD (SP_REF (obj), idx, (uintptr_t) SP_REF_PTR (val));
+
+      NEXT (1);
     }
 
-  /* sub/immediate dst:8 src:8 imm:8
+  /* tail-pointer-ref/immediate dst:8 obj:8 idx:8
    *
-   * Subtract the unsigned 8-bit value IMM from the value in SRC, and
-   * place the result in DST.
+   * Compute the address of word offset IDX from local OBJ, and store it
+   * to DST.  IDX is a uint8_t immediate.
    */
-  VM_DEFINE_OP (89, sub_immediate, "sub/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (79, tail_pointer_ref_immediate, "tail-pointer-ref/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint8 dst, src, imm;
-      SCM x;
+      uint8_t dst, obj, idx;
 
-      UNPACK_8_8_8 (op, dst, src, imm);
-      x = SP_REF (src);
-
-      if (SCM_LIKELY (SCM_I_INUMP (x)))
-        {
-          scm_t_signed_bits diff = SCM_I_INUM (x) - (scm_t_signed_bits) imm;
+      UNPACK_8_8_8 (op, dst, obj, idx);
 
-          if (SCM_LIKELY (SCM_NEGFIXABLE (diff)))
-            RETURN (SCM_I_MAKINUM (diff));
-        }
+      SP_SET_PTR (dst, ((scm_t_bits *) SCM2PTR (SP_REF (obj))) + idx);
 
-      RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (imm)));
+      NEXT (1);
     }
 
-  /* mul dst:8 a:8 b:8
+  /* atomic-scm-ref/immediate dst:8 obj:8 idx:8
    *
-   * Multiply A and B, and place the result in DST.
+   * Atomically reference the SCM object at word offset IDX from local
+   * OBJ, and store it to DST, using the sequential consistency memory
+   * model.  IDX is a uint8_t immediate.
    */
-  VM_DEFINE_OP (90, mul, "mul", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (80, atomic_scm_ref_immediate, "atomic-scm-ref/immediate", DOP1 (X8_S8_S8_C8))
     {
-      ARGS2 (x, y);
-      RETURN_EXP (scm_product (x, y));
+      uint8_t dst, obj, offset;
+      SCM *loc;
+      UNPACK_8_8_8 (op, dst, obj, offset);
+      loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
+      SP_SET (dst, scm_atomic_ref_scm (loc));
+      NEXT (1);
     }
 
-  /* div dst:8 a:8 b:8
+  /* atomic-scm-set!/immediate obj:8 idx:8 val:8
    *
-   * Divide A by B, and place the result in DST.
+   * Atomically store the SCM local VAL into object OBJ at word offset
+   * IDX, using the sequentially consistent memory model.  IDX is a
+   * uint8_t immediate.
    */
-  VM_DEFINE_OP (91, div, "div", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (81, atomic_scm_set_immediate, "atomic-scm-set!/immediate", OP1 (X8_S8_C8_S8))
     {
-      ARGS2 (x, y);
-      RETURN_EXP (scm_divide (x, y));
+      uint8_t obj, offset, val;
+      SCM *loc;
+      UNPACK_8_8_8 (op, obj, offset, val);
+      loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
+      scm_atomic_set_scm (loc, SP_REF (val));
+      NEXT (1);
     }
 
-  /* quo dst:8 a:8 b:8
+  /* atomic-scm-swap!/immediate dst:24 _:8 obj:24 idx:8 val:24
    *
-   * Divide A by B, and place the quotient in DST.
+   * Atomically swap the SCM value stored in object OBJ at word offset
+   * IDX with VAL, using the sequentially consistent memory model.  IDX
+   * is a uint8_t immediate.  Return the previous value to DST.
    */
-  VM_DEFINE_OP (92, quo, "quo", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (82, atomic_scm_swap_immediate, "atomic-scm-swap!/immediate", DOP3 (X8_S24, X8_S24, C8_S24))
     {
-      ARGS2 (x, y);
-      RETURN_EXP (scm_quotient (x, y));
+      uint32_t dst, obj, val;
+      uint8_t offset;
+      SCM *loc;
+      UNPACK_24 (op, dst);
+      UNPACK_24 (ip[1], obj);
+      UNPACK_8_24 (ip[2], offset, val);
+      loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
+      SP_SET (dst, scm_atomic_swap_scm (loc, SP_REF (val)));
+      NEXT (3);
     }
 
-  /* rem dst:8 a:8 b:8
+  /* atomic-scm-compare-and-swap!/immediate dst:24 _:8 obj:24 idx:8 expected:24 _:8 desired:24
    *
-   * Divide A by B, and place the remainder in DST.
+   * Atomically swap the SCM value stored in object OBJ at word offset
+   * IDX with DESIRED, if and only if the value that was there was
+   * EXPECTED, using the sequentially consistent memory model.  IDX is a
+   * uint8_t immediate.  Return the value that was stored at IDX from
+   * OBJ in DST.
    */
-  VM_DEFINE_OP (93, rem, "rem", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (83, atomic_scm_compare_and_swap_immediate, "atomic-scm-compare-and-swap!/immediate", DOP4 (X8_S24, X8_S24, C8_S24, X8_S24))
     {
-      ARGS2 (x, y);
-      RETURN_EXP (scm_remainder (x, y));
+      uint32_t dst, obj, expected, desired;
+      uint8_t offset;
+      SCM *loc;
+      SCM got;
+      UNPACK_24 (op, dst);
+      UNPACK_24 (ip[1], obj);
+      UNPACK_8_24 (ip[2], offset, expected);
+      UNPACK_24 (ip[3], desired);
+      loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
+      got = scm_atomic_compare_and_swap_scm (loc, SP_REF (expected),
+                                             SP_REF (desired));
+      SP_SET (dst, got);
+      NEXT (4);
     }
 
-  /* mod dst:8 a:8 b:8
+  /* static-ref dst:24 offset:32
    *
-   * Place the modulo of A by B in DST.
+   * Load a SCM value into DST.  The SCM value will be fetched from
+   * memory, OFFSET 32-bit words away from the current instruction
+   * pointer.  OFFSET is a signed value.
+   *
+   * The intention is for this instruction to be used to load constants
+   * that the compiler is unable to statically allocate, like symbols.
+   * These values would be initialized when the object file loads.
    */
-  VM_DEFINE_OP (94, mod, "mod", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (84, static_ref, "static-ref", DOP2 (X8_S24, R32))
     {
-      ARGS2 (x, y);
-      RETURN_EXP (scm_modulo (x, y));
+      uint32_t dst;
+      int32_t offset;
+      uint32_t* loc;
+      uintptr_t loc_bits;
+
+      UNPACK_24 (op, dst);
+      offset = ip[1];
+      loc = ip + offset;
+      loc_bits = (uintptr_t) loc;
+      VM_ASSERT (ALIGNED_P (loc, SCM), abort());
+
+      SP_SET (dst, *((SCM *) loc_bits));
+
+      NEXT (2);
     }
 
-  /* ash dst:8 a:8 b:8
+  /* static-set! src:24 offset:32
    *
-   * Shift A arithmetically by B bits, and place the result in DST.
+   * Store a SCM value into memory, OFFSET 32-bit words away from the
+   * current instruction pointer.  OFFSET is a signed value.
    */
-  VM_DEFINE_OP (95, ash, "ash", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (85, static_set, "static-set!", OP2 (X8_S24, LO32))
     {
-      ARGS2 (x, y);
-      if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
-        {
-          if (SCM_I_INUM (y) < 0)
-            /* Right shift, will be a fixnum. */
-            RETURN (SCM_I_MAKINUM
-                    (SCM_SRS (SCM_I_INUM (x),
-                              (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
-                              ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
-          else
-            /* Left shift. See comments in scm_ash. */
-            {
-              scm_t_signed_bits nn, bits_to_shift;
-
-              nn = SCM_I_INUM (x);
-              bits_to_shift = SCM_I_INUM (y);
-
-              if (bits_to_shift < SCM_I_FIXNUM_BIT-1
-                  && ((scm_t_bits)
-                      (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
-                      <= 1))
-                RETURN (SCM_I_MAKINUM (nn < 0
-                                       ? -(-nn << bits_to_shift)
-                                       : (nn << bits_to_shift)));
-              /* fall through */
-            }
-          /* fall through */
-        }
-      RETURN_EXP (scm_ash (x, y));
+      uint32_t src;
+      int32_t offset;
+      uint32_t* loc;
+
+      UNPACK_24 (op, src);
+      offset = ip[1];
+      loc = ip + offset;
+      VM_ASSERT (ALIGNED_P (loc, SCM), abort());
+
+      *((SCM *) loc) = SP_REF (src);
+
+      NEXT (2);
     }
 
-  /* logand dst:8 a:8 b:8
+  /* static-patch! _:24 dst-offset:32 src-offset:32
    *
-   * Place the bitwise AND of A and B into DST.
+   * Patch a pointer at DST-OFFSET to point to SRC-OFFSET.  Both offsets
+   * are signed 32-bit values, indicating a memory address as a number
+   * of 32-bit words away from the current instruction pointer.
    */
-  VM_DEFINE_OP (96, logand, "logand", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (86, static_patch, "static-patch!", OP3 (X32, LO32, L32))
     {
-      ARGS2 (x, y);
-      if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
-        /* Compute bitwise AND without untagging */
-        RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
-      RETURN_EXP (scm_logand (x, y));
+      int32_t dst_offset, src_offset;
+      void *src;
+      void** dst_loc;
+
+      dst_offset = ip[1];
+      src_offset = ip[2];
+
+      dst_loc = (void **) (ip + dst_offset);
+      src = ip + src_offset;
+      VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
+
+      *dst_loc = src;
+
+      NEXT (3);
     }
 
-  /* logior dst:8 a:8 b:8
+  /* tag-char dst:12 src:12
    *
-   * Place the bitwise inclusive OR of A with B in DST.
+   * Make a SCM character whose integer value is the u64 in SRC, and
+   * store it in DST.
    */
-  VM_DEFINE_OP (97, logior, "logior", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (87, tag_char, "tag-char", DOP1 (X8_S12_S12))
     {
-      ARGS2 (x, y);
-      if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
-        /* Compute bitwise OR without untagging */
-        RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
-      RETURN_EXP (scm_logior (x, y));
+      uint16_t dst, src;
+      UNPACK_12_12 (op, dst, src);
+      SP_SET (dst,
+              SCM_MAKE_ITAG8 ((scm_t_bits) (scm_t_wchar) SP_REF_U64 (src),
+                              scm_tc8_char));
+      NEXT (1);
     }
 
-  /* logxor dst:8 a:8 b:8
+  /* untag-char dst:12 src:12
    *
-   * Place the bitwise exclusive OR of A with B in DST.
+   * Extract the integer value from the SCM character SRC, and store the
+   * resulting u64 in DST.
    */
-  VM_DEFINE_OP (98, logxor, "logxor", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (88, untag_char, "untag-char", DOP1 (X8_S12_S12))
     {
-      ARGS2 (x, y);
-      if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
-        RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
-      RETURN_EXP (scm_logxor (x, y));
+      uint16_t dst, src;
+      UNPACK_12_12 (op, dst, src);
+      SP_SET_U64 (dst, SCM_CHAR (SP_REF (src)));
+      NEXT (1);
     }
 
-  /* make-vector dst:8 length:8 init:8
+  /* tag-fixnum dst:12 src:12
    *
-   * Make a vector and write it to DST.  The vector will have space for
-   * LENGTH slots.  They will be filled with the value in slot INIT.
+   * Make a SCM integer whose value is the s64 in SRC, and store it in
+   * DST.
    */
-  VM_DEFINE_OP (99, make_vector, "make-vector", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (89, tag_fixnum, "tag-fixnum", DOP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, length, init;
-      scm_t_uint64 length_val;
+      uint16_t dst, src;
 
-      UNPACK_8_8_8 (op, dst, length, init);
-      length_val = SP_REF_U64 (length);
-      VM_VALIDATE_INDEX (length_val, (size_t) -1, "make-vector");
+      UNPACK_12_12 (op, dst, src);
 
-      /* TODO: Inline this allocation.  */
-      SYNC_IP ();
-      SP_SET (dst, scm_c_make_vector (length_val, SP_REF (init)));
+      SP_SET (dst, SCM_I_MAKINUM (SP_REF_S64 (src)));
 
       NEXT (1);
     }
 
-  /* make-vector/immediate dst:8 length:8 init:8
+  /* untag-fixnum dst:12 src:12
    *
-   * Make a short vector of known size and write it to DST.  The vector
-   * will have space for LENGTH slots, an immediate value.  They will be
-   * filled with the value in slot INIT.
+   * Extract the integer value from the SCM integer SRC, and store the
+   * resulting s64 in DST.
    */
-  VM_DEFINE_OP (100, make_vector_immediate, "make-vector/immediate", OP1 (X8_S8_C8_S8) | OP_DST)
+  VM_DEFINE_OP (90, untag_fixnum, "untag-fixnum", DOP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, init;
-      scm_t_int32 length, n;
-      SCM val, vector;
+      uint16_t dst, src;
+
+      UNPACK_12_12 (op, dst, src);
 
-      UNPACK_8_8_8 (op, dst, length, init);
+      SP_SET_S64 (dst, SCM_I_INUM (SP_REF (src)));
 
-      val = SP_REF (init);
-      SYNC_IP ();
-      vector = scm_inline_words (thread, scm_tc7_vector | (length << 8),
-                                 length + 1);
-      for (n = 0; n < length; n++)
-        SCM_SIMPLE_VECTOR_SET (vector, n, val);
-      SP_SET (dst, vector);
       NEXT (1);
     }
 
-  /* vector-length dst:12 src:12
+  /* uadd dst:8 a:8 b:8
    *
-   * Store the length of the vector in SRC in DST.
+   * Add A to B, and place the result in DST.  The operands and the
+   * result are unboxed unsigned 64-bit integers.  Overflow will wrap
+   * around.
    */
-  VM_DEFINE_OP (101, vector_length, "vector-length", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (91, uadd, "uadd", DOP1 (X8_S8_S8_S8))
     {
-      ARGS1 (vect);
-      VM_VALIDATE_VECTOR (vect, "vector-length");
-      SP_SET_U64 (dst, SCM_I_VECTOR_LENGTH (vect));
+      uint8_t dst, a, b;
+      UNPACK_8_8_8 (op, dst, a, b);
+      SP_SET_U64 (dst, SP_REF_U64 (a) + SP_REF_U64 (b));
       NEXT (1);
     }
 
-  /* vector-ref dst:8 src:8 idx:8
+  /* usub dst:8 a:8 b:8
    *
-   * Fetch the item at position IDX in the vector in SRC, and store it
-   * in DST.
+   * Subtract B from A, and place the result in DST.  The operands and
+   * the result are unboxed unsigned 64-bit integers.  Overflow will
+   * wrap around.
    */
-  VM_DEFINE_OP (102, vector_ref, "vector-ref", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (92, usub, "usub", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, src, idx;
-      SCM vect;
-      scm_t_uint64 c_idx;
-
-      UNPACK_8_8_8 (op, dst, src, idx);
-      vect = SP_REF (src);
-      c_idx = SP_REF_U64 (idx);
-
-      VM_VALIDATE_VECTOR (vect, "vector-ref");
-      VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref");
-      RETURN (SCM_I_VECTOR_ELTS (vect)[c_idx]);
+      uint8_t dst, a, b;
+      UNPACK_8_8_8 (op, dst, a, b);
+      SP_SET_U64 (dst, SP_REF_U64 (a) - SP_REF_U64 (b));
+      NEXT (1);
     }
 
-  /* vector-ref/immediate dst:8 src:8 idx:8
+  /* umul dst:8 a:8 b:8
    *
-   * Fill DST with the item IDX elements into the vector at SRC.  Useful
-   * for building data types using vectors.
+   * Multiply A and B, and place the result in DST.  The operands and
+   * the result are unboxed unsigned 64-bit integers.  Overflow will
+   * wrap around.
    */
-  VM_DEFINE_OP (103, vector_ref_immediate, "vector-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (93, umul, "umul", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, src, idx;
-      SCM vect;
-      
-      UNPACK_8_8_8 (op, dst, src, idx);
-      vect = SP_REF (src);
-      VM_VALIDATE_VECTOR (vect, "vector-ref");
-      VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref");
-      SP_SET (dst, SCM_I_VECTOR_ELTS (vect)[idx]);
+      uint8_t dst, a, b;
+      UNPACK_8_8_8 (op, dst, a, b);
+      SP_SET_U64 (dst, SP_REF_U64 (a) * SP_REF_U64 (b));
       NEXT (1);
     }
 
-  /* vector-set! dst:8 idx:8 src:8
+  /* uadd/immediate dst:8 src:8 imm:8
    *
-   * Store SRC into the vector DST at index IDX.
+   * Add the unsigned 64-bit value from SRC with the unsigned 8-bit
+   * value IMM and place the raw unsigned 64-bit result in DST.
+   * Overflow will wrap around.
    */
-  VM_DEFINE_OP (104, vector_set, "vector-set!", OP1 (X8_S8_S8_S8))
+  VM_DEFINE_OP (94, uadd_immediate, "uadd/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint8 dst, idx, src;
-      SCM vect, val;
-      scm_t_uint64 c_idx;
-
-      UNPACK_8_8_8 (op, dst, idx, src);
-      vect = SP_REF (dst);
-      c_idx = SP_REF_U64 (idx);
-      val = SP_REF (src);
+      uint8_t dst, src, imm;
+      uint64_t x;
 
-      VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!");
-      VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
-      SCM_I_VECTOR_WELTS (vect)[c_idx] = val;
+      UNPACK_8_8_8 (op, dst, src, imm);
+      x = SP_REF_U64 (src);
+      SP_SET_U64 (dst, x + (uint64_t) imm);
       NEXT (1);
     }
 
-  /* vector-set!/immediate dst:8 idx:8 src:8
+  /* usub/immediate dst:8 src:8 imm:8
    *
-   * Store SRC into the vector DST at index IDX.  Here IDX is an
-   * immediate value.
+   * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit
+   * value in SRC and place the raw unsigned 64-bit result in DST.
+   * Overflow will wrap around.
    */
-  VM_DEFINE_OP (105, vector_set_immediate, "vector-set!/immediate", OP1 (X8_S8_C8_S8))
+  VM_DEFINE_OP (95, usub_immediate, "usub/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint8 dst, idx, src;
-      SCM vect, val;
-
-      UNPACK_8_8_8 (op, dst, idx, src);
-      vect = SP_REF (dst);
-      val = SP_REF (src);
+      uint8_t dst, src, imm;
+      uint64_t x;
 
-      VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!");
-      VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
-      SCM_I_VECTOR_WELTS (vect)[idx] = val;
+      UNPACK_8_8_8 (op, dst, src, imm);
+      x = SP_REF_U64 (src);
+      SP_SET_U64 (dst, x - (uint64_t) imm);
       NEXT (1);
     }
 
-
-  
-
-  /*
-   * Structs and GOOPS
-   */
-
-  /* struct-vtable dst:12 src:12
+  /* umul/immediate dst:8 src:8 imm:8
    *
-   * Store the vtable of SRC into DST.
+   * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit
+   * value IMM and place the raw unsigned 64-bit result in DST.
+   * Overflow will wrap around.
    */
-  VM_DEFINE_OP (106, struct_vtable, "struct-vtable", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (96, umul_immediate, "umul/immediate", DOP1 (X8_S8_S8_C8))
     {
-      ARGS1 (obj);
-      VM_VALIDATE_STRUCT (obj, "struct_vtable");
-      RETURN (SCM_STRUCT_VTABLE (obj));
+      uint8_t dst, src, imm;
+      uint64_t x;
+
+      UNPACK_8_8_8 (op, dst, src, imm);
+      x = SP_REF_U64 (src);
+      SP_SET_U64 (dst, x * (uint64_t) imm);
+      NEXT (1);
     }
 
-  /* allocate-struct dst:8 vtable:8 nfields:8
+  /* ulogand dst:8 a:8 b:8
    *
-   * Allocate a new struct with VTABLE, and place it in DST.  The struct
-   * will be constructed with space for NFIELDS fields, which should
-   * correspond to the field count of the VTABLE.
+   * Place the bitwise AND of the u64 values in A and B into DST.
    */
-  VM_DEFINE_OP (107, allocate_struct, "allocate-struct", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (97, ulogand, "ulogand", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, vtable, nfields;
-      SCM ret;
+      uint8_t dst, a, b;
 
-      UNPACK_8_8_8 (op, dst, vtable, nfields);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      /* TODO: Specify nfields as untagged value when calling
-         allocate-struct.  */
-      SYNC_IP ();
-      ret = scm_allocate_struct (SP_REF (vtable),
-                                 scm_from_uint64 (SP_REF_U64 (nfields)));
-      SP_SET (dst, ret);
+      SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b));
 
       NEXT (1);
     }
 
-  /* struct-ref dst:8 src:8 idx:8
+  /* ulogior dst:8 a:8 b:8
    *
-   * Fetch the item at slot IDX in the struct in SRC, and store it
-   * in DST.
+   * Place the bitwise inclusive OR of the u64 values in A and B into
+   * DST.
    */
-  VM_DEFINE_OP (108, struct_ref, "struct-ref", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (98, ulogior, "ulogior", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, src, idx;
-      SCM obj;
-      scm_t_uint64 index;
-
-      UNPACK_8_8_8 (op, dst, src, idx);
+      uint8_t dst, a, b;
 
-      obj = SP_REF (src);
-      index = SP_REF_U64 (idx);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      if (SCM_LIKELY (SCM_STRUCTP (obj)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE)
-                      && index < (SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
-                                                       scm_vtable_index_size))))
-        RETURN (SCM_STRUCT_SLOT_REF (obj, index));
+      SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b));
 
-      SYNC_IP ();
-      RETURN (scm_struct_ref (obj, scm_from_uint64 (index)));
+      NEXT (1);
     }
 
-  /* struct-set! dst:8 idx:8 src:8
+  /* ulogsub dst:8 a:8 b:8
    *
-   * Store SRC into the struct DST at slot IDX.
+   * Place the (A & ~B) of the u64 values A and B into DST.
    */
-  VM_DEFINE_OP (109, struct_set, "struct-set!", OP1 (X8_S8_S8_S8))
+  VM_DEFINE_OP (99, ulogsub, "ulogsub", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, idx, src;
-      SCM obj, val;
-      scm_t_uint64 index;
+      uint8_t dst, a, b;
 
-      UNPACK_8_8_8 (op, dst, idx, src);
-
-      obj = SP_REF (dst);
-      val = SP_REF (src);
-      index = SP_REF_U64 (idx);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      if (SCM_LIKELY (SCM_STRUCTP (obj)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE_RW)
-                      && index < (SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
-                                                       scm_vtable_index_size))))
-        {
-          SCM_STRUCT_SLOT_SET (obj, index, val);
-          NEXT (1);
-        }
+      SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b));
 
-      SYNC_IP ();
-      scm_struct_set_x (obj, scm_from_uint64 (index), val);
       NEXT (1);
     }
 
-  /* allocate-struct/immediate dst:8 vtable:8 nfields:8
+  /* ulogxor dst:8 a:8 b:8
    *
-   * Allocate a new struct with VTABLE, and place it in DST.  The struct
-   * will be constructed with space for NFIELDS fields, which should
-   * correspond to the field count of the VTABLE.
+   * Place the bitwise exclusive OR of the u64 values in A and B into
+   * DST.
    */
-  VM_DEFINE_OP (110, allocate_struct_immediate, "allocate-struct/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (100, ulogxor, "ulogxor", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, vtable, nfields;
-      SCM ret;
+      uint8_t dst, a, b;
 
-      UNPACK_8_8_8 (op, dst, vtable, nfields);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      SYNC_IP ();
-      ret = scm_allocate_struct (SP_REF (vtable), SCM_I_MAKINUM (nfields));
-      SP_SET (dst, ret);
+      SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b));
 
       NEXT (1);
     }
 
-  /* struct-ref/immediate dst:8 src:8 idx:8
+  /* ursh dst:8 a:8 b:8
    *
-   * Fetch the item at slot IDX in the struct in SRC, and store it
-   * in DST.  IDX is an immediate unsigned 8-bit value.
+   * Shift the u64 value in A right by B bits, and place the result in
+   * DST.  Only the lower 6 bits of B are used.
    */
-  VM_DEFINE_OP (111, struct_ref_immediate, "struct-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (101, ursh, "ursh", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, src, idx;
-      SCM obj;
-
-      UNPACK_8_8_8 (op, dst, src, idx);
+      uint8_t dst, a, b;
 
-      obj = SP_REF (src);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      if (SCM_LIKELY (SCM_STRUCTP (obj)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE)
-                      && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
-                                                    scm_vtable_index_size)))
-        RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
+      SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63));
 
-      SYNC_IP ();
-      RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
+      NEXT (1);
     }
 
-  /* struct-set!/immediate dst:8 idx:8 src:8
+  /* srsh dst:8 a:8 b:8
    *
-   * Store SRC into the struct DST at slot IDX.  IDX is an immediate
-   * unsigned 8-bit value.
+   * Shift the s64 value in A right by B bits, and place the result in
+   * DST.  Only the lower 6 bits of B are used.
    */
-  VM_DEFINE_OP (112, struct_set_immediate, "struct-set!/immediate", OP1 (X8_S8_C8_S8))
+  VM_DEFINE_OP (102, srsh, "srsh", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, idx, src;
-      SCM obj, val;
-
-      UNPACK_8_8_8 (op, dst, idx, src);
+      uint8_t dst, a, b;
 
-      obj = SP_REF (dst);
-      val = SP_REF (src);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-      if (SCM_LIKELY (SCM_STRUCTP (obj)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE)
-                      && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
-                                                        SCM_VTABLE_FLAG_SIMPLE_RW)
-                      && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
-                                                    scm_vtable_index_size)))
-        {
-          SCM_STRUCT_SLOT_SET (obj, idx, val);
-          NEXT (1);
-        }
+      SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), (SP_REF_U64 (b) & 63)));
 
-      SYNC_IP ();
-      scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
       NEXT (1);
     }
 
-  /* class-of dst:12 type:12
+  /* ulsh dst:8 a:8 b:8
    *
-   * Store the vtable of SRC into DST.
+   * Shift the u64 value in A left by B bits, and place the result in
+   * DST.  Only the lower 6 bits of B are used.
    */
-  VM_DEFINE_OP (113, class_of, "class-of", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (103, ulsh, "ulsh", DOP1 (X8_S8_S8_S8))
     {
-      ARGS1 (obj);
-      if (SCM_INSTANCEP (obj))
-        RETURN (SCM_CLASS_OF (obj));
-      RETURN_EXP (scm_class_of (obj));
-    }
-
-  
+      uint8_t dst, a, b;
 
-  /*
-   * Arrays, packed uniform arrays, and bytevectors.
-   */
+      UNPACK_8_8_8 (op, dst, a, b);
 
-  /* load-typed-array dst:24 _:8 type:24 _:8 shape:24 offset:32 len:32
-   *
-   * Load the contiguous typed array located at OFFSET 32-bit words away
-   * from the instruction pointer, and store into DST.  LEN is a byte
-   * length.  OFFSET is signed.
-   */
-  VM_DEFINE_OP (114, load_typed_array, "load-typed-array", OP5 (X8_S24, X8_S24, X8_S24, N32, C32) | OP_DST)
-    {
-      scm_t_uint32 dst, type, shape;
-      scm_t_int32 offset;
-      scm_t_uint32 len;
+      SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63));
 
-      UNPACK_24 (op, dst);
-      UNPACK_24 (ip[1], type);
-      UNPACK_24 (ip[2], shape);
-      offset = ip[3];
-      len = ip[4];
-      SYNC_IP ();
-      SP_SET (dst, scm_from_contiguous_typed_array (SP_REF (type),
-                                                       SP_REF (shape),
-                                                       ip + offset, len));
-      NEXT (5);
+      NEXT (1);
     }
 
-  /* make-array dst:24 _:8 type:24 _:8 fill:24 _:8 bounds:24
+  /* ursh/immediate dst:8 a:8 b:8
    *
-   * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
+   * Shift the u64 value in A right by the immediate B bits, and place
+   * the result in DST.  Only the lower 6 bits of B are used.
    */
-  VM_DEFINE_OP (115, make_array, "make-array", OP4 (X8_S24, X8_S24, X8_S24, X8_S24) | OP_DST)
+  VM_DEFINE_OP (104, ursh_immediate, "ursh/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint32 dst, type, fill, bounds;
-      UNPACK_24 (op, dst);
-      UNPACK_24 (ip[1], type);
-      UNPACK_24 (ip[2], fill);
-      UNPACK_24 (ip[3], bounds);
-      SYNC_IP ();
-      SP_SET (dst, scm_make_typed_array (SP_REF (type), SP_REF (fill),
-                                            SP_REF (bounds)));
-      NEXT (4);
-    }
-
-  /* bv-u8-ref dst:8 src:8 idx:8
-   * bv-s8-ref dst:8 src:8 idx:8
-   * bv-u16-ref dst:8 src:8 idx:8
-   * bv-s16-ref dst:8 src:8 idx:8
-   * bv-u32-ref dst:8 src:8 idx:8
-   * bv-s32-ref dst:8 src:8 idx:8
-   * bv-u64-ref dst:8 src:8 idx:8
-   * bv-s64-ref dst:8 src:8 idx:8
-   * bv-f32-ref dst:8 src:8 idx:8
-   * bv-f64-ref dst:8 src:8 idx:8
-   *
-   * Fetch the item at byte offset IDX in the bytevector SRC, and store
-   * it in DST.  All accesses use native endianness.
-   */
-#define BV_REF(stem, type, size, slot)                                  \
-  do {									\
-    type result;                                                        \
-    scm_t_uint8 dst, src, idx;                                          \
-    SCM bv;                                                             \
-    scm_t_uint64 c_idx;                                                 \
-    UNPACK_8_8_8 (op, dst, src, idx);                                   \
-    bv = SP_REF (src);                                                  \
-    c_idx = SP_REF_U64 (idx);                                           \
-									\
-    VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref");                    \
-									\
-    VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size                       \
-               && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx,           \
-               vm_error_out_of_range_uint64 ("bv-" #stem "-ref", c_idx)); \
-                                                                        \
-    memcpy (&result, SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, size);       \
-    SP_SET_ ## slot (dst, result);                                      \
-    NEXT (1);                                                           \
-  } while (0)
-
-  VM_DEFINE_OP (116, bv_u8_ref, "bv-u8-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (u8, scm_t_uint8, 1, U64);
-
-  VM_DEFINE_OP (117, bv_s8_ref, "bv-s8-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (s8, scm_t_int8, 1, S64);
+      uint8_t dst, a, b;
 
-  VM_DEFINE_OP (118, bv_u16_ref, "bv-u16-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (u16, scm_t_uint16, 2, U64);
-
-  VM_DEFINE_OP (119, bv_s16_ref, "bv-s16-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (s16, scm_t_int16, 2, S64);
-
-  VM_DEFINE_OP (120, bv_u32_ref, "bv-u32-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (u32, scm_t_uint32, 4, U64);
-
-  VM_DEFINE_OP (121, bv_s32_ref, "bv-s32-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (s32, scm_t_int32, 4, S64);
-
-  VM_DEFINE_OP (122, bv_u64_ref, "bv-u64-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (u64, scm_t_uint64, 8, U64);
-
-  VM_DEFINE_OP (123, bv_s64_ref, "bv-s64-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (s64, scm_t_int64, 8, S64);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-  VM_DEFINE_OP (124, bv_f32_ref, "bv-f32-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (f32, float, 4, F64);
+      SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63));
 
-  VM_DEFINE_OP (125, bv_f64_ref, "bv-f64-ref", OP1 (X8_S8_S8_S8) | OP_DST)
-    BV_REF (f64, double, 8, F64);
+      NEXT (1);
+    }
 
-  /* bv-u8-set! dst:8 idx:8 src:8
-   * bv-s8-set! dst:8 idx:8 src:8
-   * bv-u16-set! dst:8 idx:8 src:8
-   * bv-s16-set! dst:8 idx:8 src:8
-   * bv-u32-set! dst:8 idx:8 src:8
-   * bv-s32-set! dst:8 idx:8 src:8
-   * bv-u64-set! dst:8 idx:8 src:8
-   * bv-s64-set! dst:8 idx:8 src:8
-   * bv-f32-set! dst:8 idx:8 src:8
-   * bv-f64-set! dst:8 idx:8 src:8
+  /* srsh/immediate dst:8 a:8 b:8
    *
-   * Store SRC into the bytevector DST at byte offset IDX.  Multibyte
-   * values are written using native endianness.
+   * Shift the s64 value in A right by the immediate B bits, and place
+   * the result in DST.  Only the lower 6 bits of B are used.
    */
-#define BV_BOUNDED_SET(stem, type, min, max, size, slot_type, slot)     \
-  do {									\
-    scm_t_ ## slot_type slot_val;                                       \
-    type val;                                                           \
-    scm_t_uint8 dst, idx, src;                                          \
-    SCM bv;                                                             \
-    scm_t_uint64 c_idx;                                                 \
-    UNPACK_8_8_8 (op, dst, idx, src);                                   \
-    bv = SP_REF (dst);                                                  \
-    c_idx = SP_REF_U64 (idx);                                           \
-    slot_val = SP_REF_ ## slot (src);                                   \
-									\
-    VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!");           \
-									\
-    VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size                       \
-               && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx,           \
-               vm_error_out_of_range_uint64 ("bv-" #stem "-set!", c_idx)); \
-                                                                        \
-    VM_ASSERT (slot_val >= min && slot_val <= max,                      \
-               vm_error_out_of_range_ ## slot_type ("bv-" #stem "-set!", \
-                                                    slot_val));         \
-                                                                        \
-    val = slot_val;                                                     \
-    memcpy (SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, &val, size);          \
-    NEXT (1);                                                           \
-  } while (0)
-
-#define BV_SET(stem, type, size, slot)                                  \
-  do {									\
-    type val;                                                           \
-    scm_t_uint8 dst, idx, src;                                          \
-    SCM bv;                                                             \
-    scm_t_uint64 c_idx;                                                 \
-    UNPACK_8_8_8 (op, dst, idx, src);                                   \
-    bv = SP_REF (dst);                                                  \
-    c_idx = SP_REF_U64 (idx);                                           \
-    val = SP_REF_ ## slot (src);                                        \
-									\
-    VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!");           \
-									\
-    VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size                       \
-               && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx,           \
-               vm_error_out_of_range_uint64 ("bv-" #stem "-set!", c_idx)); \
-                                                                        \
-    memcpy (SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, &val, size);          \
-    NEXT (1);                                                           \
-  } while (0)
-
-  VM_DEFINE_OP (126, bv_u8_set, "bv-u8-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (u8, scm_t_uint8,
-                    0, SCM_T_UINT8_MAX, 1, uint64, U64);
-
-  VM_DEFINE_OP (127, bv_s8_set, "bv-s8-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (s8, scm_t_int8,
-                    SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1, int64, S64);
-
-  VM_DEFINE_OP (128, bv_u16_set, "bv-u16-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (u16, scm_t_uint16,
-                    0, SCM_T_UINT16_MAX, 2, uint64, U64);
-
-  VM_DEFINE_OP (129, bv_s16_set, "bv-s16-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (s16, scm_t_int16,
-                    SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2, int64, S64);
-
-  VM_DEFINE_OP (130, bv_u32_set, "bv-u32-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (u32, scm_t_uint32,
-                    0, SCM_T_UINT32_MAX, 4, uint64, U64);
-
-  VM_DEFINE_OP (131, bv_s32_set, "bv-s32-set!", OP1 (X8_S8_S8_S8))
-    BV_BOUNDED_SET (s32, scm_t_int32,
-                    SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4, int64, S64);
-
-  VM_DEFINE_OP (132, bv_u64_set, "bv-u64-set!", OP1 (X8_S8_S8_S8))
-    BV_SET (u64, scm_t_uint64, 8, U64);
-
-  VM_DEFINE_OP (133, bv_s64_set, "bv-s64-set!", OP1 (X8_S8_S8_S8))
-    BV_SET (s64, scm_t_int64, 8, S64);
+  VM_DEFINE_OP (105, srsh_immediate, "srsh/immediate", DOP1 (X8_S8_S8_C8))
+    {
+      uint8_t dst, a, b;
 
-  VM_DEFINE_OP (134, bv_f32_set, "bv-f32-set!", OP1 (X8_S8_S8_S8))
-    BV_SET (f32, float, 4, F64);
+      UNPACK_8_8_8 (op, dst, a, b);
 
-  VM_DEFINE_OP (135, bv_f64_set, "bv-f64-set!", OP1 (X8_S8_S8_S8))
-    BV_SET (f6, double, 8, F64);
+      SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), b & 63));
 
-  /* scm->f64 dst:12 src:12
-   *
-   * Unpack a raw double-precision floating-point value from SRC and
-   * place it in DST.  Note that SRC can be any value on which
-   * scm_to_double can operate.
-   */
-  VM_DEFINE_OP (136, scm_to_f64, "scm->f64", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET_F64 (dst, scm_to_double (SP_REF (src)));
       NEXT (1);
     }
 
-  /* f64->scm dst:12 src:12
+  /* ulsh/immediate dst:8 a:8 b:8
    *
-   * Pack a raw double-precision floating point value into an inexact
-   * number allocated on the heap.
+   * Shift the u64 value in A left by the immediate B bits, and place
+   * the result in DST.  Only the lower 6 bits of B are used.
    */
-  VM_DEFINE_OP (137, f64_to_scm, "f64->scm", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (106, ulsh_immediate, "ulsh/immediate", DOP1 (X8_S8_S8_C8))
     {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst, scm_from_double (SP_REF_F64 (src)));
+      uint8_t dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63));
+
       NEXT (1);
     }
 
@@ -3157,9 +2521,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Add A to B, and place the result in DST.  The operands and the
    * result are unboxed double-precision floating-point numbers.
    */
-  VM_DEFINE_OP (138, fadd, "fadd", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (107, fadd, "fadd", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, a, b;
+      uint8_t dst, a, b;
       UNPACK_8_8_8 (op, dst, a, b);
       SP_SET_F64 (dst, SP_REF_F64 (a) + SP_REF_F64 (b));
       NEXT (1);
@@ -3170,9 +2534,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Subtract B from A, and place the result in DST.  The operands and
    * the result are unboxed double-precision floating-point numbers.
    */
-  VM_DEFINE_OP (139, fsub, "fsub", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (108, fsub, "fsub", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, a, b;
+      uint8_t dst, a, b;
       UNPACK_8_8_8 (op, dst, a, b);
       SP_SET_F64 (dst, SP_REF_F64 (a) - SP_REF_F64 (b));
       NEXT (1);
@@ -3183,9 +2547,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Multiply A and B, and place the result in DST.  The operands and
    * the result are unboxed double-precision floating-point numbers.
    */
-  VM_DEFINE_OP (140, fmul, "fmul", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (109, fmul, "fmul", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, a, b;
+      uint8_t dst, a, b;
       UNPACK_8_8_8 (op, dst, a, b);
       SP_SET_F64 (dst, SP_REF_F64 (a) * SP_REF_F64 (b));
       NEXT (1);
@@ -3196,865 +2560,726 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Divide A by B, and place the result in DST.  The operands and the
    * result are unboxed double-precision floating-point numbers.
    */
-  VM_DEFINE_OP (141, fdiv, "fdiv", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (110, fdiv, "fdiv", DOP1 (X8_S8_S8_S8))
     {
-      scm_t_uint8 dst, a, b;
+      uint8_t dst, a, b;
       UNPACK_8_8_8 (op, dst, a, b);
       SP_SET_F64 (dst, SP_REF_F64 (a) / SP_REF_F64 (b));
       NEXT (1);
     }
 
-  /* apply-non-program _:24
+  /* u64=? a:12 b:12
    *
-   * Used by the VM as a trampoline to apply non-programs.
+   * Set the comparison result to EQUAL if the u64 values A and B are
+   * the same, or NONE otherwise.
    */
-  VM_DEFINE_OP (142, apply_non_program, "apply-non-program", OP1 (X32))
+  VM_DEFINE_OP (111, u64_numerically_equal, "u64=?", OP1 (X8_S12_S12))
     {
-      SCM proc = FP_REF (0);
+      uint16_t a, b;
+      uint64_t x, y;
 
-      while (!SCM_PROGRAM_P (proc))
-        {
-          if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
-            {
-              proc = SCM_STRUCT_PROCEDURE (proc);
-              FP_SET (0, proc);
-              continue;
-            }
-          if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
-            {
-              scm_t_uint32 n = FRAME_LOCALS_COUNT();
-
-              /* Shuffle args up.  (FIXME: no real need to shuffle; just set
-                 IP and go. ) */
-              ALLOC_FRAME (n + 1);
-              while (n--)
-                FP_SET (n + 1, FP_REF (n));
-
-              proc = SCM_SMOB_DESCRIPTOR (proc).apply_trampoline;
-              FP_SET (0, proc);
-              continue;
-            }
-
-          SYNC_IP();
-          vm_error_wrong_type_apply (proc);
-        }
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF_U64 (a);
+      y = SP_REF_U64 (b);
 
-      ip = SCM_PROGRAM_CODE (proc);
-      NEXT (0);
-    }
+      VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
 
-  /* scm->u64 dst:12 src:12
-   *
-   * Unpack an unsigned 64-bit integer from SRC and place it in DST.
-   */
-  VM_DEFINE_OP (143, scm_to_u64, "scm->u64", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET_U64 (dst, scm_to_uint64 (SP_REF (src)));
       NEXT (1);
     }
 
-  /* u64->scm dst:12 src:12
+  /* u64<? a:12 b:12
    *
-   * Pack an unsigned 64-bit integer into a SCM value.
+   * Set the comparison result to LESS_THAN if the u64 value A is less
+   * than the u64 value B are the same, or NONE otherwise.
    */
-  VM_DEFINE_OP (144, u64_to_scm, "u64->scm", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (112, u64_less, "u64<?", OP1 (X8_S12_S12))
     {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst, scm_from_uint64 (SP_REF_U64 (src)));
-      NEXT (1);
-    }
+      uint16_t a, b;
+      uint64_t x, y;
+
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF_U64 (a);
+      y = SP_REF_U64 (b);
+
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
-  /* bv-length dst:12 src:12
-   *
-   * Store the length of the bytevector in SRC in DST, as an untagged
-   * 64-bit integer.
-   */
-  VM_DEFINE_OP (145, bv_length, "bv-length", OP1 (X8_S12_S12) | OP_DST)
-    {
-      ARGS1 (bv);
-      VM_VALIDATE_BYTEVECTOR (bv, "bytevector-length");
-      SP_SET_U64 (dst, SCM_BYTEVECTOR_LENGTH (bv));
       NEXT (1);
     }
 
-  /* br-if-= a:12 b:12 invert:1 _:7 offset:24
+  /* s64<? a:12 b:12
    *
-   * If the value in A is = to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
+   * Set the comparison result to LESS_THAN if the s64 value A is less
+   * than the s64 value B are the same, or NONE otherwise.
    */
-  VM_DEFINE_OP (146, br_if_u64_ee, "br-if-u64-=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (113, s64_less, "s64<?", OP1 (X8_S12_S12))
     {
-      BR_U64_ARITHMETIC (==);
-    }
+      uint16_t a, b;
+      int64_t x, y;
 
-  /* br-if-< a:12 b:12 invert:1 _:7 offset:24
-   *
-   * If the value in A is < to the value in B, add OFFSET, a signed
-   * 24-bit number, to the current instruction pointer.
-   */
-  VM_DEFINE_OP (147, br_if_u64_lt, "br-if-u64-<", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_U64_ARITHMETIC (<);
-    }
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF_S64 (a);
+      y = SP_REF_S64 (b);
 
-  VM_DEFINE_OP (148, br_if_u64_le, "br-if-u64-<=", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_U64_ARITHMETIC (<=);
-    }
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
-  /* uadd dst:8 a:8 b:8
-   *
-   * Add A to B, and place the result in DST.  The operands and the
-   * result are unboxed unsigned 64-bit integers.  Overflow will wrap
-   * around.
-   */
-  VM_DEFINE_OP (149, uadd, "uadd", OP1 (X8_S8_S8_S8) | OP_DST)
-    {
-      scm_t_uint8 dst, a, b;
-      UNPACK_8_8_8 (op, dst, a, b);
-      SP_SET_U64 (dst, SP_REF_U64 (a) + SP_REF_U64 (b));
       NEXT (1);
     }
 
-  /* usub dst:8 a:8 b:8
-   *
-   * Subtract B from A, and place the result in DST.  The operands and
-   * the result are unboxed unsigned 64-bit integers.  Overflow will
-   * wrap around.
-   */
-  VM_DEFINE_OP (150, usub, "usub", OP1 (X8_S8_S8_S8) | OP_DST)
-    {
-      scm_t_uint8 dst, a, b;
-      UNPACK_8_8_8 (op, dst, a, b);
-      SP_SET_U64 (dst, SP_REF_U64 (a) - SP_REF_U64 (b));
-      NEXT (1);
-    }
-
-  /* umul dst:8 a:8 b:8
+  /* s64-imm=? a:12 b:12
    *
-   * Multiply A and B, and place the result in DST.  The operands and
-   * the result are unboxed unsigned 64-bit integers.  Overflow will
-   * wrap around.
+   * Set the comparison result to EQUAL if the s64 value A is equal to
+   * the immediate s64 value B, or NONE otherwise.
    */
-  VM_DEFINE_OP (151, umul, "umul", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (114, s64_imm_numerically_equal, "s64-imm=?", OP1 (X8_S12_Z12))
     {
-      scm_t_uint8 dst, a, b;
-      UNPACK_8_8_8 (op, dst, a, b);
-      SP_SET_U64 (dst, SP_REF_U64 (a) * SP_REF_U64 (b));
-      NEXT (1);
-    }
+      uint16_t a;
+      int64_t x, y;
 
-  /* uadd/immediate dst:8 src:8 imm:8
-   *
-   * Add the unsigned 64-bit value from SRC with the unsigned 8-bit
-   * value IMM and place the raw unsigned 64-bit result in DST.
-   * Overflow will wrap around.
-   */
-  VM_DEFINE_OP (152, uadd_immediate, "uadd/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
-    {
-      scm_t_uint8 dst, src, imm;
-      scm_t_uint64 x;
+      a = (op >> 8) & 0xfff;
+      x = SP_REF_S64 (a);
 
-      UNPACK_8_8_8 (op, dst, src, imm);
-      x = SP_REF_U64 (src);
-      SP_SET_U64 (dst, x + (scm_t_uint64) imm);
-      NEXT (1);
-    }
+      y = ((int32_t) op) >> 20; /* Sign extension.  */
 
-  /* usub/immediate dst:8 src:8 imm:8
-   *
-   * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit
-   * value in SRC and place the raw unsigned 64-bit result in DST.
-   * Overflow will wrap around.
-   */
-  VM_DEFINE_OP (153, usub_immediate, "usub/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
-    {
-      scm_t_uint8 dst, src, imm;
-      scm_t_uint64 x;
+      VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
 
-      UNPACK_8_8_8 (op, dst, src, imm);
-      x = SP_REF_U64 (src);
-      SP_SET_U64 (dst, x - (scm_t_uint64) imm);
       NEXT (1);
     }
 
-  /* umul/immediate dst:8 src:8 imm:8
+  /* u64-imm<? a:12 b:12
    *
-   * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit
-   * value IMM and place the raw unsigned 64-bit result in DST.
-   * Overflow will wrap around.
+   * Set the comparison result to LESS_THAN if the u64 value A is less
+   * than the immediate u64 value B, or NONE otherwise.
    */
-  VM_DEFINE_OP (154, umul_immediate, "umul/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (115, u64_imm_less, "u64-imm<?", OP1 (X8_S12_C12))
     {
-      scm_t_uint8 dst, src, imm;
-      scm_t_uint64 x;
+      uint16_t a;
+      uint64_t x, y;
 
-      UNPACK_8_8_8 (op, dst, src, imm);
-      x = SP_REF_U64 (src);
-      SP_SET_U64 (dst, x * (scm_t_uint64) imm);
-      NEXT (1);
-    }
+      UNPACK_12_12 (op, a, y);
+      x = SP_REF_U64 (a);
 
-  /* load-f64 dst:24 high-bits:32 low-bits:32
-   *
-   * Make a double-precision floating-point value with HIGH-BITS and
-   * LOW-BITS.
-   */
-  VM_DEFINE_OP (155, load_f64, "load-f64", OP3 (X8_S24, AF32, BF32) | OP_DST)
-    {
-      scm_t_uint32 dst;
-      scm_t_uint64 val;
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
-      UNPACK_24 (op, dst);
-      val = ip[1];
-      val <<= 32;
-      val |= ip[2];
-      SP_SET_U64 (dst, val);
-      NEXT (3);
+      NEXT (1);
     }
 
-  /* load-u64 dst:24 high-bits:32 low-bits:32
+  /* imm-u64<? a:12 b:12
    *
-   * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
+   * Set the comparison result to LESS_THAN if the u64 immediate B is
+   * less than the u64 value A, or NONE otherwise.
    */
-  VM_DEFINE_OP (156, load_u64, "load-u64", OP3 (X8_S24, AU32, BU32) | OP_DST)
+  VM_DEFINE_OP (116, imm_u64_less, "imm-u64<?", OP1 (X8_S12_C12))
     {
-      scm_t_uint32 dst;
-      scm_t_uint64 val;
+      uint16_t a;
+      uint64_t x, y;
 
-      UNPACK_24 (op, dst);
-      val = ip[1];
-      val <<= 32;
-      val |= ip[2];
-      SP_SET_U64 (dst, val);
-      NEXT (3);
-    }
+      UNPACK_12_12 (op, a, x);
+      y = SP_REF_U64 (a);
 
-  /* scm->s64 dst:12 src:12
-   *
-   * Unpack a signed 64-bit integer from SRC and place it in DST.
-   */
-  VM_DEFINE_OP (157, scm_to_s64, "scm->s64", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET_S64 (dst, scm_to_int64 (SP_REF (src)));
-      NEXT (1);
-    }
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
-  /* s64->scm dst:12 src:12
-   *
-   * Pack an signed 64-bit integer into a SCM value.
-   */
-  VM_DEFINE_OP (158, s64_to_scm, "s64->scm", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      SP_SET (dst, scm_from_int64 (SP_REF_S64 (src)));
       NEXT (1);
     }
 
-  /* load-s64 dst:24 high-bits:32 low-bits:32
+  /* s64-imm<? a:12 b:12
    *
-   * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
+   * Set the comparison result to LESS_THAN if the s64 value A is less
+   * than the immediate s64 value B, or NONE otherwise.
    */
-  VM_DEFINE_OP (159, load_s64, "load-s64", OP3 (X8_S24, AS32, BS32) | OP_DST)
+  VM_DEFINE_OP (117, s64_imm_less, "s64-imm<?", OP1 (X8_S12_Z12))
     {
-      scm_t_uint32 dst;
-      scm_t_uint64 val;
+      uint16_t a;
+      int64_t x, y;
 
-      UNPACK_24 (op, dst);
-      val = ip[1];
-      val <<= 32;
-      val |= ip[2];
-      SP_SET_U64 (dst, val);
-      NEXT (3);
-    }
+      a = (op >> 8) & 0xfff;
+      x = SP_REF_S64 (a);
 
-  /* current-thread dst:24
-   *
-   * Write the current thread into DST.
-   */
-  VM_DEFINE_OP (160, current_thread, "current-thread", OP1 (X8_S24) | OP_DST)
-    {
-      scm_t_uint32 dst;
+      y = ((int32_t) op) >> 20; /* Sign extension.  */
 
-      UNPACK_24 (op, dst);
-      SP_SET (dst, thread->handle);
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
       NEXT (1);
     }
 
-  /* logsub dst:8 a:8 b:8
+  /* imm-s64<? a:12 b:12
    *
-   * Place the bitwise AND of A and the bitwise NOT of B into DST.
+   * Set the comparison result to LESS_THAN if the s64 immediate B is
+   * less than the s64 value A, or NONE otherwise.
    */
-  VM_DEFINE_OP (161, logsub, "logsub", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (118, imm_s64_less, "imm-s64<?", OP1 (X8_S12_Z12))
     {
-      ARGS2 (x, y);
+      uint16_t a;
+      int64_t x, y;
 
-      if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
-        {
-          scm_t_signed_bits a, b;
+      a = (op >> 8) & 0xfff;
+      y = SP_REF_S64 (a);
 
-          a = SCM_I_INUM (x);
-          b = SCM_I_INUM (y);
+      x = ((int32_t) op) >> 20; /* Sign extension.  */
 
-          RETURN (SCM_I_MAKINUM (a & ~b));
-        }
+      VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
 
-      RETURN_EXP (scm_logand (x, scm_lognot (y)));
+      NEXT (1);
     }
 
-  /* ulogand dst:8 a:8 b:8
+  /* f64=? a:12 b:12
    *
-   * Place the bitwise AND of the u64 values in A and B into DST.
+   * Set the comparison result to EQUAL if the f64 value A is equal to
+   * the f64 value B, or NONE otherwise.
    */
-  VM_DEFINE_OP (162, ulogand, "ulogand", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (119, f64_numerically_equal, "f64=?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
+      uint16_t a, b;
+      double x, y;
 
-      UNPACK_8_8_8 (op, dst, a, b);
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF_F64 (a);
+      y = SP_REF_F64 (b);
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b));
+      if (x == y)
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        /* This is also the case for NaN.  */
+        VP->compare_result = SCM_F_COMPARE_NONE;
 
       NEXT (1);
     }
 
-  /* ulogior dst:8 a:8 b:8
+  /* f64<? a:12 b:12
    *
-   * Place the bitwise inclusive OR of the u64 values in A and B into
-   * DST.
+   * Set the comparison result to LESS_THAN if the f64 value A is less
+   * than the f64 value B, NONE if A is greater than or equal to B, or
+   * INVALID otherwise.
    */
-  VM_DEFINE_OP (163, ulogior, "ulogior", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (120, f64_less, "f64<?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
+      uint16_t a, b;
+      double x, y;
 
-      UNPACK_8_8_8 (op, dst, a, b);
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF_F64 (a);
+      y = SP_REF_F64 (b);
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b));
+      if (x < y)
+        VP->compare_result = SCM_F_COMPARE_LESS_THAN;
+      else if (x >= y)
+        VP->compare_result = SCM_F_COMPARE_NONE;
+      else
+        /* NaN.  */
+        VP->compare_result = SCM_F_COMPARE_INVALID;
 
       NEXT (1);
     }
 
-  /* ulogsub dst:8 a:8 b:8
+  /* =? a:12 b:12
    *
-   * Place the (A & ~B) of the u64 values A and B into DST.
+   * Set the comparison result to EQUAL if the SCM values A and B are
+   * numerically equal, in the sense of "=".  Set to NONE otherwise.
    */
-  VM_DEFINE_OP (164, ulogsub, "ulogsub", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (121, numerically_equal, "=?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
-
-      UNPACK_8_8_8 (op, dst, a, b);
+      uint16_t a, b;
+      SCM x, y;
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b));
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF (a);
+      y = SP_REF (b);
 
+      SYNC_IP ();
+      if (CALL_INTRINSIC (numerically_equal_p, (x, y)))
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        VP->compare_result = SCM_F_COMPARE_NONE;
+      CACHE_SP ();
       NEXT (1);
     }
 
-  /* ursh dst:8 a:8 b:8
+  /* heap-numbers-equal? a:12 b:12
    *
-   * Shift the u64 value in A right by B bits, and place the result in
-   * DST.  Only the lower 6 bits of B are used.
+   * Set the comparison result to EQUAL if the SCM values A and B are
+   * numerically equal, in the sense of "=".  Set to NONE otherwise.  It
+   * is known that both A and B are heap numbers.
    */
-  VM_DEFINE_OP (165, ursh, "ursh", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (122, heap_numbers_equal, "heap-numbers-equal?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
-
-      UNPACK_8_8_8 (op, dst, a, b);
+      uint16_t a, b;
+      SCM x, y;
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63));
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF (a);
+      y = SP_REF (b);
 
+      SYNC_IP ();
+      if (CALL_INTRINSIC (heap_numbers_equal_p, (x, y)))
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        VP->compare_result = SCM_F_COMPARE_NONE;
+      CACHE_SP ();
       NEXT (1);
     }
 
-  /* ulsh dst:8 a:8 b:8
+  /* <? a:12 b:12
    *
-   * Shift the u64 value in A left by B bits, and place the result in
-   * DST.  Only the lower 6 bits of B are used.
+   * Set the comparison result to LESS_THAN if the SCM value A is less
+   * than the SCM value B, NONE if A is greater than or equal to B, or
+   * INVALID otherwise.
    */
-  VM_DEFINE_OP (166, ulsh, "ulsh", OP1 (X8_S8_S8_S8) | OP_DST)
+  VM_DEFINE_OP (123, less, "<?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
-
-      UNPACK_8_8_8 (op, dst, a, b);
+      uint16_t a, b;
+      SCM x, y;
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63));
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF (a);
+      y = SP_REF (b);
 
+      SYNC_IP ();
+      VP->compare_result = CALL_INTRINSIC (less_p, (x, y));
+      CACHE_SP ();
       NEXT (1);
     }
 
-  /* scm->u64/truncate dst:12 src:12
+  /* immediate-tag=? obj:24 mask:16 tag:16
    *
-   * Unpack an exact integer from SRC and place it in the unsigned
-   * 64-bit register DST, truncating any high bits.  If the number in
-   * SRC is negative, all the high bits will be set.
+   * Set the comparison result to EQUAL if the result of a bitwise AND
+   * between the bits of SCM value A and the immediate MASK is TAG, or
+   * NONE otherwise.
    */
-  VM_DEFINE_OP (167, scm_to_u64_truncate, "scm->u64/truncate", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (124, immediate_tag_equals, "immediate-tag=?", OP2 (X8_S24, C16_C16))
     {
-      scm_t_uint16 dst, src;
+      uint32_t a;
+      uint16_t mask, expected;
       SCM x;
 
-      UNPACK_12_12 (op, dst, src);
-      x = SP_REF (src);
+      UNPACK_24 (op, a);
+      UNPACK_16_16 (ip[1], mask, expected);
+      x = SP_REF (a);
 
-      if (SCM_I_INUMP (x))
-        SP_SET_U64 (dst, (scm_t_uint64) SCM_I_INUM (x));
+      if ((SCM_UNPACK (x) & mask) == expected)
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
       else
-        {
-          SYNC_IP ();
-          SP_SET_U64 (dst,
-                      scm_to_uint64
-                      (scm_logand (x, scm_from_uint64 ((scm_t_uint64) -1))));
-        }
+        VP->compare_result = SCM_F_COMPARE_NONE;
 
-      NEXT (1);
+      NEXT (2);
     }
 
-  /* ursh/immediate dst:8 a:8 b:8
+  /* heap-tag=? obj:24 mask:16 tag:16
    *
-   * Shift the u64 value in A right by the immediate B bits, and place
-   * the result in DST.  Only the lower 6 bits of B are used.
+   * Set the comparison result to EQUAL if the result of a bitwise AND
+   * between the first word of SCM value A and the immediate MASK is
+   * TAG, or NONE otherwise.
    */
-  VM_DEFINE_OP (168, ursh_immediate, "ursh/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (125, heap_tag_equals, "heap-tag=?", OP2 (X8_S24, C16_C16))
     {
-      scm_t_uint8 dst, a, b;
+      uint32_t a;
+      uint16_t mask, expected;
+      SCM x;
 
-      UNPACK_8_8_8 (op, dst, a, b);
+      UNPACK_24 (op, a);
+      UNPACK_16_16 (ip[1], mask, expected);
+      x = SP_REF (a);
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63));
+      if ((SCM_CELL_TYPE (x) & mask) == expected)
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        VP->compare_result = SCM_F_COMPARE_NONE;
 
-      NEXT (1);
+      NEXT (2);
     }
 
-  /* ulsh/immediate dst:8 a:8 b:8
+  /* eq? a:12 b:12
    *
-   * Shift the u64 value in A left by the immediate B bits, and place
-   * the result in DST.  Only the lower 6 bits of B are used.
+   * Set the comparison result to EQUAL if the SCM values A and B are
+   * eq?, or NONE otherwise.
    */
-  VM_DEFINE_OP (169, ulsh_immediate, "ulsh/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+  VM_DEFINE_OP (126, eq, "eq?", OP1 (X8_S12_S12))
     {
-      scm_t_uint8 dst, a, b;
+      uint16_t a, b;
+      SCM x, y;
 
-      UNPACK_8_8_8 (op, dst, a, b);
+      UNPACK_12_12 (op, a, b);
+      x = SP_REF (a);
+      y = SP_REF (b);
 
-      SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63));
+      if (scm_is_eq (x, y))
+        VP->compare_result = SCM_F_COMPARE_EQUAL;
+      else
+        VP->compare_result = SCM_F_COMPARE_NONE;
 
       NEXT (1);
     }
 
-#define BR_U64_SCM_COMPARISON(x, y, unboxed, boxed)                     \
-  do {                                                                  \
-    scm_t_uint32 a, b;                                                  \
-    scm_t_uint64 x;                                                     \
-    SCM y_scm;                                                          \
-                                                                        \
-    UNPACK_24 (op, a);                                                  \
-    UNPACK_24 (ip[1], b);                                               \
-    x = SP_REF_U64 (a);                                                 \
-    y_scm = SP_REF (b);                                                 \
-                                                                        \
-    if (SCM_I_INUMP (y_scm))                                            \
-      {                                                                 \
-        scm_t_signed_bits y = SCM_I_INUM (y_scm);                       \
-                                                                        \
-        if ((ip[2] & 0x1) ? !(unboxed) : (unboxed))                     \
-          {                                                             \
-            scm_t_int32 offset = ip[2];                                 \
-            offset >>= 8; /* Sign-extending shift. */                   \
-            NEXT (offset);                                              \
-          }                                                             \
-        NEXT (3);                                                       \
-      }                                                                 \
-    else                                                                \
-      {                                                                 \
-        SCM res;                                                        \
-        SYNC_IP ();                                                     \
-        res = boxed (scm_from_uint64 (x), y_scm);                       \
-        CACHE_SP ();                                                    \
-        if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res))     \
-          {                                                             \
-            scm_t_int32 offset = ip[2];                                 \
-            offset >>= 8; /* Sign-extending shift. */                   \
-            NEXT (offset);                                              \
-          }                                                             \
-        NEXT (3);                                                       \
-      }                                                                 \
-  } while (0)
-
-  /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* j offset:24
    *
-   * If the U64 value in A is = to the SCM value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Add OFFSET, a signed 24-bit number, to the current instruction
+   * pointer.
    */
-  VM_DEFINE_OP (170, br_if_u64_ee_scm, "br-if-u64-=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (127, j, "j", OP1 (X8_L24))
     {
-      BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y == x, scm_num_eq_p);
+      int32_t offset = op;
+      offset >>= 8; /* Sign-extending shift. */
+      NEXT (offset);
     }
 
-  /* br-if-u64-<-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* jl offset:24
    *
-   * If the U64 value in A is < than the SCM value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * If the last comparison result is equal to SCM_F_COMPARE_LESS_THAN, add
+   * OFFSET, a signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (171, br_if_u64_lt_scm, "br-if-u64-<-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (128, jl, "jl", OP1 (X8_L24))
     {
-      BR_U64_SCM_COMPARISON(x, y, y > 0 && (scm_t_uint64) y > x, scm_less_p);
+      if (VP->compare_result == SCM_F_COMPARE_LESS_THAN)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
     }
 
-  /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* je offset:24
    *
-   * If the U64 value in A is <= than the SCM value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * If the last comparison result was EQUAL, then add OFFSET, a signed
+   * 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (172, br_if_u64_le_scm, "br-if-u64-<=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (129, je, "je", OP1 (X8_L24))
     {
-      BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y >= x, scm_leq_p);
+      if (VP->compare_result == SCM_F_COMPARE_EQUAL)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
     }
 
-  /* br-if-u64->-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* jnl offset:24
    *
-   * If the U64 value in A is > than the SCM value in B, add OFFSET, a
+   * If the last comparison result was not LESS_THAN, then add OFFSET, a
    * signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (173, br_if_u64_gt_scm, "br-if-u64->-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (130, jnl, "jnl", OP1 (X8_L24))
     {
-      BR_U64_SCM_COMPARISON(x, y, y < 0 || (scm_t_uint64) y < x, scm_gr_p);
+      if (VP->compare_result != SCM_F_COMPARE_LESS_THAN)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
     }
 
-  /* br-if-u64->=-scm a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* jne offset:24
    *
-   * If the U64 value in A is >= than the SCM value in B, add OFFSET, a
+   * If the last comparison result was not EQUAL, then add OFFSET, a
    * signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (174, br_if_u64_ge_scm, "br-if-u64->=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24))
+  VM_DEFINE_OP (131, jne, "jne", OP1 (X8_L24))
     {
-      BR_U64_SCM_COMPARISON(x, y, y <= 0 || (scm_t_uint64) y <= x, scm_geq_p);
+      if (VP->compare_result != SCM_F_COMPARE_EQUAL)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
     }
 
-  /* integer->char a:12 b:12
+  /* jge offset:24
    *
-   * Convert the U64 value in B to a Scheme character, and return it in
-   * A.
+   * If the last comparison result was NONE, then add OFFSET, a signed
+   * 24-bit number, to the current instruction pointer.
+   *
+   * This is intended for use after a "<?" comparison, and is different
+   * from "jnl" in the way it handles not-a-number (NaN) values: "<?"
+   * sets INVALID instead of NONE if either value is a NaN.  For exact
+   * numbers, "jge" is the same as "jnl".
    */
-  VM_DEFINE_OP (175, integer_to_char, "integer->char", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (132, jge, "jge", OP1 (X8_L24))
     {
-      scm_t_uint16 dst, src;
-      scm_t_uint64 x;
-
-      UNPACK_12_12 (op, dst, src);
-      x = SP_REF_U64 (src);
-
-      VM_ASSERT (x <= (scm_t_uint64) SCM_CODEPOINT_MAX,
-                 vm_error_out_of_range_uint64 ("integer->char", x));
-
-      SP_SET (dst, SCM_MAKE_ITAG8 ((scm_t_bits) (scm_t_wchar) x, scm_tc8_char));
-
-      NEXT (1);
+      if (VP->compare_result == SCM_F_COMPARE_NONE)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
     }
 
-  /* char->integer a:12 b:12
+  /* jnge offset:24
    *
-   * Untag the character in B to U64, and return it in A.
+   * If the last comparison result was not NONE, then add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   *
+   * This is intended for use after a "<?" comparison, and is different
+   * from "jl" in the way it handles not-a-number (NaN) values: "<?"
+   * sets INVALID instead of NONE if either value is a NaN.  For exact
+   * numbers, "jnge" is the same as "jl".
    */
-  VM_DEFINE_OP (176, char_to_integer, "char->integer", OP1 (X8_S12_S12) | OP_DST)
+  VM_DEFINE_OP (133, jnge, "jnge", OP1 (X8_L24))
     {
-      scm_t_uint16 dst, src;
-      SCM x;
-
-      UNPACK_12_12 (op, dst, src);
-      x = SP_REF (src);
+      if (VP->compare_result != SCM_F_COMPARE_NONE)
+        {
+          int32_t offset = op;
+          offset >>= 8; /* Sign-extending shift. */
+          NEXT (offset);
+        }
+      else
+        NEXT (1);
+    }
 
-      VM_VALIDATE_CHAR (x, "char->integer");
-      SP_SET_U64 (dst, SCM_CHAR (x));
+#define PTR_REF(type, slot)                                             \
+  do {                                                                  \
+    uint8_t dst, a, b;                                                  \
+    char *ptr;                                                          \
+    size_t idx;                                                         \
+    type val;                                                           \
+    UNPACK_8_8_8 (op, dst, a, b);                                       \
+    ptr = SP_REF_PTR (a);                                               \
+    idx = SP_REF_U64 (b);                                               \
+    memcpy (&val, ptr + idx, sizeof (val));                             \
+    SP_SET_ ## slot (dst, val);                                         \
+    NEXT (1);                                                           \
+  } while (0)
 
-      NEXT (1);
-    }
+#define PTR_SET(type, slot)                                             \
+  do {                                                                  \
+    uint8_t a, b, c;                                                    \
+    char *ptr;                                                          \
+    size_t idx;                                                         \
+    type val;                                                           \
+    UNPACK_8_8_8 (op, a, b, c);                                         \
+    ptr = SP_REF_PTR (a);                                               \
+    idx = SP_REF_U64 (b);                                               \
+    val = SP_REF_ ## slot (c);                                          \
+    memcpy (ptr + idx, &val, sizeof (val));                             \
+    NEXT (1);                                                           \
+  } while (0)
 
-  /* ulogxor dst:8 a:8 b:8
+  /* u8-ref dst:8 ptr:8 idx:8
    *
-   * Place the bitwise exclusive OR of the u64 values in A and B into
-   * DST.
+   * Load the u8 at byte offset IDX from pointer PTR, and store it to
+   * u64 DST.
    */
-  VM_DEFINE_OP (177, ulogxor, "ulogxor", OP1 (X8_S8_S8_S8) | OP_DST)
-    {
-      scm_t_uint8 dst, a, b;
-
-      UNPACK_8_8_8 (op, dst, a, b);
-
-      SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b));
+  VM_DEFINE_OP (134, u8_ref, "u8-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (uint8_t, U64);
 
-      NEXT (1);
-    }
-
-  /* make-atomic-box dst:12 src:12
+  /* u16-ref dst:8 ptr:8 idx:8
    *
-   * Create a new atomic box initialized to SRC, and place it in DST.
+   * Load the u16 at byte offset IDX from pointer PTR, and store it to
+   * u64 DST.
    */
-  VM_DEFINE_OP (178, make_atomic_box, "make-atomic-box", OP1 (X8_S12_S12) | OP_DST)
-    {
-      SCM box;
-      scm_t_uint16 dst, src;
-      UNPACK_12_12 (op, dst, src);
-      SYNC_IP ();
-      box = scm_inline_cell (thread, scm_tc7_atomic_box,
-                             SCM_UNPACK (SCM_UNSPECIFIED));
-      scm_atomic_set_scm (scm_atomic_box_loc (box), SP_REF (src));
-      SP_SET (dst, box);
-      NEXT (1);
-    }
+  VM_DEFINE_OP (135, u16_ref, "u16-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (uint16_t, U64);
 
-  /* atomic-box-ref dst:12 src:12
+  /* u32-ref dst:8 ptr:8 idx:8
    *
-   * Fetch the value of the atomic box at SRC into DST.
+   * Load the u32 at byte offset IDX from pointer PTR, and store it to
+   * u64 DST.
    */
-  VM_DEFINE_OP (179, atomic_box_ref, "atomic-box-ref", OP1 (X8_S12_S12) | OP_DST)
-    {
-      scm_t_uint16 dst, src;
-      SCM box;
-      UNPACK_12_12 (op, dst, src);
-      box = SP_REF (src);
-      VM_VALIDATE_ATOMIC_BOX (box, "atomic-box-ref");
-      SP_SET (dst, scm_atomic_ref_scm (scm_atomic_box_loc (box)));
-      NEXT (1);
-    }
+  VM_DEFINE_OP (136, u32_ref, "u32-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (uint32_t, U64);
 
-  /* atomic-box-set! dst:12 src:12
+  /* u64-ref dst:8 ptr:8 idx:8
    *
-   * Set the contents of the atomic box at DST to SRC.
+   * Load the u64 at byte offset IDX from pointer PTR, and store it to
+   * u64 DST.
    */
-  VM_DEFINE_OP (180, atomic_box_set, "atomic-box-set!", OP1 (X8_S12_S12))
-    {
-      scm_t_uint16 dst, src;
-      SCM box;
-      UNPACK_12_12 (op, dst, src);
-      box = SP_REF (dst);
-      VM_VALIDATE_ATOMIC_BOX (box, "atomic-box-set!");
-      scm_atomic_set_scm (scm_atomic_box_loc (box), SP_REF (src));
-      NEXT (1);
-    }
+  VM_DEFINE_OP (137, u64_ref, "u64-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (uint64_t, U64);
 
-  /* atomic-box-swap! dst:12 box:12 _:8 val:24
+  /* u8-set! ptr:8 idx:8 val:8
    *
-   * Replace the contents of the atomic box at BOX to VAL and store the
-   * previous value at DST.
+   * Store the u64 value VAL into the u8 at byte offset IDX from pointer
+   * PTR.
    */
-  VM_DEFINE_OP (181, atomic_box_swap, "atomic-box-swap!", OP2 (X8_S12_S12, X8_S24) | OP_DST)
-    {
-      scm_t_uint16 dst, box;
-      scm_t_uint32 val;
-      SCM scm_box;
-      UNPACK_12_12 (op, dst, box);
-      UNPACK_24 (ip[1], val);
-      scm_box = SP_REF (box);
-      VM_VALIDATE_ATOMIC_BOX (scm_box, "atomic-box-swap!");
-      SP_SET (dst,
-              scm_atomic_swap_scm (scm_atomic_box_loc (scm_box), SP_REF (val)));
-      NEXT (2);
-    }
+  VM_DEFINE_OP (138, u8_set, "u8-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (uint8_t, U64);
 
-  /* atomic-box-compare-and-swap! dst:12 box:12 _:8 expected:24  _:8 desired:24
+  /* u16-set! ptr:8 idx:8 val:8
    *
-   * Set the contents of the atomic box at DST to SET.
+   * Store the u64 value VAL into the u16 at byte offset IDX from
+   * pointer PTR.
    */
-  VM_DEFINE_OP (182, atomic_box_compare_and_swap, "atomic-box-compare-and-swap!", OP3 (X8_S12_S12, X8_S24, X8_S24) | OP_DST)
-    {
-      scm_t_uint16 dst, box;
-      scm_t_uint32 expected, desired;
-      SCM scm_box, scm_expected, scm_result;
-      UNPACK_12_12 (op, dst, box);
-      UNPACK_24 (ip[1], expected);
-      UNPACK_24 (ip[2], desired);
-      scm_box = SP_REF (box);
-      VM_VALIDATE_ATOMIC_BOX (scm_box, "atomic-box-compare-and-swap!");
-      scm_result = scm_expected = SP_REF (expected);
-      while (!scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (scm_box),
-                                               &scm_result, SP_REF (desired))
-             && scm_is_eq (scm_result, scm_expected))
-        {
-          /* 'scm_atomic_compare_and_swap_scm' has spuriously failed,
-             i.e. it has returned 0 to indicate failure, although the
-             observed value is 'eq?' to EXPECTED.  In this case, we *must*
-             try again, because the API of 'atomic-box-compare-and-swap!'
-             provides no way to indicate to the caller that the exchange
-             failed when the observed value is 'eq?' to EXPECTED.  */
-        }
-      SP_SET (dst, scm_result);
-      NEXT (3);
-    }
+  VM_DEFINE_OP (139, u16_set, "u16-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (uint16_t, U64);
 
-  /* handle-interrupts _:24
+  /* u32-set! ptr:8 idx:8 val:8
    *
-   * Handle pending interrupts.
+   * Store the u64 value VAL into the u32 at byte offset IDX from
+   * pointer PTR.
    */
-  VM_DEFINE_OP (183, handle_interrupts, "handle-interrupts", OP1 (X32))
-    {
-      if (SCM_LIKELY (scm_is_null
-                      (scm_atomic_ref_scm (&thread->pending_asyncs))))
-        NEXT (1);
-
-      if (thread->block_asyncs > 0)
-        NEXT (1);
-
-      {
-        union scm_vm_stack_element *old_fp, *new_fp;
-        size_t old_frame_size = FRAME_LOCALS_COUNT ();
-        SCM proc = scm_i_async_pop (thread);
+  VM_DEFINE_OP (140, u32_set, "u32-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (uint32_t, U64);
 
-        /* No PUSH_CONTINUATION_HOOK, as we can't usefully
-           POP_CONTINUATION_HOOK because there are no return values.  */
-
-        /* Three slots: two for RA and dynamic link, one for proc.  */
-        ALLOC_FRAME (old_frame_size + 3);
-
-        /* Set up a frame that will return right back to this
-           handle-interrupts opcode to handle any additional
-           interrupts.  */
-        old_fp = vp->fp;
-        new_fp = SCM_FRAME_SLOT (old_fp, old_frame_size + 1);
-        SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
-        SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip);
-        vp->fp = new_fp;
-
-        SP_SET (0, proc);
-
-        ip = (scm_t_uint32 *) vm_handle_interrupt_code;
-
-        APPLY_HOOK ();
+  /* u64-set! ptr:8 idx:8 val:8
+   *
+   * Store the u64 value VAL into the u64 at byte offset IDX from
+   * pointer PTR.
+   */
+  VM_DEFINE_OP (141, u64_set, "u64-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (uint64_t, U64);
 
-        NEXT (0);
-      }
-    }
+  /* s8-ref dst:8 ptr:8 idx:8
+   *
+   * Load the s8 at byte offset IDX from pointer PTR, and store it to
+   * s64 DST.
+   */
+  VM_DEFINE_OP (142, s8_ref, "s8-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (int8_t, S64);
 
-  /* return-from-interrupt _:24
+  /* s16-ref dst:8 ptr:8 idx:8
    *
-   * Return from handling an interrupt, discarding any return values and
-   * stripping away the interrupt frame.
+   * Load the s16 at byte offset IDX from pointer PTR, and store it to
+   * s64 DST.
    */
-  VM_DEFINE_OP (184, return_from_interrupt, "return-from-interrupt", OP1 (X32))
-    {
-      vp->sp = sp = SCM_FRAME_PREVIOUS_SP (vp->fp);
-      ip = SCM_FRAME_RETURN_ADDRESS (vp->fp);
-      vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp);
+  VM_DEFINE_OP (143, s16_ref, "s16-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (int16_t, S64);
 
-      NEXT (0);
-    }
+  /* s32-ref dst:8 ptr:8 idx:8
+   *
+   * Load the s32 at byte offset IDX from pointer PTR, and store it to
+   * s64 DST.
+   */
+  VM_DEFINE_OP (144, s32_ref, "s32-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (int32_t, S64);
 
-  /* push-dynamic-state state:24
+  /* s64-ref dst:8 ptr:8 idx:8
    *
-   * Save the current fluid bindings on the dynamic stack, and use STATE
-   * instead.
+   * Load the s64 at byte offset IDX from pointer PTR, and store it to
+   * s64 DST.
    */
-  VM_DEFINE_OP (185, push_dynamic_state, "push-dynamic-state", OP1 (X8_S24))
-    {
-      scm_t_uint32 state;
+  VM_DEFINE_OP (145, s64_ref, "s64-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (int64_t, S64);
 
-      UNPACK_24 (op, state);
+  /* s8-set! ptr:8 idx:8 val:8
+   *
+   * Store the s64 value VAL into the s8 at byte offset IDX from pointer
+   * PTR.
+   */
+  VM_DEFINE_OP (146, s8_set, "s8-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (int8_t, S64);
 
-      SYNC_IP ();
-      scm_dynstack_push_dynamic_state (&thread->dynstack, SP_REF (state),
-                                       thread->dynamic_state);
-      NEXT (1);
-    }
+  /* s16-set! ptr:8 idx:8 val:8
+   *
+   * Store the s64 value VAL into the s16 at byte offset IDX from
+   * pointer PTR.
+   */
+  VM_DEFINE_OP (147, s16_set, "s16-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (int16_t, S64);
 
-  /* pop-dynamic-state _:24
+  /* s32-set! ptr:8 idx:8 val:8
    *
-   * Restore the saved fluid bindings from the dynamic stack.
+   * Store the s64 value VAL into the s32 at byte offset IDX from
+   * pointer PTR.
    */
-  VM_DEFINE_OP (186, pop_dynamic_state, "pop-dynamic-state", OP1 (X32))
-    {
-      SYNC_IP ();
-      scm_dynstack_unwind_dynamic_state (&thread->dynstack,
-                                         thread->dynamic_state);
-      NEXT (1);
-    }
+  VM_DEFINE_OP (148, s32_set, "s32-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (int32_t, S64);
 
-  /* br-if-f64-= a:12 b:12 invert:1 _:7 offset:24
+  /* s64-set! ptr:8 idx:8 val:8
    *
-   * If the F64 value in A is = to the F64 value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Store the s64 value VAL into the s64 at byte offset IDX from
+   * pointer PTR.
    */
-  VM_DEFINE_OP (187, br_if_f64_ee, "br-if-f64-=", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_F64_ARITHMETIC (==);
-    }
+  VM_DEFINE_OP (149, s64_set, "s64-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (int64_t, S64);
 
-  /* br-if-f64-< a:12 b:12 invert:1 _:7 offset:24
+  /* f32-ref dst:8 ptr:8 idx:8
    *
-   * If the F64 value in A is < to the F64 value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Load the f32 at byte offset IDX from pointer PTR, and store it to
+   * f64 DST.
    */
-  VM_DEFINE_OP (188, br_if_f64_lt, "br-if-f64-<", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_F64_ARITHMETIC (<);
-    }
+  VM_DEFINE_OP (150, f32_ref, "f32-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (float, F64);
 
-  /* br-if-f64-<= a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* f64-ref dst:8 ptr:8 idx:8
    *
-   * If the F64 value in A is <= than the F64 value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Load the f64 at byte offset IDX from pointer PTR, and store it to
+   * f64 DST.
    */
-  VM_DEFINE_OP (189, br_if_f64_le, "br-if-f64-<=", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_F64_ARITHMETIC (<=);
-    }
+  VM_DEFINE_OP (151, f64_ref, "f64-ref", DOP1 (X8_S8_S8_S8))
+    PTR_REF (double, F64);
 
-  /* br-if-f64-> a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* f32-set! ptr:8 idx:8 val:8
    *
-   * If the F64 value in A is > than the F64 value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Store the f64 value VAL into the f32 at byte offset IDX from
+   * pointer PTR.
    */
-  VM_DEFINE_OP (190, br_if_f64_gt, "br-if-f64->", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_F64_ARITHMETIC (>);
-    }
+  VM_DEFINE_OP (152, f32_set, "f32-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (float, F64);
 
-  /* br-if-uf4->= a:24 _:8 b:24 invert:1 _:7 offset:24
+  /* s64-set! ptr:8 idx:8 val:8
    *
-   * If the F64 value in A is >= than the F64 value in B, add OFFSET, a
-   * signed 24-bit number, to the current instruction pointer.
+   * Store the f64 value VAL into the f8 at byte offset IDX from pointer
+   * PTR.
    */
-  VM_DEFINE_OP (191, br_if_f64_ge, "br-if-f64->=", OP3 (X8_S24, X8_S24, B1_X7_L24))
-    {
-      BR_F64_ARITHMETIC (>=);
-    }
+  VM_DEFINE_OP (153, f64_set, "f64-set!", OP1 (X8_S8_S8_S8))
+    PTR_SET (double, F64);
 
-  /* string-set! dst:8 idx:8 src:8
+  /* bind-optionals nargs:24
    *
-   * Store the character SRC into the string DST at index IDX.
+   * Expand the current frame to have NARGS locals, filling in any fresh
+   * values with SCM_UNDEFINED.
    */
-  VM_DEFINE_OP (192, string_set, "string-set!", OP1 (X8_S8_S8_S8))
+  VM_DEFINE_OP (154, bind_optionals, "bind-optionals", DOP1 (X8_F24))
     {
-      scm_t_uint8 dst, idx, src;
-      SCM str, chr;
-      scm_t_uint64 c_idx;
-
-      UNPACK_8_8_8 (op, dst, idx, src);
-      str = SP_REF (dst);
-      c_idx = SP_REF_U64 (idx);
-      chr = SP_REF (src);
+      uint32_t nlocals, nargs;
 
-      VM_VALIDATE_STRING (str, "string-ref");
-      VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref");
+      UNPACK_24 (op, nlocals);
+      nargs = FRAME_LOCALS_COUNT ();
 
-      /* If needed we can speed this up and only SYNC_IP +
-         scm_i_string_writing if the string isn't already a non-shared
-         stringbuf.  */
-      SYNC_IP ();
-      scm_i_string_start_writing (str);
-      scm_i_string_set_x (str, c_idx, SCM_CHAR (chr));
-      scm_i_string_stop_writing ();
+      if (nargs < nlocals)
+        {
+          ALLOC_FRAME (nlocals);
+          while (nargs < nlocals)
+            FP_SET (nargs++, SCM_UNDEFINED);
+        }
 
       NEXT (1);
     }
 
+  VM_DEFINE_OP (155, unused_155, NULL, NOP)
+  VM_DEFINE_OP (156, unused_156, NULL, NOP)
+  VM_DEFINE_OP (157, unused_157, NULL, NOP)
+  VM_DEFINE_OP (158, unused_158, NULL, NOP)
+  VM_DEFINE_OP (159, unused_159, NULL, NOP)
+  VM_DEFINE_OP (160, unused_160, NULL, NOP)
+  VM_DEFINE_OP (161, unused_161, NULL, NOP)
+  VM_DEFINE_OP (162, unused_162, NULL, NOP)
+  VM_DEFINE_OP (163, unused_163, NULL, NOP)
+  VM_DEFINE_OP (164, unused_164, NULL, NOP)
+  VM_DEFINE_OP (165, unused_165, NULL, NOP)
+  VM_DEFINE_OP (166, unused_166, NULL, NOP)
+  VM_DEFINE_OP (167, unused_167, NULL, NOP)
+  VM_DEFINE_OP (168, unused_168, NULL, NOP)
+  VM_DEFINE_OP (169, unused_169, NULL, NOP)
+  VM_DEFINE_OP (170, unused_170, NULL, NOP)
+  VM_DEFINE_OP (171, unused_171, NULL, NOP)
+  VM_DEFINE_OP (172, unused_172, NULL, NOP)
+  VM_DEFINE_OP (173, unused_173, NULL, NOP)
+  VM_DEFINE_OP (174, unused_174, NULL, NOP)
+  VM_DEFINE_OP (175, unused_175, NULL, NOP)
+  VM_DEFINE_OP (176, unused_176, NULL, NOP)
+  VM_DEFINE_OP (177, unused_177, NULL, NOP)
+  VM_DEFINE_OP (178, unused_178, NULL, NOP)
+  VM_DEFINE_OP (179, unused_179, NULL, NOP)
+  VM_DEFINE_OP (180, unused_180, NULL, NOP)
+  VM_DEFINE_OP (181, unused_181, NULL, NOP)
+  VM_DEFINE_OP (182, unused_182, NULL, NOP)
+  VM_DEFINE_OP (183, unused_183, NULL, NOP)
+  VM_DEFINE_OP (184, unused_184, NULL, NOP)
+  VM_DEFINE_OP (185, unused_185, NULL, NOP)
+  VM_DEFINE_OP (186, unused_186, NULL, NOP)
+  VM_DEFINE_OP (187, unused_187, NULL, NOP)
+  VM_DEFINE_OP (188, unused_188, NULL, NOP)
+  VM_DEFINE_OP (189, unused_189, NULL, NOP)
+  VM_DEFINE_OP (190, unused_190, NULL, NOP)
+  VM_DEFINE_OP (191, unused_191, NULL, NOP)
+  VM_DEFINE_OP (192, unused_192, NULL, NOP)
   VM_DEFINE_OP (193, unused_193, NULL, NOP)
   VM_DEFINE_OP (194, unused_194, NULL, NOP)
   VM_DEFINE_OP (195, unused_195, NULL, NOP)
@@ -4119,6 +3344,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
   VM_DEFINE_OP (254, unused_254, NULL, NOP)
   VM_DEFINE_OP (255, unused_255, NULL, NOP)
     {
+
       vm_error_bad_instruction (op);
       abort (); /* never reached */
     }
@@ -4127,29 +3353,12 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
 }
 
 
-#undef ABORT_CONTINUATION_HOOK
+#undef ABORT_HOOK
 #undef ALIGNED_P
 #undef APPLY_HOOK
-#undef ARGS1
-#undef ARGS2
 #undef BEGIN_DISPATCH_SWITCH
-#undef BINARY_INTEGER_OP
-#undef BR_ARITHMETIC
-#undef BR_BINARY
-#undef BR_NARGS
-#undef BR_UNARY
-#undef BV_FIXABLE_INT_REF
-#undef BV_FIXABLE_INT_SET
-#undef BV_FLOAT_REF
-#undef BV_FLOAT_SET
-#undef BV_INT_REF
-#undef BV_INT_SET
 #undef CACHE_REGISTER
 #undef END_DISPATCH_SWITCH
-#undef FREE_VARIABLE_REF
-#undef INIT
-#undef INUM_MAX
-#undef INUM_MIN
 #undef FP_REF
 #undef FP_SET
 #undef FP_SLOT
@@ -4157,32 +3366,17 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
 #undef SP_SET
 #undef NEXT
 #undef NEXT_HOOK
-#undef NEXT_JUMP
-#undef POP_CONTINUATION_HOOK
-#undef PUSH_CONTINUATION_HOOK
-#undef RETURN
+#undef RETURN_HOOK
 #undef RUN_HOOK
-#undef RUN_HOOK0
-#undef RUN_HOOK1
 #undef SYNC_IP
 #undef UNPACK_8_8_8
 #undef UNPACK_8_16
-#undef UNPACK_16_8
 #undef UNPACK_12_12
 #undef UNPACK_24
-#undef VARIABLE_BOUNDP
-#undef VARIABLE_REF
-#undef VARIABLE_SET
-#undef VM_CHECK_FREE_VARIABLE
-#undef VM_CHECK_OBJECT
-#undef VM_CHECK_UNDERFLOW
 #undef VM_DEFINE_OP
 #undef VM_INSTRUCTION_TO_LABEL
 #undef VM_USE_HOOKS
-#undef VM_VALIDATE_ATOMIC_BOX
-#undef VM_VALIDATE_BYTEVECTOR
-#undef VM_VALIDATE_PAIR
-#undef VM_VALIDATE_STRUCT
+#undef VP
 
 /*
 (defun renumber-ops ()
@@ -4196,8 +3390,3 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
           t t nil 1)))))
 (renumber-ops)
 */
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vm-expand.h b/libguile/vm-expand.h
index 787223d07..6cd693ecb 100644
--- a/libguile/vm-expand.h
+++ b/libguile/vm-expand.h
@@ -1,20 +1,21 @@
-/* Copyright (C) 2001 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef VM_LABEL
 #define VM_LABEL(tag) l_##tag
@@ -71,9 +72,3 @@
 #endif /* VM_INSTRUCTION_TO_OPCODE */
 #endif /* VM_INSTRUCTION_TO_LABEL */
 #endif /* VM_INSTRUCTION_TO_TABLE */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vm.c b/libguile/vm.c
index c313119e7..d7b1788d8 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1,59 +1,91 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2018 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2017-2019
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
-#include <stdlib.h>
-#include <alloca.h>
 #include <alignof.h>
-#include <string.h>
+#include <alloca.h>
+#include <errno.h>
+#include <math.h>
 #include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
 #include <unistd.h>
 
 #ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
 #endif
 
-#include "libguile/bdw-gc.h"
+#include "alist.h"
+#include "async.h"
+#include "atomic.h"
+#include "atomics-internal.h"
+#include "bdw-gc.h"
+#include "cache-internal.h"
+#include "continuations.h"
+#include "control.h"
+#include "dynwind.h"
+#include "eval.h"
+#include "extensions.h"
+#include "foreign.h"
+#include "frames.h"
+#include "gc-inline.h"
+#include "gsubr.h"
+#include "hooks.h"
+#include "instructions.h"
+#include "intrinsics.h"
+#include "jit.h"
+#include "keywords.h"
+#include "list.h"
+#include "loader.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "procprop.h"
+#include "programs.h"
+#include "simpos.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "symbols.h"
+#include "values.h"
+#include "vectors.h"
+#include "version.h"
+#include "vm-builtins.h"
+
+#include "vm.h"
+
 #include <gc/gc_mark.h>
 
-#include "libguile/_scm.h"
-#include "libguile/atomic.h"
-#include "libguile/atomics-internal.h"
-#include "libguile/cache-internal.h"
-#include "libguile/control.h"
-#include "libguile/frames.h"
-#include "libguile/gc-inline.h"
-#include "libguile/instructions.h"
-#include "libguile/loader.h"
-#include "libguile/programs.h"
-#include "libguile/simpos.h"
-#include "libguile/vm.h"
-#include "libguile/vm-builtins.h"
+#if (defined __GNUC__)
+# define SCM_NOINLINE __attribute__ ((__noinline__))
+#else
+# define SCM_NOINLINE /* noinline */
+#endif
 
 static int vm_default_engine = SCM_VM_REGULAR_ENGINE;
 
 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
    (system vm vm), which might not be loaded before an error happens. */
-static SCM sym_vm_run;
-static SCM sym_vm_error;
 static SCM sym_keyword_argument_error;
 static SCM sym_regular;
 static SCM sym_debug;
@@ -122,7 +154,7 @@ scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
   frame->stack_holder = data;
   frame->fp_offset = data->fp_offset;
   frame->sp_offset = data->stack_size;
-  frame->ip = data->ra;
+  frame->ip = data->vra;
 
   return 1;
 }
@@ -130,11 +162,13 @@ scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
 /* Ideally we could avoid copying the C stack if the continuation root
    is inside VM code, and call/cc was invoked within that same call to
    vm_run.  That's currently not implemented.  */
-SCM
-scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
-                        union scm_vm_stack_element *fp,
-                        union scm_vm_stack_element *sp, scm_t_uint32 *ra,
-                        scm_t_dynstack *dynstack, scm_t_uint32 flags)
+static SCM
+capture_stack (union scm_vm_stack_element *stack_top,
+               union scm_vm_stack_element *fp,
+               union scm_vm_stack_element *sp,
+               uint32_t *vra,
+               uint8_t *mra,
+               scm_t_dynstack *dynstack, uint32_t flags)
 {
   struct scm_vm_cont *p;
 
@@ -142,7 +176,8 @@ scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
   p->stack_size = stack_top - sp;
   p->stack_bottom = scm_gc_malloc (p->stack_size * sizeof (*p->stack_bottom),
                                    "capture_vm_cont");
-  p->ra = ra;
+  p->vra = vra;
+  p->mra = mra;
   p->fp_offset = stack_top - fp;
   memcpy (p->stack_bottom, sp, p->stack_size * sizeof (*p->stack_bottom));
   p->dynstack = dynstack;
@@ -150,102 +185,92 @@ scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
   return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p);
 }
 
-struct return_to_continuation_data
+SCM
+scm_i_capture_current_stack (void)
 {
-  struct scm_vm_cont *cp;
+  scm_thread *thread;
   struct scm_vm *vp;
-};
-
-/* Called with the GC lock to prevent the stack marker from traversing a
-   stack in an inconsistent state.  */
-static void *
-vm_return_to_continuation_inner (void *data_ptr)
-{
-  struct return_to_continuation_data *data = data_ptr;
-  struct scm_vm *vp = data->vp;
-  struct scm_vm_cont *cp = data->cp;
 
-  /* We know that there is enough space for the continuation, because we
-     captured it in the past.  However there may have been an expansion
-     since the capture, so we may have to re-link the frame
-     pointers.  */
-  memcpy (vp->stack_top - cp->stack_size,
-          cp->stack_bottom,
-          cp->stack_size * sizeof (*cp->stack_bottom));
-  vp->fp = vp->stack_top - cp->fp_offset;
-  vm_restore_sp (vp, vp->stack_top - cp->stack_size);
+  thread = SCM_I_CURRENT_THREAD;
+  vp = &thread->vm;
 
-  return NULL;
+  return capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip, NULL,
+                        scm_dynstack_capture_all (&thread->dynstack),
+                        0);
 }
 
+#define FOR_EACH_HOOK(M) \
+  M(apply) \
+  M(return) \
+  M(next) \
+  M(abort)
+
 static void
-vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n,
-                           union scm_vm_stack_element *argv)
+vm_hook_compute_enabled (scm_thread *thread, SCM hook, uint8_t *enabled)
 {
-  struct scm_vm_cont *cp;
-  union scm_vm_stack_element *argv_copy;
-  struct return_to_continuation_data data;
-
-  argv_copy = alloca (n * sizeof (*argv));
-  memcpy (argv_copy, argv, n * sizeof (*argv));
-
-  cp = SCM_VM_CONT_DATA (cont);
+  if (thread->vm.trace_level <= 0
+      || thread->vm.engine == SCM_VM_REGULAR_ENGINE
+      || scm_is_false (hook)
+      || scm_is_true (scm_hook_empty_p (hook)))
+    *enabled = 0;
+  else
+    *enabled = 1;
+}
 
-  data.cp = cp;
-  data.vp = vp;
-  GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data);
+static void
+vm_recompute_disable_mcode (scm_thread *thread)
+{
+  uint8_t was_disabled = thread->vm.disable_mcode;
+  thread->vm.disable_mcode = 0;
 
-  /* Now we have the continuation properly copied over.  We just need to
-     copy on an empty frame and the return values, as the continuation
-     expects.  */
-  vm_push_sp (vp, vp->sp - 3 - n);
-  vp->sp[n+2].as_scm = SCM_BOOL_F;
-  vp->sp[n+1].as_scm = SCM_BOOL_F;
-  vp->sp[n].as_scm = SCM_BOOL_F;
-  memcpy(vp->sp, argv_copy, n * sizeof (union scm_vm_stack_element));
+#define DISABLE_MCODE_IF_HOOK_ENABLED(h) \
+  if (thread->vm.h##_hook_enabled)       \
+    thread->vm.disable_mcode = 1;
+  FOR_EACH_HOOK (DISABLE_MCODE_IF_HOOK_ENABLED);
+#undef DISABLE_MCODE_IF_HOOK_ENABLED
 
-  vp->ip = cp->ra;
+  if (thread->vm.disable_mcode && !was_disabled)
+    scm_jit_clear_mcode_return_addresses (thread);
 }
 
-static struct scm_vm * thread_vm (scm_i_thread *t);
-SCM
-scm_i_capture_current_stack (void)
+static int
+set_vm_trace_level (scm_thread *thread, int level)
 {
-  scm_i_thread *thread;
-  struct scm_vm *vp;
+  int old_level;
+  struct scm_vm *vp = &thread->vm;
 
-  thread = SCM_I_CURRENT_THREAD;
-  vp = thread_vm (thread);
+  old_level = vp->trace_level;
+  vp->trace_level = level;
+  vp->disable_mcode = 0;
+#define RESET_LEVEL(h) \
+  vm_hook_compute_enabled (thread, vp->h##_hook, &vp->h##_hook_enabled);
+  FOR_EACH_HOOK (RESET_LEVEL);
+#undef RESET_LEVEL
+  vm_recompute_disable_mcode (thread);
 
-  return scm_i_vm_capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip,
-                                 scm_dynstack_capture_all (&thread->dynstack),
-                                 0);
+  return old_level;
 }
 
-static void vm_dispatch_apply_hook (struct scm_vm *vp) SCM_NOINLINE;
-static void vm_dispatch_push_continuation_hook (struct scm_vm *vp) SCM_NOINLINE;
-static void vm_dispatch_pop_continuation_hook
-  (struct scm_vm *vp, union scm_vm_stack_element *old_fp) SCM_NOINLINE;
-static void vm_dispatch_next_hook (struct scm_vm *vp) SCM_NOINLINE;
-static void vm_dispatch_abort_hook (struct scm_vm *vp) SCM_NOINLINE;
+/* Return the first integer greater than or equal to LEN such that
+   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
+#define ROUND_UP(len, align)					\
+  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
 
 static void
-vm_dispatch_hook (struct scm_vm *vp, int hook_num,
-                  union scm_vm_stack_element *argv, int n)
+invoke_hook (scm_thread *thread, SCM hook)
 {
-  SCM hook;
+  struct scm_vm *vp = &thread->vm;
   struct scm_frame c_frame;
   scm_t_cell *frame;
+  SCM scm_frame;
   int saved_trace_level;
+  uint8_t saved_compare_result;
 
-  hook = vp->hooks[hook_num];
-
-  if (SCM_LIKELY (scm_is_false (hook))
-      || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
+  if (scm_is_false (hook) || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
     return;
 
-  saved_trace_level = vp->trace_level;
-  vp->trace_level = 0;
+  saved_trace_level = set_vm_trace_level (thread, 0);
+  saved_compare_result = vp->compare_result;
 
   /* Allocate a frame object on the stack.  This is more efficient than calling
      `scm_c_make_frame ()' to allocate on the heap, but it forces hooks to not
@@ -262,423 +287,69 @@ vm_dispatch_hook (struct scm_vm *vp, int hook_num,
 
   /* Arrange for FRAME to be 8-byte aligned, like any other cell.  */
   frame = alloca (sizeof (*frame) + 8);
-  frame = (scm_t_cell *) ROUND_UP ((scm_t_uintptr) frame, 8UL);
+  frame = (scm_t_cell *) ROUND_UP ((uintptr_t) frame, 8UL);
 
   frame->word_0 = SCM_PACK (scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8));
   frame->word_1 = SCM_PACK_POINTER (&c_frame);
 
-  if (n == 0)
-    {
-      SCM args[1];
-
-      args[0] = SCM_PACK_POINTER (frame);
-      scm_c_run_hookn (hook, args, 1);
-    }
-  else if (n == 1)
-    {
-      SCM args[2];
-
-      args[0] = SCM_PACK_POINTER (frame);
-      args[1] = argv[0].as_scm;
-      scm_c_run_hookn (hook, args, 2);
-    }
-  else
-    {
-      SCM args = SCM_EOL;
-      int i;
-
-      for (i = 0; i < n; i++)
-        args = scm_cons (argv[i].as_scm, args);
-      scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args));
-    }
+  scm_frame = SCM_PACK_POINTER (frame);
+  scm_c_run_hookn (hook, &scm_frame, 1);
 
-  vp->trace_level = saved_trace_level;
+  vp->compare_result = saved_compare_result;
+  set_vm_trace_level (thread, saved_trace_level);
 }
 
-static void
-vm_dispatch_apply_hook (struct scm_vm *vp)
-{
-  return vm_dispatch_hook (vp, SCM_VM_APPLY_HOOK, NULL, 0);
-}
-static void vm_dispatch_push_continuation_hook (struct scm_vm *vp)
-{
-  return vm_dispatch_hook (vp, SCM_VM_PUSH_CONTINUATION_HOOK, NULL, 0);
-}
-static void vm_dispatch_pop_continuation_hook (struct scm_vm *vp,
-                                               union scm_vm_stack_element *old_fp)
-{
-  return vm_dispatch_hook (vp, SCM_VM_POP_CONTINUATION_HOOK,
-                           vp->sp, SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1);
-}
-static void vm_dispatch_next_hook (struct scm_vm *vp)
-{
-  return vm_dispatch_hook (vp, SCM_VM_NEXT_HOOK, NULL, 0);
-}
-static void vm_dispatch_abort_hook (struct scm_vm *vp)
-{
-  return vm_dispatch_hook (vp, SCM_VM_ABORT_CONTINUATION_HOOK,
-                           vp->sp, SCM_FRAME_NUM_LOCALS (vp->fp, vp->sp) - 1);
-}
-
-static void
-vm_abort (struct scm_vm *vp, SCM tag, size_t nargs,
-          scm_i_jmp_buf *current_registers) SCM_NORETURN;
-
-static void
-vm_abort (struct scm_vm *vp, SCM tag, size_t nargs,
-          scm_i_jmp_buf *current_registers)
-{
-  size_t i;
-  SCM *argv;
-  
-  argv = alloca (nargs * sizeof (SCM));
-  for (i = 0; i < nargs; i++)
-    argv[i] = vp->sp[nargs - i - 1].as_scm;
-
-  vp->sp = vp->fp;
-
-  scm_c_abort (vp, tag, nargs, argv, current_registers);
-}
-
-struct vm_reinstate_partial_continuation_data
-{
-  struct scm_vm *vp;
-  struct scm_vm_cont *cp;
-};
-
-static void *
-vm_reinstate_partial_continuation_inner (void *data_ptr)
-{
-  struct vm_reinstate_partial_continuation_data *data = data_ptr;
-  struct scm_vm *vp = data->vp;
-  struct scm_vm_cont *cp = data->cp;
-
-  memcpy (vp->fp - cp->stack_size,
-          cp->stack_bottom,
-          cp->stack_size * sizeof (*cp->stack_bottom));
-
-  vp->fp -= cp->fp_offset;
-  vp->ip = cp->ra;
-
-  return NULL;
-}
-
-static void
-vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
-                                   scm_t_dynstack *dynstack,
-                                   scm_i_jmp_buf *registers)
-{
-  struct vm_reinstate_partial_continuation_data data;
-  struct scm_vm_cont *cp;
-  union scm_vm_stack_element *args;
-  scm_t_ptrdiff old_fp_offset;
-
-  args = alloca (nargs * sizeof (*args));
-  memcpy (args, vp->sp, nargs * sizeof (*args));
-
-  cp = SCM_VM_CONT_DATA (cont);
-
-  old_fp_offset = vp->stack_top - vp->fp;
-
-  vm_push_sp (vp, vp->fp - (cp->stack_size + nargs + 1));
-
-  data.vp = vp;
-  data.cp = cp;
-  GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner, &data);
-
-  /* The resume continuation will expect ARGS on the stack as if from a
-     multiple-value return.  Fill in the closure slot with #f, and copy
-     the arguments into place.  */
-  vp->sp[nargs].as_scm = SCM_BOOL_F;
-  memcpy (vp->sp, args, nargs * sizeof (*args));
+#define DEFINE_INVOKE_HOOK(h) \
+  static void                                             \
+  invoke_##h##_hook (scm_thread *thread) SCM_NOINLINE;    \
+  static void                                             \
+  invoke_##h##_hook (scm_thread *thread)                  \
+  {                                                       \
+    if (thread->vm.h##_hook_enabled)                      \
+      return invoke_hook (thread, thread->vm.h##_hook);   \
+  }
 
-  /* The prompt captured a slice of the dynamic stack.  Here we wind
-     those entries onto the current thread's stack.  We also have to
-     relocate any prompts that we see along the way.  */
-  {
-    scm_t_bits *walk;
+FOR_EACH_HOOK (DEFINE_INVOKE_HOOK)
 
-    for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
-         SCM_DYNSTACK_TAG (walk);
-         walk = SCM_DYNSTACK_NEXT (walk))
-      {
-        scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
-
-        if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
-          scm_dynstack_wind_prompt (dynstack, walk, old_fp_offset, registers);
-        else
-          scm_dynstack_wind_1 (dynstack, walk);
-      }
-  }
-}
+#undef DEFINE_INVOKE_HOOK
 
 
 /*
  * VM Error Handling
  */
 
-static void vm_error (const char *msg, SCM arg) SCM_NORETURN;
-static void vm_error_bad_instruction (scm_t_uint32 inst) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_unbound (SCM sym) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_variable (const char *func_name, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_kwargs_missing_value (SCM proc, SCM kw) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_char (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_mutable_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_string (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_atomic_box (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_mutable_bytevector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_a_mutable_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_out_of_range_int64 (const char *subr, scm_t_int64 idx) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_continuation_not_rewindable (SCM cont) SCM_NORETURN SCM_NOINLINE;
 
-static void
-vm_error (const char *msg, SCM arg)
-{
-  scm_throw (sym_vm_error,
-             scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
-                         SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
-  abort(); /* not reached */
-}
+static void vm_error_bad_instruction (uint32_t inst) SCM_NORETURN SCM_NOINLINE;
 
 static void
-vm_error_bad_instruction (scm_t_uint32 inst)
+vm_error_bad_instruction (uint32_t inst)
 {
-  vm_error ("VM: Bad instruction: ~s", scm_from_uint32 (inst));
-}
-
-static void
-vm_error_unbound (SCM sym)
-{
-  scm_error_scm (scm_misc_error_key, SCM_BOOL_F,
-                 scm_from_latin1_string ("Unbound variable: ~s"),
-                 scm_list_1 (sym), SCM_BOOL_F);
-}
-
-static void
-vm_error_not_a_variable (const char *func_name, SCM x)
-{
-  scm_error (scm_arg_type_key, func_name, "Not a variable: ~S",
-             scm_list_1 (x), scm_list_1 (x));
-}
-
-static void
-vm_error_apply_to_non_list (SCM x)
-{
-  scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
-             scm_list_1 (x), scm_list_1 (x));
-}
-
-static void
-vm_error_kwargs_missing_value (SCM proc, SCM kw)
-{
-  scm_error_scm (sym_keyword_argument_error, proc,
-                 scm_from_latin1_string ("Keyword argument has no value"),
-                 SCM_EOL, scm_list_1 (kw));
-}
-
-static void
-vm_error_kwargs_invalid_keyword (SCM proc, SCM obj)
-{
-  scm_error_scm (sym_keyword_argument_error, proc,
-                 scm_from_latin1_string ("Invalid keyword"),
-                 SCM_EOL, scm_list_1 (obj));
-}
-
-static void
-vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw)
-{
-  scm_error_scm (sym_keyword_argument_error, proc,
-                 scm_from_latin1_string ("Unrecognized keyword"),
-                 SCM_EOL, scm_list_1 (kw));
-}
-
-static void
-vm_error_wrong_num_args (SCM proc)
-{
-  scm_wrong_num_args (proc);
-}
-
-static void
-vm_error_wrong_type_apply (SCM proc)
-{
-  scm_error (scm_arg_type_key, NULL, "Wrong type to apply: ~S",
-             scm_list_1 (proc), scm_list_1 (proc));
-}
-
-static void
-vm_error_not_a_char (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "char");
-}
-
-static void
-vm_error_not_a_pair (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "pair");
-}
-
-static void
-vm_error_not_a_mutable_pair (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "mutable pair");
-}
-
-static void
-vm_error_not_a_string (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "string");
-}
-
-static void
-vm_error_not_a_atomic_box (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "atomic box");
-}
-
-static void
-vm_error_not_a_bytevector (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "bytevector");
-}
-
-static void
-vm_error_not_a_mutable_bytevector (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "mutable bytevector");
-}
-
-static void
-vm_error_not_a_struct (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "struct");
-}
-
-static void
-vm_error_not_a_vector (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "vector");
-}
-
-static void
-vm_error_not_a_mutable_vector (const char *subr, SCM x)
-{
-  scm_wrong_type_arg_msg (subr, 1, x, "mutable vector");
-}
-
-static void
-vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx)
-{
-  scm_out_of_range (subr, scm_from_uint64 (idx));
-}
-
-static void
-vm_error_out_of_range_int64 (const char *subr, scm_t_int64 idx)
-{
-  scm_out_of_range (subr, scm_from_int64 (idx));
-}
-
-static void
-vm_error_no_values (void)
-{
-  vm_error ("Zero values returned to single-valued continuation",
-            SCM_UNDEFINED);
-}
-
-static void
-vm_error_not_enough_values (void)
-{
-  vm_error ("Too few values returned to continuation", SCM_UNDEFINED);
-}
-
-static void
-vm_error_wrong_number_of_values (scm_t_uint32 expected)
-{
-  vm_error ("Wrong number of values returned to continuation (expected ~a)",
-            scm_from_uint32 (expected));
-}
-
-static void
-vm_error_continuation_not_rewindable (SCM cont)
-{
-  vm_error ("Unrewindable partial continuation", cont);
+  fprintf (stderr, "VM: Bad instruction: %x\n", inst);
+  abort ();
 }
 
 
 
 
 static SCM vm_boot_continuation;
-static SCM vm_builtin_apply;
-static SCM vm_builtin_values;
-static SCM vm_builtin_abort_to_prompt;
-static SCM vm_builtin_call_with_values;
-static SCM vm_builtin_call_with_current_continuation;
-
-static const scm_t_uint32 vm_boot_continuation_code[] = {
-  SCM_PACK_OP_24 (halt, 0)
-};
 
-static const scm_t_uint32 vm_apply_non_program_code[] = {
-  SCM_PACK_OP_24 (apply_non_program, 0)
-};
-
-static const scm_t_uint32 vm_builtin_apply_code[] = {
-  SCM_PACK_OP_24 (assert_nargs_ge, 3),
-  SCM_PACK_OP_24 (tail_apply, 0), /* proc in r1, args from r2 */
-};
-
-static const scm_t_uint32 vm_builtin_values_code[] = {
-  SCM_PACK_OP_24 (return_values, 0) /* vals from r1 */
-};
-
-static const scm_t_uint32 vm_builtin_abort_to_prompt_code[] = {
-  SCM_PACK_OP_24 (assert_nargs_ge, 2),
-  SCM_PACK_OP_24 (abort, 0), /* tag in r1, vals from r2 */
-  /* FIXME: Partial continuation should capture caller regs.  */
-  SCM_PACK_OP_24 (return_values, 0) /* vals from r1 */
-};
-
-static const scm_t_uint32 vm_builtin_call_with_values_code[] = {
-  SCM_PACK_OP_24 (assert_nargs_ee, 3),
-  SCM_PACK_OP_24 (alloc_frame, 7),
-  SCM_PACK_OP_12_12 (mov, 0, 5),
-  SCM_PACK_OP_24 (call, 6), SCM_PACK_OP_ARG_8_24 (0, 1),
-  SCM_PACK_OP_24 (long_fmov, 0), SCM_PACK_OP_ARG_8_24 (0, 2),
-  SCM_PACK_OP_24 (tail_call_shuffle, 7)
-};
+#define DECLARE_BUILTIN(builtin, BUILTIN, req, opt, rest)               \
+  static SCM vm_builtin_##builtin;                                      \
+  static uint32_t *vm_builtin_##builtin##_code;
+FOR_EACH_VM_BUILTIN (DECLARE_BUILTIN)
+#undef DECLARE_BUILTIN
 
-static const scm_t_uint32 vm_builtin_call_with_current_continuation_code[] = {
-  SCM_PACK_OP_24 (assert_nargs_ee, 2),
-  SCM_PACK_OP_24 (call_cc, 0)
-};
-
-static const scm_t_uint32 vm_handle_interrupt_code[] = {
-  SCM_PACK_OP_24 (alloc_frame, 3),
-  SCM_PACK_OP_12_12 (mov, 0, 2),
-  SCM_PACK_OP_24 (call, 2), SCM_PACK_OP_ARG_8_24 (0, 1),
-  SCM_PACK_OP_24 (return_from_interrupt, 0)
+static const uint32_t vm_boot_continuation_code[] = {
+  SCM_PACK_OP_24 (halt, 0)
 };
 
-
 int
-scm_i_vm_is_boot_continuation_code (scm_t_uint32 *ip)
+scm_i_vm_is_boot_continuation_code (uint32_t *ip)
 {
   return ip == vm_boot_continuation_code;
 }
 
-static SCM
+SCM
 scm_vm_builtin_ref (unsigned idx)
 {
   switch (idx)
@@ -741,6 +412,77 @@ scm_init_vm_builtins (void)
                       scm_vm_builtin_index_to_name);
 }
 
+static uint32_t*
+instrumented_code (const uint32_t *code, size_t byte_size)
+{
+  uint32_t *ret, *write;
+  ret = scm_i_alloc_primitive_code_with_instrumentation (byte_size / 4, &write);
+  memcpy (write, code, byte_size);
+  return ret;
+}
+
+static void
+define_vm_builtins (void)
+{
+  const uint32_t apply_code[] = {
+    SCM_PACK_OP_24 (assert_nargs_ge, 3),
+    SCM_PACK_OP_12_12 (shuffle_down, 1, 0),
+    SCM_PACK_OP_24 (expand_apply_argument, 0),
+    SCM_PACK_OP_24 (tail_call, 0),
+  };
+
+  const uint32_t values_code[] = {
+    SCM_PACK_OP_12_12 (shuffle_down, 1, 0),
+    SCM_PACK_OP_24 (return_values, 0)
+  };
+
+  const uint32_t abort_to_prompt_code[] = {
+    SCM_PACK_OP_24 (assert_nargs_ge, 2),
+    SCM_PACK_OP_24 (abort, 0), /* tag in r1, vals from r2 */
+    /* FIXME: Partial continuation should capture caller regs.  */
+    SCM_PACK_OP_24 (return_values, 0) /* vals from r0 */
+  };
+
+  const uint32_t call_with_values_code[] = {
+    SCM_PACK_OP_24 (assert_nargs_ee, 3),
+    SCM_PACK_OP_24 (alloc_frame, 8),
+    SCM_PACK_OP_12_12 (mov, 0, 6),
+    SCM_PACK_OP_24 (call, 7), SCM_PACK_OP_ARG_8_24 (0, 1),
+    SCM_PACK_OP_24 (long_fmov, 0), SCM_PACK_OP_ARG_8_24 (0, 2),
+    SCM_PACK_OP_12_12 (shuffle_down, 7, 1),
+    SCM_PACK_OP_24 (tail_call, 0)
+  };
+
+  const uint32_t call_with_current_continuation_code[] = {
+    SCM_PACK_OP_24 (assert_nargs_ee, 2),
+    SCM_PACK_OP_12_12 (mov, 1, 0),
+    SCM_PACK_OP_24 (capture_continuation, 0),
+    SCM_PACK_OP_24 (tail_call, 0)
+  };
+
+  /* This one isn't exactly a builtin but we still handle it here.  */
+  const uint32_t handle_interrupt_code[] = {
+    SCM_PACK_OP_24 (alloc_frame, 4),
+    SCM_PACK_OP_12_12 (mov, 0, 3),
+    SCM_PACK_OP_24 (call, 3), SCM_PACK_OP_ARG_8_24 (0, 1),
+    SCM_PACK_OP_24 (return_from_interrupt, 0)
+  };
+
+#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest)                \
+  {                                                                     \
+    size_t sz = sizeof (builtin##_code);                                \
+    vm_builtin_##builtin##_code = instrumented_code (builtin##_code, sz); \
+    vm_builtin_##builtin =                                              \
+      scm_cell (scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE,           \
+                (scm_t_bits)vm_builtin_##builtin##_code);               \
+  }
+  FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
+#undef INDEX_TO_NAME
+
+  scm_vm_intrinsics.handle_interrupt_code =
+    instrumented_code (handle_interrupt_code, sizeof (handle_interrupt_code));
+}
+
 SCM
 scm_i_call_with_current_continuation (SCM proc)
 {
@@ -768,8 +510,7 @@ scm_i_call_with_current_continuation (SCM proc)
 #undef VM_USE_HOOKS
 #undef VM_NAME
 
-typedef SCM (*scm_t_vm_engine) (scm_i_thread *current_thread, struct scm_vm *vp,
-                                scm_i_jmp_buf *registers, int resume);
+typedef SCM (*scm_t_vm_engine) (scm_thread *current_thread);
 
 static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
   { vm_regular_engine, vm_debug_engine };
@@ -849,14 +590,18 @@ expand_stack (union scm_vm_stack_element *old_bottom, size_t old_size,
 }
 #undef FUNC_NAME
 
-static struct scm_vm *
-make_vm (void)
-#define FUNC_NAME "make_vm"
+void
+scm_i_vm_prepare_stack (struct scm_vm *vp)
 {
-  int i;
-  struct scm_vm *vp;
-
-  vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
+  /* Not racey, as this will be run the first time a thread enters
+     Guile.  */
+  if (page_size == 0)
+    {
+      page_size = getpagesize ();
+      /* page_size should be a power of two.  */
+      if (page_size & (page_size - 1))
+        abort ();
+    }
 
   vp->stack_size = page_size / sizeof (union scm_vm_stack_element);
   vp->stack_bottom = allocate_stack (vp->stack_size);
@@ -872,24 +617,23 @@ make_vm (void)
   vp->sp = vp->stack_top;
   vp->sp_min_since_gc = vp->sp;
   vp->fp = vp->stack_top;
+  vp->compare_result = SCM_F_COMPARE_NONE;
   vp->engine = vm_default_engine;
   vp->trace_level = 0;
-  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
-    vp->hooks[i] = SCM_BOOL_F;
-
-  return vp;
+#define INIT_HOOK(h) vp->h##_hook = SCM_BOOL_F;
+  FOR_EACH_HOOK (INIT_HOOK)
+#undef INIT_HOOK
 }
-#undef FUNC_NAME
 
 static void
 return_unused_stack_to_os (struct scm_vm *vp)
 {
 #if HAVE_SYS_MMAN_H
-  scm_t_uintptr lo = (scm_t_uintptr) vp->stack_bottom;
-  scm_t_uintptr hi = (scm_t_uintptr) vp->sp;
+  uintptr_t lo = (uintptr_t) vp->stack_bottom;
+  uintptr_t hi = (uintptr_t) vp->sp;
   /* The second condition is needed to protect against wrap-around.  */
   if (vp->sp_min_since_gc >= vp->stack_bottom && vp->sp >= vp->sp_min_since_gc)
-    lo = (scm_t_uintptr) vp->sp_min_since_gc;
+    lo = (uintptr_t) vp->sp_min_since_gc;
 
   lo &= ~(page_size - 1U); /* round down */
   hi &= ~(page_size - 1U); /* round down */
@@ -918,8 +662,8 @@ return_unused_stack_to_os (struct scm_vm *vp)
 #define SLOT_MAP_CACHE_SIZE 32U
 struct slot_map_cache_entry
 {
-  scm_t_uint32 *ip;
-  const scm_t_uint8 *map;
+  uint32_t *ip;
+  const uint8_t *map;
 };
 
 struct slot_map_cache
@@ -927,13 +671,13 @@ struct slot_map_cache
   struct slot_map_cache_entry entries[SLOT_MAP_CACHE_SIZE];
 };
 
-static const scm_t_uint8 *
-find_slot_map (scm_t_uint32 *ip, struct slot_map_cache *cache)
+static const uint8_t *
+find_slot_map (uint32_t *ip, struct slot_map_cache *cache)
 {
   /* The lower two bits should be zero.  FIXME: Use a better hash
      function; we don't expose scm_raw_hashq currently.  */
-  size_t slot = (((scm_t_uintptr) ip) >> 2) % SLOT_MAP_CACHE_SIZE;
-  const scm_t_uint8 *map;
+  size_t slot = (((uintptr_t) ip) >> 2) % SLOT_MAP_CACHE_SIZE;
+  const uint8_t *map;
 
   if (cache->entries[slot].ip == ip)
     map = cache->entries[slot].map;
@@ -951,7 +695,7 @@ enum slot_desc
   {
     SLOT_DESC_DEAD = 0,
     SLOT_DESC_LIVE_RAW = 1,
-    SLOT_DESC_LIVE_SCM = 2,
+    SLOT_DESC_LIVE_GC = 2,
     SLOT_DESC_UNUSED = 3
   };
 
@@ -966,7 +710,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
      activation, due to multiple threads or per-instruction hooks, and
      providing slot maps for all points in a program would take a
      prohibitive amount of space.  */
-  const scm_t_uint8 *slot_map = NULL;
+  const uint8_t *slot_map = NULL;
   void *upper = (void *) GC_greatest_plausible_heap_addr;
   void *lower = (void *) GC_least_plausible_heap_addr;
   struct slot_map_cache cache;
@@ -977,11 +721,11 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
        fp < vp->stack_top;
        fp = SCM_FRAME_DYNAMIC_LINK (fp))
     {
-      scm_t_ptrdiff nlocals = SCM_FRAME_NUM_LOCALS (fp, sp);
+      ptrdiff_t nlocals = SCM_FRAME_NUM_LOCALS (fp, sp);
       size_t slot = nlocals - 1;
       for (slot = nlocals - 1; sp < fp; sp++, slot--)
         {
-          enum slot_desc desc = SLOT_DESC_LIVE_SCM;
+          enum slot_desc desc = SLOT_DESC_LIVE_GC;
 
           if (slot_map)
             desc = (slot_map[slot / 4U] >> ((slot % 4U) * 2)) & 3U;
@@ -991,7 +735,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
             case SLOT_DESC_LIVE_RAW:
               break;
             case SLOT_DESC_UNUSED:
-            case SLOT_DESC_LIVE_SCM:
+            case SLOT_DESC_LIVE_GC:
               if (SCM_NIMP (sp->as_scm) &&
                   sp->as_ptr >= lower && sp->as_ptr <= upper)
                 mark_stack_ptr = GC_mark_and_push (sp->as_ptr,
@@ -1011,7 +755,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
          Note that there may be other reasons to not have a dead slots
          map, e.g. if all of the frame's slots below the callee frame
          are live.  */
-      slot_map = find_slot_map (SCM_FRAME_RETURN_ADDRESS (fp), &cache);
+      slot_map = find_slot_map (SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp), &cache);
     }
 
   return_unused_stack_to_os (vp);
@@ -1024,8 +768,9 @@ void
 scm_i_vm_free_stack (struct scm_vm *vp)
 {
   free_stack (vp->stack_bottom, vp->stack_size);
-  vp->stack_bottom = vp->stack_top = vp->stack_limit = NULL;
-  vp->stack_size = 0;
+  /* Not strictly necessary, but good to avoid confusion when debugging
+     thread-related GC issues.  */
+  memset (vp, 0, sizeof (*vp));
 }
 
 struct vm_expand_stack_data
@@ -1043,7 +788,7 @@ vm_expand_stack_inner (void *data_ptr)
   struct scm_vm *vp = data->vp;
   union scm_vm_stack_element *old_top, *new_bottom;
   size_t new_size;
-  scm_t_ptrdiff reloc;
+  ptrdiff_t reloc;
 
   old_top = vp->stack_top;
   new_size = vp->stack_size;
@@ -1067,7 +812,7 @@ vm_expand_stack_inner (void *data_ptr)
   return new_bottom;
 }
 
-static scm_t_ptrdiff
+static ptrdiff_t
 current_overflow_size (struct scm_vm *vp)
 {
   if (scm_is_pair (vp->overflow_handler_stack))
@@ -1076,9 +821,9 @@ current_overflow_size (struct scm_vm *vp)
 }
 
 static int
-should_handle_stack_overflow (struct scm_vm *vp, scm_t_ptrdiff stack_size)
+should_handle_stack_overflow (struct scm_vm *vp, ptrdiff_t stack_size)
 {
-  scm_t_ptrdiff overflow_size = current_overflow_size (vp);
+  ptrdiff_t overflow_size = current_overflow_size (vp);
   return overflow_size >= 0 && stack_size >= overflow_size;
 }
 
@@ -1120,7 +865,7 @@ unwind_overflow_handler (void *ptr)
 static void
 vm_expand_stack (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
 {
-  scm_t_ptrdiff stack_size = vp->stack_top - new_sp;
+  ptrdiff_t stack_size = vp->stack_top - new_sp;
 
   if (stack_size > vp->stack_size)
     {
@@ -1180,37 +925,616 @@ vm_expand_stack (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
     }
 }
 
-static struct scm_vm *
-thread_vm (scm_i_thread *t)
+static uint32_t
+frame_locals_count (scm_thread *thread)
+{
+  return SCM_FRAME_NUM_LOCALS (thread->vm.fp, thread->vm.sp);
+}
+
+static void
+thread_expand_stack (scm_thread *thread, union scm_vm_stack_element *new_sp)
+{
+  vm_expand_stack (&thread->vm, new_sp);
+}
+
+/* This duplicates the inlined "ALLOC_FRAME" macro from vm-engine.c, but
+   it seems to be necessary for perf; the inlined version avoids the
+   needs to flush IP in the common case.  */
+static void
+alloc_frame (scm_thread *thread, uint32_t nlocals)
+{
+  union scm_vm_stack_element *sp = thread->vm.fp - nlocals;
+
+  if (sp < thread->vm.sp_min_since_gc)
+    {
+      if (SCM_UNLIKELY (sp < thread->vm.stack_limit))
+        thread_expand_stack (thread, sp);
+      else
+        thread->vm.sp_min_since_gc = thread->vm.sp = sp;
+    }
+  else
+    thread->vm.sp = sp;
+}
+
+static uint32_t
+compute_kwargs_npositional (scm_thread *thread, uint32_t nreq, uint32_t nopt)
+{
+  uint32_t npositional, nargs;
+
+  nargs = frame_locals_count (thread);
+
+  /* look in optionals for first keyword or last positional */
+  /* starting after the last required positional arg */
+  npositional = nreq;
+  while (/* while we have args */
+         npositional < nargs
+         /* and we still have positionals to fill */
+         && npositional < nreq + nopt
+         /* and we haven't reached a keyword yet */
+         && !scm_is_keyword (SCM_FRAME_LOCAL (thread->vm.fp, npositional)))
+    /* bind this optional arg (by leaving it in place) */
+    npositional++;
+
+  return npositional;
+}
+
+static void
+bind_kwargs (scm_thread *thread, uint32_t npositional, uint32_t nlocals,
+             SCM kwargs, uint8_t strict, uint8_t allow_other_keys)
+{
+  uint32_t nargs, nkw, n;
+  union scm_vm_stack_element *fp;
+
+  nargs = frame_locals_count (thread);
+  nkw = nargs - npositional;
+
+  /* shuffle non-positional arguments above nlocals */
+  alloc_frame (thread, nlocals + nkw);
+
+  fp = thread->vm.fp;
+  n = nkw;
+  while (n--)
+    SCM_FRAME_LOCAL (fp, nlocals + n) = SCM_FRAME_LOCAL (fp, npositional + n);
+
+  /* Fill optionals & keyword args with SCM_UNDEFINED */
+  n = npositional;
+  while (n < nlocals)
+    SCM_FRAME_LOCAL (fp, n++) = SCM_UNDEFINED;
+
+  /* Now bind keywords, in the order given.  */
+  for (n = 0; n < nkw; n++)
+    {
+      SCM kw = SCM_FRAME_LOCAL (fp, nlocals + n);
+
+      if (scm_is_keyword (kw))
+        {
+          SCM walk;
+          for (walk = kwargs; scm_is_pair (walk); walk = SCM_CDR (walk))
+            if (scm_is_eq (SCM_CAAR (walk), kw))
+              {
+                SCM si = SCM_CDAR (walk);
+                if (n + 1 < nkw)
+                  SCM_FRAME_LOCAL (fp, scm_to_uint32 (si)) =
+                    SCM_FRAME_LOCAL (fp, nlocals + n + 1);
+                else
+                  scm_error_scm (sym_keyword_argument_error, SCM_BOOL_F,
+                                 scm_from_latin1_string
+                                 ("Keyword argument has no value"),
+                                 SCM_EOL, scm_list_1 (kw));
+                break;
+              }
+          if (!allow_other_keys && !scm_is_pair (walk))
+            scm_error_scm (sym_keyword_argument_error, SCM_BOOL_F,
+                           scm_from_latin1_string ("Unrecognized keyword"),
+                           SCM_EOL, scm_list_1 (kw));
+          n++;
+        }
+      else if (strict)
+        {
+          scm_error_scm (sym_keyword_argument_error, SCM_BOOL_F,
+                         scm_from_latin1_string ("Invalid keyword"),
+                         SCM_EOL, scm_list_1 (kw));
+        }
+      else
+        {
+          /* Ignore this argument.  It might get consed onto a rest list.  */
+        }
+    }
+}
+
+static SCM
+cons_rest (scm_thread *thread, uint32_t base)
+{
+  SCM rest = SCM_EOL;
+  uint32_t n = frame_locals_count (thread) - base;
+
+  while (n--)
+    rest = scm_inline_cons (thread, SCM_FRAME_LOCAL (thread->vm.fp, base + n),
+                            rest);
+
+  return rest;
+}
+
+static void
+push_interrupt_frame (scm_thread *thread, uint8_t *mra)
+{
+  union scm_vm_stack_element *old_fp, *new_fp;
+  size_t frame_overhead = 3;
+  size_t old_frame_size = frame_locals_count (thread);
+  SCM proc = scm_i_async_pop (thread);
+
+  /* Reserve space for frame and callee.  */
+  alloc_frame (thread, old_frame_size + frame_overhead + 1);
+
+  old_fp = thread->vm.fp;
+  new_fp = SCM_FRAME_SLOT (old_fp, old_frame_size + frame_overhead - 1);
+  SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
+  /* Arrange to return to the same handle-interrupts opcode to handle
+     any additional interrupts.  */
+  SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, thread->vm.ip);
+  SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, mra);
+  SCM_FRAME_LOCAL (new_fp, 0) = proc;
+
+  thread->vm.fp = new_fp;
+}
+
+struct return_to_continuation_data
+{
+  struct scm_vm_cont *cp;
+  struct scm_vm *vp;
+};
+
+/* Called with the GC lock to prevent the stack marker from traversing a
+   stack in an inconsistent state.  */
+static void *
+vm_return_to_continuation_inner (void *data_ptr)
+{
+  struct return_to_continuation_data *data = data_ptr;
+  struct scm_vm *vp = data->vp;
+  struct scm_vm_cont *cp = data->cp;
+
+  /* We know that there is enough space for the continuation, because we
+     captured it in the past.  However there may have been an expansion
+     since the capture, so we may have to re-link the frame
+     pointers.  */
+  memcpy (vp->stack_top - cp->stack_size,
+          cp->stack_bottom,
+          cp->stack_size * sizeof (*cp->stack_bottom));
+  vp->fp = vp->stack_top - cp->fp_offset;
+  vm_restore_sp (vp, vp->stack_top - cp->stack_size);
+
+  return NULL;
+}
+
+static void reinstate_continuation_x (scm_thread *thread, SCM cont) SCM_NORETURN;
+
+static void
+reinstate_continuation_x (scm_thread *thread, SCM cont)
 {
-  if (SCM_UNLIKELY (!t->vp))
-    t->vp = make_vm ();
+  scm_t_contregs *continuation = scm_i_contregs (cont);
+  struct scm_vm *vp = &thread->vm;
+  struct scm_vm_cont *cp;
+  size_t n, i, frame_overhead = 3;
+  union scm_vm_stack_element *argv;
+  struct return_to_continuation_data data;
+
+  if (!scm_is_eq (continuation->root, thread->continuation_root))
+    scm_misc_error
+      ("%continuation-call",
+       "invoking continuation would cross continuation barrier: ~A",
+       scm_list_1 (cont));
+
+  n = frame_locals_count (thread) - 1;
+  argv = alloca (n * sizeof (*argv));
+  memcpy (argv, vp->sp, n * sizeof (*argv));
+
+  cp = SCM_VM_CONT_DATA (continuation->vm_cont);
+
+  data.cp = cp;
+  data.vp = vp;
+  GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data);
+
+  /* Now we have the continuation properly copied over.  We just need to
+     copy on an empty frame and the return values, as the continuation
+     expects.  */
+  vm_push_sp (vp, vp->sp - frame_overhead - n);
+  for (i = 0; i < frame_overhead; i++)
+    vp->sp[n+i].as_scm = SCM_BOOL_F;
+  memcpy(vp->sp, argv, n * sizeof (union scm_vm_stack_element));
 
-  return t->vp;
+  vp->ip = cp->vra;
+
+  scm_i_reinstate_continuation (cont, cp->mra);
 }
 
-struct scm_vm *
-scm_the_vm (void)
+static SCM
+capture_continuation (scm_thread *thread)
 {
-  return thread_vm (SCM_I_CURRENT_THREAD);
+  struct scm_vm *vp = &thread->vm;
+  void *mra = SCM_FRAME_MACHINE_RETURN_ADDRESS (vp->fp);
+  if (mra == scm_jit_return_to_interpreter_trampoline)
+    mra = NULL;
+  SCM vm_cont = capture_stack (vp->stack_top,
+                               SCM_FRAME_DYNAMIC_LINK (vp->fp),
+                               SCM_FRAME_PREVIOUS_SP (vp->fp),
+                               SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp),
+                               mra,
+                               scm_dynstack_capture_all (&thread->dynstack),
+                               0);
+  return scm_i_make_continuation (thread, vm_cont);
+}
+
+struct compose_continuation_data
+{
+  struct scm_vm *vp;
+  struct scm_vm_cont *cp;
+};
+
+static void *
+compose_continuation_inner (void *data_ptr)
+{
+  struct compose_continuation_data *data = data_ptr;
+  struct scm_vm *vp = data->vp;
+  struct scm_vm_cont *cp = data->cp;
+
+  memcpy (vp->fp - cp->stack_size,
+          cp->stack_bottom,
+          cp->stack_size * sizeof (*cp->stack_bottom));
+
+  vp->fp -= cp->fp_offset;
+  vp->ip = cp->vra;
+
+  return cp->mra;
+}
+
+static uint8_t*
+compose_continuation (scm_thread *thread, SCM cont)
+{
+  struct scm_vm *vp = &thread->vm;
+  size_t nargs;
+  struct compose_continuation_data data;
+  struct scm_vm_cont *cp;
+  union scm_vm_stack_element *args;
+  ptrdiff_t old_fp_offset;
+  uint8_t *mra;
+
+  if (SCM_UNLIKELY (! SCM_VM_CONT_REWINDABLE_P (cont)))
+    scm_wrong_type_arg_msg (NULL, 0, cont, "resumable continuation");
+
+  nargs = frame_locals_count (thread) - 1;
+  args = alloca (nargs * sizeof (*args));
+  memcpy (args, vp->sp, nargs * sizeof (*args));
+
+  cp = SCM_VM_CONT_DATA (cont);
+
+  old_fp_offset = vp->stack_top - vp->fp;
+
+  vm_push_sp (vp, vp->fp - (cp->stack_size + nargs));
+
+  data.vp = vp;
+  data.cp = cp;
+  mra = GC_call_with_alloc_lock (compose_continuation_inner, &data);
+
+  /* The resumed continuation will expect ARGS on the stack as if from a
+     multiple-value return.  */
+  memcpy (vp->sp, args, nargs * sizeof (*args));
+
+  /* The prompt captured a slice of the dynamic stack.  Here we wind
+     those entries onto the current thread's stack.  We also have to
+     relocate any prompts that we see along the way.  */
+  {
+    scm_t_bits *walk;
+
+    for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
+         SCM_DYNSTACK_TAG (walk);
+         walk = SCM_DYNSTACK_NEXT (walk))
+      {
+        scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+        if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
+          scm_dynstack_wind_prompt (&thread->dynstack, walk, old_fp_offset,
+                                    thread->vm.registers);
+        else
+          scm_dynstack_wind_1 (&thread->dynstack, walk);
+      }
+  }
+
+  return mra;
+}
+
+static void
+expand_apply_argument (scm_thread *thread)
+{
+  SCM x = thread->vm.sp[0].as_scm;
+  int len = scm_ilength (x);
+
+  if (SCM_UNLIKELY (len < 0))
+    scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
+               scm_list_1 (x), scm_list_1 (x));
+
+  alloc_frame (thread, frame_locals_count (thread) - 1 + len);
+
+  while (len--)
+    {
+      thread->vm.sp[len].as_scm = SCM_CAR (x);
+      x = SCM_CDR (x);
+    }
+}
+
+/* This is here to avoid putting the code for "alloc-frame" in subr
+   calls. */
+static void
+unpack_values_object (scm_thread *thread, SCM obj)
+{
+  size_t n, nvals = scm_i_nvalues (obj);
+  alloc_frame (thread, nvals);
+  for (n = 0; n < nvals; n++)
+    SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_i_value_ref (obj, n);
+}
+
+static void
+foreign_call (scm_thread *thread, SCM cif, SCM pointer)
+{
+  SCM ret;
+  int err = 0;
+
+  ret = scm_i_foreign_call (cif, pointer, &err, thread->vm.sp);
+
+  alloc_frame (thread, 2);
+  SCM_FRAME_LOCAL (thread->vm.fp, 0) = ret;
+  SCM_FRAME_LOCAL (thread->vm.fp, 1) = scm_from_int (err);
+}
+
+static SCM
+capture_delimited_continuation (struct scm_vm *vp,
+                                union scm_vm_stack_element *saved_fp,
+                                uint8_t *saved_mra,
+                                jmp_buf *saved_registers,
+                                scm_t_dynstack *dynstack,
+                                jmp_buf *current_registers)
+{
+  SCM vm_cont;
+  uint32_t flags;
+  union scm_vm_stack_element *base_fp;
+
+  flags = SCM_F_VM_CONT_PARTIAL;
+  /* If we are aborting to a prompt that has the same registers as those
+     of the abort, it means there are no intervening C frames on the
+     stack, and so the continuation can be relocated elsewhere on the
+     stack: it is rewindable.  */
+  if (saved_registers && saved_registers == current_registers)
+    flags |= SCM_F_VM_CONT_REWINDABLE;
+
+  /* Walk the stack until we find the first frame newer than saved_fp.
+     We will save the stack until that frame.  It used to be that we
+     could determine the stack base in O(1) time, but that's no longer
+     the case, since the thunk application doesn't occur where the
+     prompt is saved.  */
+  for (base_fp = vp->fp;
+       SCM_FRAME_DYNAMIC_LINK (base_fp) < saved_fp;
+       base_fp = SCM_FRAME_DYNAMIC_LINK (base_fp));
+
+  if (SCM_FRAME_DYNAMIC_LINK (base_fp) != saved_fp)
+    abort();
+
+  scm_dynstack_relocate_prompts (dynstack, vp->stack_top - base_fp);
+
+  /* Capture from the base_fp to the top thunk application frame.  Don't
+     capture values from the most recent frame, as they are the abort
+     args.  */
+  vm_cont = capture_stack (base_fp, vp->fp, vp->fp, vp->ip,
+                           saved_mra, dynstack, flags);
+
+  return scm_i_make_composable_continuation (vm_cont);
+}
+
+void
+scm_i_vm_abort (SCM *tag_and_argv, size_t n)
+{
+  scm_call_n (vm_builtin_abort_to_prompt, tag_and_argv, n);
+  /* Unreachable.  */
+  abort ();
+}
+
+/* The same as scm_i_vm_abort(), but possibly called in response to
+   resource allocation failures, so we might not be able to make a
+   call, as that might require stack expansion.  Grrr.  */
+void
+scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n)
+{
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+  struct scm_vm *vp = &thread->vm;
+  scm_t_dynstack *dynstack = &thread->dynstack;
+  SCM tag, cont;
+  size_t nargs;
+  scm_t_bits *prompt;
+  scm_t_dynstack_prompt_flags flags;
+  ptrdiff_t fp_offset, sp_offset;
+  union scm_vm_stack_element *fp, *sp;
+  SCM *argv;
+  uint32_t *vra;
+  uint8_t *mra;
+  jmp_buf *registers;
+
+  tag = tag_and_argv[0];
+  argv = tag_and_argv + 1;
+  nargs = n - 1;
+
+  prompt = scm_dynstack_find_prompt (dynstack, tag,
+                                     &flags, &fp_offset, &sp_offset,
+                                     &vra, &mra, &registers);
+
+  if (!prompt)
+    {
+      fprintf (stderr, "guile: fatal: emergency abort to unknown prompt\n");
+      abort ();
+    }
+
+  fp = vp->stack_top - fp_offset;
+  sp = vp->stack_top - sp_offset;
+
+  if (!(flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY))
+    {
+      fprintf (stderr, "guile: fatal: emergency abort to non-linear prompt\n");
+      abort ();
+    }
+
+  cont = SCM_BOOL_F;
+
+  /* Unwind.  */
+  scm_dynstack_unwind (dynstack, prompt);
+
+  /* Continuation gets nargs+1 values: the one more is for the cont.  */
+  sp = sp - nargs - 1;
+
+  /* Shuffle abort arguments down to the prompt continuation.  We have
+     to be jumping to an older part of the stack.  */
+  if (sp < vp->sp)
+    abort ();
+  sp[nargs].as_scm = cont;
+
+  while (nargs--)
+    sp[nargs].as_scm = *argv++;
+
+  /* Restore VM regs */
+  vp->fp = fp;
+  vp->sp = sp;
+  vp->ip = vra;
+
+  /* Jump! */
+  vp->mra_after_abort = mra;
+  longjmp (*registers, 1);
+}
+
+static uint8_t *
+abort_to_prompt (scm_thread *thread, uint8_t *saved_mra)
+{
+  struct scm_vm *vp = &thread->vm;
+  scm_t_dynstack *dynstack = &thread->dynstack;
+  SCM tag, cont;
+  size_t nargs;
+  scm_t_bits *prompt;
+  scm_t_dynstack_prompt_flags flags;
+  ptrdiff_t fp_offset, sp_offset;
+  union scm_vm_stack_element *fp, *sp;
+  uint32_t *vra;
+  uint8_t *mra;
+  jmp_buf *registers;
+
+  tag = SCM_FRAME_LOCAL (vp->fp, 1);
+  nargs = frame_locals_count (thread) - 2;
+
+  prompt = scm_dynstack_find_prompt (dynstack, tag,
+                                     &flags, &fp_offset, &sp_offset,
+                                     &vra, &mra, &registers);
+
+  if (!prompt)
+    scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
+
+  fp = vp->stack_top - fp_offset;
+  sp = vp->stack_top - sp_offset;
+
+  /* Only reify if the continuation referenced in the handler. */
+  if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
+    cont = SCM_BOOL_F;
+  else
+    {
+      scm_t_dynstack *captured;
+
+      captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
+      cont = capture_delimited_continuation (vp, fp, saved_mra, registers,
+                                             captured, thread->vm.registers);
+    }
+
+  /* Unwind.  */
+  scm_dynstack_unwind (dynstack, prompt);
+
+  /* Continuation gets nargs+1 values: the one more is for the cont.  */
+  sp = sp - nargs - 1;
+
+  /* Shuffle abort arguments down to the prompt continuation.  We have
+     to be jumping to an older part of the stack.  */
+  if (sp < vp->sp)
+    abort ();
+  sp[nargs].as_scm = cont;
+  while (nargs--)
+    sp[nargs] = vp->sp[nargs];
+
+  /* Restore VM regs */
+  vp->fp = fp;
+  vp->sp = sp;
+  vp->ip = vra;
+
+  /* If there are intervening C frames, then jump over them, making a
+     nonlocal exit.  Otherwise fall through and let the VM pick up where
+     it left off.  */
+  if (thread->vm.registers != registers)
+    {
+      vp->mra_after_abort = mra;
+      longjmp (*registers, 1);
+    }
+
+  return mra;
+}
+
+static uint32_t *
+get_callee_vcode (scm_thread *thread)
+{
+  struct scm_vm *vp = &thread->vm;
+
+  SCM proc = SCM_FRAME_LOCAL (vp->fp, 0);
+
+  if (SCM_LIKELY (SCM_PROGRAM_P (proc)))
+    return SCM_PROGRAM_CODE (proc);
+
+  while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
+    {
+      proc = SCM_STRUCT_PROCEDURE (proc);
+      SCM_FRAME_LOCAL (vp->fp, 0) = proc;
+
+      if (SCM_PROGRAM_P (proc))
+        return SCM_PROGRAM_CODE (proc);
+    }
+
+  if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
+    {
+      uint32_t n = frame_locals_count (thread);
+
+      alloc_frame (thread, n + 1);
+
+      /* Although we could make VM modifications to avoid this shuffle,
+         it's easier to piggy-back on the subr arg parsing machinery.
+         Hopefully applicable smobs will go away in the mid-term.  */
+      while (n--)
+        SCM_FRAME_LOCAL (vp->fp, n + 1) = SCM_FRAME_LOCAL (vp->fp, n);
+
+      proc = SCM_SMOB_DESCRIPTOR (proc).apply_trampoline;
+      SCM_FRAME_LOCAL (vp->fp, 0) = proc;
+      return SCM_PROGRAM_CODE (proc);
+    }
+
+  vp->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp);
+
+  scm_error (scm_arg_type_key, NULL, "Wrong type to apply: ~S",
+             scm_list_1 (proc), scm_list_1 (proc));
 }
 
 SCM
 scm_call_n (SCM proc, SCM *argv, size_t nargs)
 {
-  scm_i_thread *thread;
+  scm_thread *thread;
   struct scm_vm *vp;
   union scm_vm_stack_element *return_fp, *call_fp;
   /* Since nargs can only describe the length of a valid argv array in
      elements and each element is at least 4 bytes, nargs will not be
      greater than INTMAX/2 and therefore we don't have to check for
      overflow here or below.  */
-  size_t return_nlocals = 1, call_nlocals = nargs + 1, frame_size = 2;
-  scm_t_ptrdiff stack_reserve_words;
+  size_t return_nlocals = 0, call_nlocals = nargs + 1, frame_size = 3;
+  ptrdiff_t stack_reserve_words;
   size_t i;
 
   thread = SCM_I_CURRENT_THREAD;
-  vp = thread_vm (thread);
+  vp = &thread->vm;
 
   SCM_CHECK_STACK;
 
@@ -1229,36 +1553,48 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
   call_fp = vp->sp + call_nlocals;
   return_fp = call_fp + frame_size + return_nlocals;
 
-  SCM_FRAME_SET_RETURN_ADDRESS (return_fp, vp->ip);
+  SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (return_fp, vp->ip);
+  SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (return_fp, 0);
   SCM_FRAME_SET_DYNAMIC_LINK (return_fp, vp->fp);
-  SCM_FRAME_LOCAL (return_fp, 0) = vm_boot_continuation;
 
-  vp->ip = (scm_t_uint32 *) vm_boot_continuation_code;
-  vp->fp = call_fp;
+  vp->ip = (uint32_t *) vm_boot_continuation_code;
 
-  SCM_FRAME_SET_RETURN_ADDRESS (call_fp, vp->ip);
+  SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (call_fp, vp->ip);
+  SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (call_fp, 0);
   SCM_FRAME_SET_DYNAMIC_LINK (call_fp, return_fp);
   SCM_FRAME_LOCAL (call_fp, 0) = proc;
   for (i = 0; i < nargs; i++)
     SCM_FRAME_LOCAL (call_fp, i + 1) = argv[i];
 
+  vp->fp = call_fp;
+
   {
-    scm_i_jmp_buf registers;
+    jmp_buf registers;
     int resume;
-    const void *prev_cookie = vp->resumable_prompt_cookie;
+    jmp_buf *prev_registers = thread->vm.registers;
     SCM ret;
 
-    resume = SCM_I_SETJMP (registers);
+    resume = setjmp (registers);
+
+    thread->vm.registers = &registers;
+
     if (SCM_UNLIKELY (resume))
       {
+        uint8_t *mcode = vp->mra_after_abort;
         scm_gc_after_nonlocal_exit ();
         /* Non-local return.  */
-        vm_dispatch_abort_hook (vp);
+        if (vp->abort_hook_enabled)
+          invoke_abort_hook (thread);
+#if ENABLE_JIT
+        if (mcode && !vp->disable_mcode)
+          scm_jit_enter_mcode (thread, mcode);
+#endif
       }
+    else
+      vp->ip = get_callee_vcode (thread);
 
-    vp->resumable_prompt_cookie = &registers;
-    ret = vm_engines[vp->engine](thread, vp, &registers, resume);
-    vp->resumable_prompt_cookie = prev_cookie;
+    ret = vm_engines[vp->engine](thread);
+    thread->vm.registers = prev_registers;
 
     return ret;
   }
@@ -1266,57 +1602,98 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
 
 /* Scheme interface */
 
-#define VM_DEFINE_HOOK(n)				\
-{							\
-  struct scm_vm *vp;					\
-  vp = scm_the_vm ();                                   \
-  if (scm_is_false (vp->hooks[n]))			\
-    vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
-  return vp->hooks[n];					\
+#define VM_ADD_HOOK(h, f)                                               \
+  {                                                                     \
+    scm_thread *t = SCM_I_CURRENT_THREAD;                               \
+    SCM hook = t->vm.h##_hook;                                          \
+    if (scm_is_false (hook))                                            \
+      hook = t->vm.h##_hook = scm_make_hook (SCM_I_MAKINUM (1));        \
+    scm_add_hook_x (hook, f, SCM_UNDEFINED);                            \
+    vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled);         \
+    vm_recompute_disable_mcode (t);                                     \
+    return SCM_UNSPECIFIED;                                             \
+  }
+
+#define VM_REMOVE_HOOK(h, f)                                            \
+  {                                                                     \
+    scm_thread *t = SCM_I_CURRENT_THREAD;                               \
+    SCM hook = t->vm.h##_hook;                                          \
+    if (scm_is_true (hook))                                             \
+      scm_remove_hook_x (hook, f);                                      \
+    vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled);         \
+    vm_recompute_disable_mcode (t);                                     \
+    return SCM_UNSPECIFIED;                                             \
+  }
+
+SCM_DEFINE (scm_vm_add_apply_hook_x, "vm-add-apply-hook!", 1, 0, 0,
+	    (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_add_apply_hook_x
+{
+  VM_ADD_HOOK (apply, f);
 }
+#undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_remove_apply_hook_x, "vm-remove-apply-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_apply_hook
+#define FUNC_NAME s_scm_vm_remove_apply_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK);
+  VM_REMOVE_HOOK (apply, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_add_return_hook_x, "vm-add-return-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_push_continuation_hook
+#define FUNC_NAME s_scm_vm_add_return_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK);
+  VM_ADD_HOOK (return, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_remove_return_hook_x, "vm-remove-return-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_pop_continuation_hook
+#define FUNC_NAME s_scm_vm_remove_return_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK);
+  VM_REMOVE_HOOK (return, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_add_next_hook_x, "vm-add-next-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_next_hook
+#define FUNC_NAME s_scm_vm_add_next_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK);
+  VM_ADD_HOOK (next, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_remove_next_hook_x, "vm-remove-next-hook!", 1, 0, 0,
+	    (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_remove_next_hook_x
+{
+  VM_REMOVE_HOOK (next, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_add_abort_hook_x, "vm-add-abort-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_abort_continuation_hook
+#define FUNC_NAME s_scm_vm_add_abort_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK);
+  VM_ADD_HOOK (abort, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_remove_abort_hook_x, "vm-remove-abort-hook!", 1, 0, 0,
+            (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_remove_abort_hook_x
+{
+  VM_REMOVE_HOOK (abort, f);
 }
 #undef FUNC_NAME
 
@@ -1325,7 +1702,7 @@ SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_trace_level
 {
-  return scm_from_int (scm_the_vm ()->trace_level);
+  return scm_from_int (SCM_I_CURRENT_THREAD->vm.trace_level);
 }
 #undef FUNC_NAME
 
@@ -1334,8 +1711,8 @@ SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_set_vm_trace_level_x
 {
-  scm_the_vm ()->trace_level = scm_to_int (level);
-  return SCM_UNSPECIFIED;
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+  return scm_from_int (set_vm_trace_level (thread, scm_to_int (level)));
 }
 #undef FUNC_NAME
 
@@ -1376,7 +1753,7 @@ SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_engine
 {
-  return vm_engine_to_symbol (scm_the_vm ()->engine, FUNC_NAME);
+  return vm_engine_to_symbol (SCM_I_CURRENT_THREAD->vm.engine, FUNC_NAME);
 }
 #undef FUNC_NAME
 
@@ -1384,11 +1761,15 @@ void
 scm_c_set_vm_engine_x (int engine)
 #define FUNC_NAME "set-vm-engine!"
 {
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+
   if (engine < 0 || engine >= SCM_VM_NUM_ENGINES)
     SCM_MISC_ERROR ("Unknown VM engine: ~a",
                     scm_list_1 (scm_from_int (engine)));
     
-  scm_the_vm ()->engine = engine;
+  thread->vm.engine = engine;
+  /* Trigger update of the various hook_enabled flags.  */
+  set_vm_trace_level (thread, thread->vm.trace_level);
 }
 #undef FUNC_NAME
 
@@ -1448,29 +1829,28 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
             "@code{call-with-stack-overflow-handler} was called.")
 #define FUNC_NAME s_scm_call_with_stack_overflow_handler
 {
-  struct scm_vm *vp;
-  scm_t_ptrdiff c_limit, stack_size;
+  struct scm_thread *t = SCM_I_CURRENT_THREAD;
+  ptrdiff_t c_limit, stack_size;
   struct overflow_handler_data data;
   SCM new_limit, ret;
 
-  vp = scm_the_vm ();
-  stack_size = vp->stack_top - vp->sp;
+  stack_size = t->vm.stack_top - t->vm.sp;
 
   c_limit = scm_to_ptrdiff_t (limit);
   if (c_limit <= 0)
     scm_out_of_range (FUNC_NAME, limit);
 
   new_limit = scm_sum (scm_from_ptrdiff_t (stack_size), limit);
-  if (scm_is_pair (vp->overflow_handler_stack))
-    new_limit = scm_min (new_limit, scm_caar (vp->overflow_handler_stack));
+  if (scm_is_pair (t->vm.overflow_handler_stack))
+    new_limit = scm_min (new_limit, scm_caar (t->vm.overflow_handler_stack));
 
   /* Hacky check that the current stack depth plus the limit is within
      the range of a ptrdiff_t.  */
   scm_to_ptrdiff_t (new_limit);
 
-  data.vp = vp;
+  data.vp = &t->vm;
   data.overflow_handler_stack =
-    scm_acons (limit, handler, vp->overflow_handler_stack);
+    scm_acons (limit, handler, t->vm.overflow_handler_stack);
 
   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 
@@ -1479,9 +1859,8 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
   scm_dynwind_unwind_handler (unwind_overflow_handler, &data,
                               SCM_F_WIND_EXPLICITLY);
 
-  /* Reset vp->sp_min_since_gc so that the VM checks actually
-     trigger.  */
-  return_unused_stack_to_os (vp);
+  /* Reset sp_min_since_gc so that the VM checks actually trigger.  */
+  return_unused_stack_to_os (&t->vm);
 
   ret = scm_call_0 (thunk);
 
@@ -1516,11 +1895,7 @@ scm_init_vm_builtin_properties (void)
 
 #define INIT_BUILTIN(builtin, BUILTIN, req, opt, rest)                  \
   scm_set_procedure_property_x (vm_builtin_##builtin, scm_sym_name,     \
-                                scm_sym_##builtin);                     \
-  scm_set_procedure_minimum_arity_x (vm_builtin_##builtin,              \
-                                     SCM_I_MAKINUM (req),               \
-                                     SCM_I_MAKINUM (opt),               \
-                                     scm_from_bool (rest));
+                                scm_sym_##builtin);
   FOR_EACH_VM_BUILTIN (INIT_BUILTIN);
 #undef INIT_BUILTIN
 }
@@ -1536,13 +1911,20 @@ scm_bootstrap_vm (void)
                             (scm_t_extension_init_func)scm_init_vm_builtins,
                             NULL);
 
-  page_size = getpagesize ();
-  /* page_size should be a power of two.  */
-  if (page_size & (page_size - 1))
-    abort ();
+  scm_vm_intrinsics.expand_stack = thread_expand_stack;
+  scm_vm_intrinsics.cons_rest = cons_rest;
+  scm_vm_intrinsics.compute_kwargs_npositional = compute_kwargs_npositional;
+  scm_vm_intrinsics.bind_kwargs = bind_kwargs;
+  scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame;
+  scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x;
+  scm_vm_intrinsics.capture_continuation = capture_continuation;
+  scm_vm_intrinsics.compose_continuation = compose_continuation;
+  scm_vm_intrinsics.expand_apply_argument = expand_apply_argument;
+  scm_vm_intrinsics.abort_to_prompt = abort_to_prompt;
+  scm_vm_intrinsics.get_callee_vcode = get_callee_vcode;
+  scm_vm_intrinsics.unpack_values_object = unpack_values_object;
+  scm_vm_intrinsics.foreign_call = foreign_call;
 
-  sym_vm_run = scm_from_latin1_symbol ("vm-run");
-  sym_vm_error = scm_from_latin1_symbol ("vm-error");
   sym_keyword_argument_error = scm_from_latin1_symbol ("keyword-argument-error");
   sym_regular = scm_from_latin1_symbol ("regular");
   sym_debug = scm_from_latin1_symbol ("debug");
@@ -1552,22 +1934,13 @@ scm_bootstrap_vm (void)
                        (SCM_CELL_WORD_0 (vm_boot_continuation)
                         | SCM_F_PROGRAM_IS_BOOT));
 
-#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest)                \
-  vm_builtin_##builtin = scm_i_make_program (vm_builtin_##builtin##_code);
-  FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
-#undef DEFINE_BUILTIN
+  define_vm_builtins ();
 }
 
 void
 scm_init_vm (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/vm.x"
+#include "vm.x"
 #endif
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vm.h b/libguile/vm.h
index a1cac391f..d227f2652 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -1,67 +1,81 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2001,2009-2015,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifndef _SCM_VM_H_
 #define _SCM_VM_H_
 
-#include <libguile.h>
-#include <libguile/programs.h>
+#include <setjmp.h>
 
-enum {
-  SCM_VM_APPLY_HOOK,
-  SCM_VM_PUSH_CONTINUATION_HOOK,
-  SCM_VM_POP_CONTINUATION_HOOK,
-  SCM_VM_NEXT_HOOK,
-  SCM_VM_ABORT_CONTINUATION_HOOK,
-  SCM_VM_NUM_HOOKS,
-};
+#include <libguile/gc.h>
+#include <libguile/programs.h>
 
 #define SCM_VM_REGULAR_ENGINE 0
 #define SCM_VM_DEBUG_ENGINE 1
 #define SCM_VM_NUM_ENGINES 2
 
+enum scm_compare {
+  SCM_F_COMPARE_NONE = 0x0,
+  SCM_F_COMPARE_EQUAL = 0x1,
+  SCM_F_COMPARE_LESS_THAN = 0x2,
+  SCM_F_COMPARE_INVALID = 0x3
+};
+
 struct scm_vm {
-  scm_t_uint32 *ip;		/* instruction pointer */
+  uint32_t *ip;		/* instruction pointer */
   union scm_vm_stack_element *sp; /* stack pointer */
   union scm_vm_stack_element *fp; /* frame pointer */
-  union scm_vm_stack_element *stack_limit; /* stack limit address */
-  int trace_level;              /* traces enabled if trace_level > 0 */
   union scm_vm_stack_element *sp_min_since_gc; /* deepest sp since last gc */
+  union scm_vm_stack_element *stack_limit; /* stack limit address */
+  uint8_t compare_result;       /* flags register: a value from scm_compare */
+  uint8_t apply_hook_enabled;   /* if apply hook is enabled */
+  uint8_t return_hook_enabled;  /* if return hook is enabled */
+  uint8_t next_hook_enabled;    /* if next hook is enabled */
+  uint8_t abort_hook_enabled;   /* if abort hook is enabled */
+  uint8_t disable_mcode;        /* if mcode is disabled (because debugging) */
+  uint8_t engine;               /* which vm engine we're using */
+  uint8_t unused;               /* padding */
   size_t stack_size;		/* stack size */
   union scm_vm_stack_element *stack_bottom; /* lowest address in allocated stack */
+  SCM apply_hook;               /* apply hook */
+  SCM return_hook;              /* return hook */
+  SCM next_hook;                /* next hook */
+  SCM abort_hook;               /* abort hook */
   union scm_vm_stack_element *stack_top; /* highest address in allocated stack */
   SCM overflow_handler_stack;   /* alist of max-stack-size -> thunk */
-  SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
-  const void *resumable_prompt_cookie; /* opaque cookie */
-  int engine;                   /* which vm engine we're using */
+  jmp_buf *registers;           /* registers captured at latest vm entry  */
+  uint8_t *mra_after_abort;     /* mra to resume after nonlocal exit, or NULL */
+  int trace_level;              /* traces enabled if trace_level > 0 */
 };
 
-SCM_INTERNAL struct scm_vm *scm_the_vm (void);
 SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
 
 SCM_API SCM scm_call_with_stack_overflow_handler (SCM limit, SCM thunk,
                                                   SCM handler);
 
-SCM_API SCM scm_vm_apply_hook (void);
-SCM_API SCM scm_vm_push_continuation_hook (void);
-SCM_API SCM scm_vm_pop_continuation_hook (void);
-SCM_API SCM scm_vm_abort_continuation_hook (void);
-SCM_API SCM scm_vm_next_hook (void);
+SCM_INTERNAL SCM scm_vm_add_apply_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_add_return_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_add_abort_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_add_next_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_remove_apply_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_remove_return_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_remove_abort_hook_x (SCM);
+SCM_INTERNAL SCM scm_vm_remove_next_hook_x (SCM);
 SCM_API SCM scm_vm_trace_level (void);
 SCM_API SCM scm_set_vm_trace_level_x (SCM level);
 SCM_API SCM scm_vm_engine (void);
@@ -70,6 +84,7 @@ SCM_API SCM scm_set_default_vm_engine_x (SCM engine);
 SCM_API void scm_c_set_vm_engine_x (int engine);
 SCM_API void scm_c_set_default_vm_engine_x (int engine);
 
+SCM_INTERNAL void scm_i_vm_prepare_stack (struct scm_vm *vp);
 struct GC_ms_entry;
 SCM_INTERNAL struct GC_ms_entry * scm_i_vm_mark_stack (struct scm_vm *,
                                                        struct GC_ms_entry *,
@@ -81,19 +96,21 @@ SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
 
 struct scm_vm_cont {
   /* IP of newest frame.  */
-  scm_t_uint32 *ra;
+  uint32_t *vra;
+  /* Machine code corresponding to IP.  */
+  uint8_t *mra;
   /* Offset of FP of newest frame, relative to stack top.  */
-  scm_t_ptrdiff fp_offset;
+  ptrdiff_t fp_offset;
   /* Besides being the stack size, this is also the offset of the SP of
      the newest frame.  */
-  scm_t_ptrdiff stack_size;
+  ptrdiff_t stack_size;
   /* Stack bottom, which also keeps saved stack alive for GC.  */
   union scm_vm_stack_element *stack_bottom;
   /* Saved dynamic stack, with prompts relocated to record saved SP/FP
      offsets from the stack top of this scm_vm_cont.  */
   scm_t_dynstack *dynstack;
   /* See the continuation is partial and/or rewindable.  */
-  scm_t_uint32 flags;
+  uint32_t flags;
 };
 
 #define SCM_VM_CONT_P(OBJ)	(SCM_HAS_TYP7 (OBJ, scm_tc7_vm_cont))
@@ -105,23 +122,13 @@ SCM_API SCM scm_load_compiled_with_vm (SCM file);
 
 SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
 SCM_INTERNAL SCM scm_i_capture_current_stack (void);
-SCM_INTERNAL SCM scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
-                                         union scm_vm_stack_element *fp,
-                                         union scm_vm_stack_element *sp,
-                                         scm_t_uint32 *ra,
-                                         scm_t_dynstack *dynstack,
-                                         scm_t_uint32 flags);
+SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
+SCM_INTERNAL void scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
 SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
 SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
                                        scm_print_state *pstate);
-SCM_INTERNAL int scm_i_vm_is_boot_continuation_code (scm_t_uint32 *ip);
+SCM_INTERNAL int scm_i_vm_is_boot_continuation_code (uint32_t *ip);
 SCM_INTERNAL void scm_bootstrap_vm (void);
 SCM_INTERNAL void scm_init_vm (void);
 
 #endif /* _SCM_VM_H_ */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vports.c b/libguile/vports.c
index 29531cfb6..7ec10dd7f 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -1,46 +1,47 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998-2003,2006,2009-2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
-#  include <config.h>
+# include <config.h>
 #endif
 
 #include <assert.h>
-#include <stdio.h>
 #include <errno.h>
+#include <stdio.h>
+#include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/chars.h"
-#include "libguile/ports.h"
-#include "libguile/ports-internal.h"
-#include "libguile/fports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
+#include "boolean.h"
+#include "chars.h"
+#include "eval.h"
+#include "fports.h"
+#include "gsubr.h"
+#include "numbers.h"
+#include "ports-internal.h"
+#include "ports.h"
+#include "strings.h"
+#include "vectors.h"
 
-#include "libguile/validate.h"
-#include "libguile/vports.h"
+#include "vports.h"
 
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
 
 
 
@@ -48,7 +49,6 @@
  * 
  */
 
-
 static scm_t_port_type *scm_soft_port_type;
 
 #define ENCODE_BUF_SIZE 10
@@ -60,7 +60,7 @@ struct soft_port {
   SCM read_char;
   SCM close;
   SCM input_waiting;
-  scm_t_uint8 encode_buf[ENCODE_BUF_SIZE];
+  uint8_t encode_buf[ENCODE_BUF_SIZE];
   size_t encode_cur;
   size_t encode_end;
 };
@@ -246,11 +246,5 @@ scm_init_vports ()
 {
   scm_soft_port_type = scm_make_sfptob ();
 
-#include "libguile/vports.x"
+#include "vports.x"
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/vports.h b/libguile/vports.h
index ae64dd438..3a8d04e8b 100644
--- a/libguile/vports.h
+++ b/libguile/vports.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_VPORTS_H
 #define SCM_VPORTS_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -31,9 +30,3 @@ SCM_API SCM scm_make_soft_port (SCM pv, SCM modes);
 SCM_INTERNAL void scm_init_vports (void);
 
 #endif  /* SCM_VPORTS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-list.h b/libguile/weak-list.h
index 989cb7f0a..158a43033 100644
--- a/libguile/weak-list.h
+++ b/libguile/weak-list.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_WEAK_LIST_H
 #define SCM_WEAK_LIST_H
 
-/* Copyright (C) 2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/pairs.h"
 #include "libguile/weak-vector.h"
 
 
@@ -65,9 +64,3 @@ scm_i_visit_weak_list (SCM *list_loc, void (*visit) (SCM))
 
 
 #endif  /* SCM_WEAK_LIST_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index 1576e20b0..8cf1b8286 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -1,38 +1,42 @@
-/* Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011-2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <assert.h>
+#include <string.h>
 
-#include "libguile/_scm.h"
-#include "libguile/hash.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/bdw-gc.h"
+#include "bdw-gc.h"
+#include "eval.h"
+#include "finalizers.h"
+#include "hash.h"
+#include "pairs.h"
+#include "ports.h"
+#include "threads.h"
+#include "weak-set.h"
 
-#include "libguile/validate.h"
-#include "libguile/weak-list.h"
-#include "libguile/weak-set.h"
+#include "weak-list.h"
 
 
 /* Weak Sets
@@ -896,13 +900,7 @@ scm_weak_set_map_to_list (SCM proc, SCM set)
 void
 scm_init_weak_set ()
 {
-#include "libguile/weak-set.x"
+#include "weak-set.x"
 
   scm_i_register_async_gc_callback (vacuum_all_weak_sets);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-set.h b/libguile/weak-set.h
index 86781c78a..621bce85f 100644
--- a/libguile/weak-set.h
+++ b/libguile/weak-set.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_WEAK_SET_H
 #define SCM_WEAK_SET_H
 
-/* Copyright (C) 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -61,9 +60,3 @@ SCM_INTERNAL void scm_i_weak_set_print (SCM exp, SCM port, scm_print_state *psta
 SCM_INTERNAL void scm_init_weak_set (void);
 
 #endif  /* SCM_WEAK_SET_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 461d4a47c..1e4d8d302 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -1,39 +1,47 @@
-/* Copyright (C) 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011-2014,2017-2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
 #include <assert.h>
 
-#include "libguile/bdw-gc.h"
-#include <gc/gc_typed.h>
+#include "alist.h"
+#include "bdw-gc.h"
+#include "eval.h"
+#include "finalizers.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "procs.h"
+#include "threads.h"
+#include "weak-list.h"
+
+#include "weak-table.h"
 
-#include "libguile/_scm.h"
-#include "libguile/hash.h"
-#include "libguile/eval.h"
-#include "libguile/ports.h"
-#include "libguile/validate.h"
-#include "libguile/weak-list.h"
-#include "libguile/weak-table.h"
+#include <gc/gc_typed.h>
 
 
 /* Weak Tables
@@ -831,13 +839,7 @@ scm_weak_table_prehistory (void)
 void
 scm_init_weak_table ()
 {
-#include "libguile/weak-table.x"
+#include "weak-table.x"
 
   scm_i_register_async_gc_callback (vacuum_all_weak_tables);
 }
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-table.h b/libguile/weak-table.h
index f516c2601..bcbc94e3f 100644
--- a/libguile/weak-table.h
+++ b/libguile/weak-table.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_WEAK_TABLE_H
 #define SCM_WEAK_TABLE_H
 
-/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 
@@ -86,9 +85,3 @@ SCM_INTERNAL void scm_weak_table_prehistory (void);
 SCM_INTERNAL void scm_init_weak_table (void);
 
 #endif  /* SCM_WEAK_TABLE_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
index 082cdde01..b087891f6 100644
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2003,2006,2008-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
@@ -24,11 +24,18 @@
 #endif
 
 #include <stdio.h>
+#include <string.h>
+
+#include "boolean.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "list.h"
+#include "pairs.h"
+#include "vectors.h"
+#include "version.h"
 
-#include "libguile/_scm.h"
-#include "libguile/vectors.h"
+#include "weak-vector.h"
 
-#include "libguile/validate.h"
 
 
 
@@ -250,7 +257,7 @@ static void
 scm_init_weak_vector_builtins (void)
 {
 #ifndef SCM_MAGIC_SNARFER
-#include "libguile/weak-vector.x"
+#include "weak-vector.x"
 #endif
 }
 
@@ -263,9 +270,3 @@ scm_init_weak_vectors ()
                             NULL);
 }
 
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h
index 11395a5da..e22f63c8b 100644
--- a/libguile/weak-vector.h
+++ b/libguile/weak-vector.h
@@ -1,29 +1,28 @@
-/* classes: h_files */
-
 #ifndef SCM_WEAK_VECTOR_H
 #define SCM_WEAK_VECTOR_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,2000-2001,2003,2006,2008-2009,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 
-#include "libguile/__scm.h"
+#include "libguile/scm.h"
 
 
 /* Weak vectors.  */
@@ -47,9 +46,3 @@ SCM_INTERNAL void scm_init_weak_vectors (void);
 
 
 #endif  /* SCM_WEAK_VECTOR_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/meta/Makefile.am b/meta/Makefile.am
index d49ebd9ac..acbd8e71a 100644
--- a/meta/Makefile.am
+++ b/meta/Makefile.am
@@ -77,7 +77,7 @@ substitute =									\
 	 -e "s|[@]guild[@]|$$guild|g"						\
 	 -e "s|[@]installed_guile[@]|$$installed_guile|g"
 
-# Substitutions for dependencies that appear in 'guile-2.0.pc'.
+# Substitutions for dependencies that appear in 'guile-3.0.pc'.
 dependency_substitutions =				\
   -e "s|[@]BDW_GC_CFLAGS[@]|$(BDW_GC_CFLAGS)|g"		\
   -e "s|[@]BDW_GC_LIBS[@]|$(BDW_GC_LIBS)|g"		\
diff --git a/meta/guile-2.2-uninstalled.pc.in b/meta/guile-3.0-uninstalled.pc.in
index e43fd3ae4..e43fd3ae4 100644
--- a/meta/guile-2.2-uninstalled.pc.in
+++ b/meta/guile-3.0-uninstalled.pc.in
diff --git a/meta/guile-2.2.pc.in b/meta/guile-3.0.pc.in
index c6d12b589..c6d12b589 100644
--- a/meta/guile-2.2.pc.in
+++ b/meta/guile-3.0.pc.in
diff --git a/meta/guile-config.in b/meta/guile-config.in
index b3e4c3d94..46428e1b9 100755
--- a/meta/guile-config.in
+++ b/meta/guile-config.in
@@ -8,7 +8,7 @@ exec "@installed_guile@" -e main -s $0 "$@"
 ;;;; guile-config --- utility for linking programs with Guile
 ;;;; Jim Blandy <jim@red-bean.com> --- September 1997
 ;;;; 
-;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1998,2001,2004-2006,2008-2009,2011,2018 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -77,7 +77,7 @@ exec "@installed_guile@" -e main -s $0 "$@"
     (dle "  " p " --help      - show usage info (this message)")
     (dle "  " p " --help SUBCOMMAND - show help for SUBCOMMAND")))
 
-(define guile-module "guile-2.2")
+(define guile-module "guile-@GUILE_EFFECTIVE_VERSION@")
 
 (define (pkg-config . args)
   (let* ((real-args (cons %pkg-config-program args))
diff --git a/module/Makefile.am b/module/Makefile.am
index e18a686ff..c72fb9228 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015, 2018 Free Software Foundation, Inc.
+##        2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -55,7 +55,6 @@ SOURCES =					\
   ice-9/common-list.scm				\
   ice-9/control.scm				\
   ice-9/curried-definitions.scm			\
-  ice-9/debug.scm				\
   ice-9/deprecated.scm				\
   ice-9/documentation.scm			\
   ice-9/eval-string.scm				\
@@ -76,7 +75,6 @@ SOURCES =					\
   ice-9/list.scm				\
   ice-9/local-eval.scm				\
   ice-9/ls.scm					\
-  ice-9/mapping.scm				\
   ice-9/match.scm				\
   ice-9/networking.scm				\
   ice-9/null.scm				\
@@ -114,7 +112,6 @@ SOURCES =					\
   ice-9/streams.scm				\
   ice-9/string-fun.scm				\
   ice-9/suspendable-ports.scm			\
-  ice-9/syncase.scm				\
   ice-9/textual-ports.scm			\
   ice-9/threads.scm				\
   ice-9/time.scm				\
@@ -134,20 +131,17 @@ SOURCES =					\
   language/cps.scm				\
   language/cps/closure-conversion.scm		\
   language/cps/compile-bytecode.scm		\
-  language/cps/constructors.scm			\
   language/cps/contification.scm		\
   language/cps/cse.scm				\
   language/cps/dce.scm				\
+  language/cps/devirtualize-integers.scm	\
   language/cps/effects-analysis.scm		\
-  language/cps/elide-values.scm			\
-  language/cps/handle-interrupts.scm		\
   language/cps/intmap.scm			\
   language/cps/intset.scm			\
   language/cps/licm.scm				\
+  language/cps/loop-instrumentation.scm		\
   language/cps/optimize.scm			\
   language/cps/peel-loops.scm			\
-  language/cps/primitives.scm			\
-  language/cps/prune-bailouts.scm		\
   language/cps/prune-top-level-scopes.scm	\
   language/cps/reify-primitives.scm		\
   language/cps/renumber.scm			\
@@ -193,6 +187,7 @@ SOURCES =					\
   language/tree-il/analyze.scm			\
   language/tree-il/canonicalize.scm		\
   language/tree-il/compile-cps.scm		\
+  language/tree-il/cps-primitives.scm		\
   language/tree-il/debug.scm			\
   language/tree-il/effects.scm			\
   language/tree-il/fix-letrec.scm		\
@@ -304,11 +299,13 @@ SOURCES =					\
   system/base/pmatch.scm			\
   system/base/syntax.scm			\
   system/base/compile.scm			\
+  system/base/optimize.scm			\
   system/base/language.scm			\
   system/base/lalr.scm				\
   system/base/message.scm			\
   system/base/target.scm			\
   system/base/types.scm				\
+  system/base/types/internal.scm		\
   system/base/ck.scm				\
 						\
   system/foreign.scm				\
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index c1891e70a..a4d3d94b1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -291,9 +291,6 @@ This is handy for tracing function calls, e.g.:
 (define (absolute-file-name? file-name) #t)
 (define (open-input-file str) (open-file str "r"))
 
-;; Temporary definition; replaced by a parameter later.
-(define (allow-legacy-syntax-objects?) #f)
-
 ;;; {and-map and or-map}
 ;;;
 ;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
@@ -1180,7 +1177,7 @@ VALUE."
 
 ;; 0: type-name, 1: fields, 2: constructor
 (define record-type-vtable
-  (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
+  (let ((s (make-vtable (string-append standard-vtable-fields "pwpwpw")
                         (lambda (s p)
                           (display "#<record-type " p)
                           (display (record-type-name s) p)
@@ -1214,14 +1211,10 @@ VALUE."
              #,@(let lp ((n 0))
                   (if (< n *max-static-argument-count*)
                       (cons (with-syntax (((formal ...) (make-formals n))
-                                          ((idx ...) (iota n))
                                           (n n))
                               #'((n)
                                  (lambda (formal ...)
-                                   (let ((s (allocate-struct rtd n)))
-                                     (struct-set! s idx formal)
-                                     ...
-                                     s))))
+                                   (make-struct/simple rtd formal ...))))
                             (lp (1+ n)))
                       '()))
              (else
@@ -1330,7 +1323,7 @@ VALUE."
 
 (define <parameter>
   ;; Three fields: the procedure itself, the fluid, and the converter.
-  (make-struct/no-tail <applicable-struct-vtable> 'pwprpr))
+  (make-struct/no-tail <applicable-struct-vtable> 'pwpwpw))
 (set-struct-vtable-name! <parameter> '<parameter>)
 
 (define* (make-parameter init #:optional (conv (lambda (x) x)))
@@ -1426,10 +1419,6 @@ CONV is not applied to the initial value."
 
 (set! default-prompt-tag (make-parameter (default-prompt-tag)))
 
-;; Because code compiled with Guile 2.2.0 embeds legacy syntax objects
-;; into its compiled macros, we have to default to true, sadly.
-(set! allow-legacy-syntax-objects? (make-parameter #t))
-
 
 
 ;;; {Languages}
@@ -1926,12 +1915,7 @@ name extensions listed in %load-extensions."
                                  (define #,ctor
                                    (let ((rtd #,rtd))
                                      (lambda #,args
-                                       (let ((s (allocate-struct rtd #,n)))
-                                         #,@(map
-                                             (lambda (arg slot)
-                                               #`(struct-set! s #,slot #,arg))
-                                             args slots)
-                                         s))))
+                                       (make-struct/simple rtd #,@args))))
                                  (struct-set! #,rtd (+ vtable-offset-user 2)
                                               #,ctor)))))
 
diff --git a/module/ice-9/debug.scm b/module/ice-9/debug.scm
deleted file mode 100644
index 380b04595..000000000
--- a/module/ice-9/debug.scm
+++ /dev/null
@@ -1,25 +0,0 @@
-;;;; 	Copyright (C) 1996, 1997, 1998, 1999, 2001, 2006, 2010 Free Software Foundation
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;;
-;;;; The author can be reached at djurfeldt@nada.kth.se
-;;;; Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
-;;;;
-
-
-(define-module (ice-9 debug))
-
-(issue-deprecation-warning
- "(ice-9 debug) is deprecated. Use (system vm trace) for tracing.")
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 2f41686ac..85be82e95 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -15,79 +15,19 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;;
 
-(define-module (ice-9 deprecated)
-  #:use-module ((ice-9 threads) #:prefix threads:))
+(define-module (ice-9 deprecated))
 
-(define-syntax-rule (define-deprecated var msg exp)
+(define-syntax-rule (define-deprecated name message exp)
   (begin
-    (define-syntax var
-      (lambda (x)
-        (issue-deprecation-warning msg)
-        (syntax-case x ()
-          ((id arg (... ...)) #'(let ((x id)) (x arg (... ...))))
-          (id (identifier? #'id) #'exp))))
-    (export var)))
+    (define-syntax rule
+      (identifier-syntax
+       (begin
+         (issue-deprecation-warning message)
+         exp)))
+    (export rule)))
 
-(define-deprecated _IONBF
-  "`_IONBF' is deprecated.  Use the symbol 'none instead."
-  'none)
-(define-deprecated _IOLBF
-  "`_IOLBF' is deprecated.  Use the symbol 'line instead."
-  'line)
-(define-deprecated _IOFBF
-  "`_IOFBF' is deprecated.  Use the symbol 'block instead."
-  'block)
-
-(define-syntax define-deprecated/threads
-  (lambda (stx)
-    (define (threads-name id)
-      (datum->syntax id (symbol-append 'threads: (syntax->datum id))))
-    (syntax-case stx ()
-      ((_ name)
-       (with-syntax ((name* (threads-name #'name))
-                     (warning (string-append
-                               "Import (ice-9 threads) to have access to `"
-                               (symbol->string (syntax->datum #'name)) "'.")))
-         #'(define-deprecated name warning name*))))))
-
-(define-syntax-rule (define-deprecated/threads* name ...)
-  (begin (define-deprecated/threads name) ...))
-
-(define-deprecated/threads*
-  call-with-new-thread
-  yield
-  cancel-thread
-  join-thread
-  thread?
-  make-mutex
-  make-recursive-mutex
-  lock-mutex
-  try-mutex
-  unlock-mutex
-  mutex?
-  mutex-owner
-  mutex-level
-  mutex-locked?
-  make-condition-variable
-  wait-condition-variable
-  signal-condition-variable
-  broadcast-condition-variable
-  condition-variable?
-  current-thread
-  all-threads
-  thread-exited?
-  total-processor-count
-  current-processor-count)
-
-(define-public make-dynamic-state
-  (case-lambda
-    (()
-     (issue-deprecation-warning
-      "`(make-dynamic-state)' is deprecated; use `(current-dynamic-state)'
-instead.")
-     (current-dynamic-state))
-    ((parent)
-     (issue-deprecation-warning
-      "`(make-dynamic-state PARENT)' is deprecated; now that reified
-dynamic state objects are themselves copies, just use PARENT directly.")
-     parent)))
+(define %allow-legacy-syntax-objects? (make-parameter #f))
+(define-deprecated allow-legacy-syntax-objects?
+  "allow-legacy-syntax-objects? is deprecated and has no effect.  Guile
+3.0 has no legacy syntax objects."
+  %allow-legacy-syntax-objects?)
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index d21f59abd..41224517f 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2015, 2018 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -157,7 +157,7 @@
                          a))
         ((a b)
          (maybe-primcall (+ - * / ash logand logior logxor
-                          cons vector-ref struct-ref allocate-struct variable-set!)
+                          cons vector-ref struct-ref variable-set!)
                          a b))
         ((a b c)
          (maybe-primcall (vector-set! struct-set!) a b c))
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 1ef4cb5ef..e7258a1e2 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -45,11 +45,6 @@
            ((not destination) (open-output-string))
            ((boolean? destination) (current-output-port)) ; boolean but not false
            ((output-port? destination) destination)
-           ((number? destination)
-            (issue-deprecation-warning
-             "Passing a number to format as the port is deprecated."
-             "Pass (current-error-port) instead.")
-            (current-error-port))
            (else
             (error "format: bad destination `~a'" destination))))
 
@@ -1603,24 +1598,5 @@
               (close-port port)
               str)))))))
 
-(begin-deprecated
- (set! format
-       (let ((format format))
-         (case-lambda
-           ((destination format-string . args)
-            (if (string? destination)
-                (begin
-                  (issue-deprecation-warning
-                   "Omitting the destination on a call to format is deprecated."
-                   "Pass #f as the destination, before the format string.")
-                  (apply format #f destination format-string args))
-                (apply format destination format-string args)))
-           ((deprecated-format-string-only)
-            (issue-deprecation-warning
-             "Omitting the destination port on a call to format is deprecated."
-             "Pass #f as the destination port, before the format string.")
-            (format #f deprecated-format-string-only))))))
-
-
 ;; Thanks to Shuji Narazaki
 (module-set! the-root-module 'format format)
diff --git a/module/ice-9/mapping.scm b/module/ice-9/mapping.scm
deleted file mode 100644
index bd4dbfbd3..000000000
--- a/module/ice-9/mapping.scm
+++ /dev/null
@@ -1,118 +0,0 @@
-;;; installed-scm-file
-
-;;;; 	Copyright (C) 1996, 2001, 2006, 2013 Free Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
-
-
-
-(define-module (ice-9 mapping)
-  :use-module (ice-9 poe)
-  :export (mapping-hooks-type make-mapping-hooks mapping-hooks?
-	   mapping-hooks-get-handle mapping-hooks-create-handle
-	   mapping-hooks-remove mapping-type make-mapping mapping?
-	   mapping-hooks mapping-data set-mapping-hooks! set-mapping-data!
-	   mapping-get-handle mapping-create-handle! mapping-remove!
-	   mapping-ref mapping-set!  hash-table-mapping-hooks
-	   make-hash-table-mapping hash-table-mapping))
-
-(issue-deprecation-warning
- "(ice-9 mapping) is deprecated.  Use srfi-69 or rnrs hash tables instead.")
-
-(define mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle
-							      create-handle
-							      remove)))
-
-
-(define make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type)))
-(define mapping-hooks? (record-predicate mapping-hooks-type))
-(define mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle))
-(define mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle))
-(define mapping-hooks-remove (record-accessor mapping-hooks-type 'remove))
-
-(define mapping-type (make-record-type 'mapping '(hooks data)))
-(define make-mapping (record-constructor mapping-type))
-(define mapping? (record-predicate mapping-type))
-(define mapping-hooks (record-accessor mapping-type 'hooks))
-(define mapping-data (record-accessor mapping-type 'data))
-(define set-mapping-hooks! (record-modifier mapping-type 'hooks))
-(define set-mapping-data! (record-modifier mapping-type 'data))
-
-(define (mapping-get-handle map key)
-  ((mapping-hooks-get-handle (mapping-hooks map)) map key))
-(define (mapping-create-handle! map key init)
-  ((mapping-hooks-create-handle (mapping-hooks map)) map key init))
-(define (mapping-remove! map key)
-  ((mapping-hooks-remove (mapping-hooks map)) map key))
-
-(define* (mapping-ref map key #:optional dflt)
-  (cond
-   ((mapping-get-handle map key) => cdr)
-   (else dflt)))
-
-(define (mapping-set! map key val)
-  (set-cdr! (mapping-create-handle! map key #f) val))
-
-
-
-(define hash-table-mapping-hooks
-  (let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data 1st) rest)))))
-
-    (perfect-funcq 17
-		   (lambda (hash-proc assoc-proc)
-		     (let ((procs (list hash-proc assoc-proc)))
-		       (cond
-			((equal? procs `(,hashq ,assq))
-			 (make-mapping-hooks (wrap hashq-get-handle)
-					     (wrap hashq-create-handle!)
-					     (wrap hashq-remove!)))
-			((equal? procs `(,hashv ,assv))
-			 (make-mapping-hooks (wrap hashv-get-handle)
-					     (wrap hashv-create-handle!)
-					     (wrap hashv-remove!)))
-			((equal? procs `(,hash ,assoc))
-			 (make-mapping-hooks (wrap hash-get-handle)
-					     (wrap hash-create-handle!)
-					     (wrap hash-remove!)))
-			(else
-			 (make-mapping-hooks (wrap
-					      (lambda (table key)
-						(hashx-get-handle hash-proc assoc-proc table key)))
-					     (wrap
-					      (lambda (table key init)
-						(hashx-create-handle! hash-proc assoc-proc table key init)))
-					     (wrap
-					      (lambda (table key)
-						(hashx-remove! hash-proc assoc-proc table key)))))))))))
-
-(define (make-hash-table-mapping table hash-proc assoc-proc)
-  (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc) table))
-
-(define* (hash-table-mapping #:optional (size 71) #:key
-                             (hash-proc hash)
-                             (assoc-proc
-                              (or (assq-ref `((,hashq . ,assq)
-                                              (,hashv . ,assv)
-                                              (,hash . ,assoc))
-                                            hash-proc)
-                                  (error 'hash-table-mapping
-                                         "Hash-procedure specified with no known assoc function."
-                                         hash-proc)))
-                             (table-constructor
-                              (lambda (len) (make-vector len '()))))
-  (make-hash-table-mapping (table-constructor size)
-                           hash-proc
-                           assoc-proc))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 6ee86210d..151bf8e5b 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -9,23 +9,19 @@
   (letrec*
     ((make-void
        (lambda (src)
-         (make-struct/no-tail (vector-ref %expanded-vtables 0) src)))
+         (make-struct/simple (vector-ref %expanded-vtables 0) src)))
      (make-const
        (lambda (src exp)
-         (make-struct/no-tail (vector-ref %expanded-vtables 1) src exp)))
+         (make-struct/simple (vector-ref %expanded-vtables 1) src exp)))
      (make-primitive-ref
        (lambda (src name)
-         (make-struct/no-tail (vector-ref %expanded-vtables 2) src name)))
+         (make-struct/simple (vector-ref %expanded-vtables 2) src name)))
      (make-lexical-ref
        (lambda (src name gensym)
-         (make-struct/no-tail
-           (vector-ref %expanded-vtables 3)
-           src
-           name
-           gensym)))
+         (make-struct/simple (vector-ref %expanded-vtables 3) src name gensym)))
      (make-lexical-set
        (lambda (src name gensym exp)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 4)
            src
            name
@@ -33,7 +29,7 @@
            exp)))
      (make-module-ref
        (lambda (src mod name public?)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 5)
            src
            mod
@@ -41,7 +37,7 @@
            public?)))
      (make-module-set
        (lambda (src mod name public? exp)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 6)
            src
            mod
@@ -50,16 +46,16 @@
            exp)))
      (make-toplevel-ref
        (lambda (src name)
-         (make-struct/no-tail (vector-ref %expanded-vtables 7) src name)))
+         (make-struct/simple (vector-ref %expanded-vtables 7) src name)))
      (make-toplevel-set
        (lambda (src name exp)
-         (make-struct/no-tail (vector-ref %expanded-vtables 8) src name exp)))
+         (make-struct/simple (vector-ref %expanded-vtables 8) src name exp)))
      (make-toplevel-define
        (lambda (src name exp)
-         (make-struct/no-tail (vector-ref %expanded-vtables 9) src name exp)))
+         (make-struct/simple (vector-ref %expanded-vtables 9) src name exp)))
      (make-conditional
        (lambda (src test consequent alternate)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 10)
            src
            test
@@ -67,19 +63,19 @@
            alternate)))
      (make-call
        (lambda (src proc args)
-         (make-struct/no-tail (vector-ref %expanded-vtables 11) src proc args)))
+         (make-struct/simple (vector-ref %expanded-vtables 11) src proc args)))
      (make-primcall
        (lambda (src name args)
-         (make-struct/no-tail (vector-ref %expanded-vtables 12) src name args)))
+         (make-struct/simple (vector-ref %expanded-vtables 12) src name args)))
      (make-seq
        (lambda (src head tail)
-         (make-struct/no-tail (vector-ref %expanded-vtables 13) src head tail)))
+         (make-struct/simple (vector-ref %expanded-vtables 13) src head tail)))
      (make-lambda
        (lambda (src meta body)
-         (make-struct/no-tail (vector-ref %expanded-vtables 14) src meta body)))
+         (make-struct/simple (vector-ref %expanded-vtables 14) src meta body)))
      (make-lambda-case
        (lambda (src req opt rest kw inits gensyms body alternate)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 15)
            src
            req
@@ -92,7 +88,7 @@
            alternate)))
      (make-let
        (lambda (src names gensyms vals body)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 16)
            src
            names
@@ -101,7 +97,7 @@
            body)))
      (make-letrec
        (lambda (src in-order? names gensyms vals body)
-         (make-struct/no-tail
+         (make-struct/simple
            (vector-ref %expanded-vtables 17)
            src
            in-order?
@@ -228,29 +224,9 @@
            (begin
              (for-each maybe-name-value! ids val-exps)
              (make-letrec src in-order? ids vars val-exps body-exp)))))
-     (syntax-object?
-       (lambda (x)
-         (or (syntax? x)
-             (and (allow-legacy-syntax-objects?)
-                  (vector? x)
-                  (= (vector-length x) 4)
-                  (eqv? (vector-ref x 0) 'syntax-object)))))
-     (make-syntax-object
-       (lambda (expression wrap module)
-         (make-syntax expression wrap module)))
-     (syntax-object-expression
-       (lambda (obj)
-         (if (syntax? obj) (syntax-expression obj) (vector-ref obj 1))))
-     (syntax-object-wrap
-       (lambda (obj)
-         (if (syntax? obj) (syntax-wrap obj) (vector-ref obj 2))))
-     (syntax-object-module
-       (lambda (obj)
-         (if (syntax? obj) (syntax-module obj) (vector-ref obj 3))))
      (source-annotation
        (lambda (x)
-         (let ((props (source-properties
-                        (if (syntax-object? x) (syntax-object-expression x) x))))
+         (let ((props (source-properties (if (syntax? x) (syntax-expression x) x))))
            (and (pair? props) props))))
      (extend-env
        (lambda (labels bindings r)
@@ -283,18 +259,15 @@
            sym
            (make-syntax-transformer sym type val))))
      (nonsymbol-id?
-       (lambda (x)
-         (and (syntax-object? x) (symbol? (syntax-object-expression x)))))
+       (lambda (x) (and (syntax? x) (symbol? (syntax-expression x)))))
      (id? (lambda (x)
-            (if (symbol? x)
-              #t
-              (and (syntax-object? x) (symbol? (syntax-object-expression x))))))
+            (if (symbol? x) #t (and (syntax? x) (symbol? (syntax-expression x))))))
      (id-sym-name&marks
        (lambda (x w)
-         (if (syntax-object? x)
+         (if (syntax? x)
            (values
-             (syntax-object-expression x)
-             (join-marks (car w) (car (syntax-object-wrap x))))
+             (syntax-expression x)
+             (join-marks (car w) (car (syntax-wrap x))))
            (values x (car w)))))
      (gen-label (lambda () (symbol->string (module-gensym "l"))))
      (gen-labels
@@ -320,10 +293,10 @@
        (lambda (ribcage id label)
          (set-ribcage-symnames!
            ribcage
-           (cons (syntax-object-expression id) (ribcage-symnames ribcage)))
+           (cons (syntax-expression id) (ribcage-symnames ribcage)))
          (set-ribcage-marks!
            ribcage
-           (cons (car (syntax-object-wrap id)) (ribcage-marks ribcage)))
+           (cons (car (syntax-wrap id)) (ribcage-marks ribcage)))
          (set-ribcage-labels! ribcage (cons label (ribcage-labels ribcage)))))
      (make-binding-wrap
        (lambda (ids labels w)
@@ -397,10 +370,10 @@
                                (values n marks))))
                           (else (f (+ i 1)))))))))
            (cond ((symbol? id) (or (search id (cdr w) (car w) mod) id))
-                 ((syntax-object? id)
-                  (let ((id (syntax-object-expression id))
-                        (w1 (syntax-object-wrap id))
-                        (mod (syntax-object-module id)))
+                 ((syntax? id)
+                  (let ((id (syntax-expression id))
+                        (w1 (syntax-wrap id))
+                        (mod (syntax-module id)))
                     (let ((marks (join-marks (car w) (car w1))))
                       (call-with-values
                         (lambda () (search id (cdr w) marks mod))
@@ -475,23 +448,19 @@
                         (values type value mod)))
                     (values 'displaced-lexical #f #f))))))
            (let ((n (id-var-name id w mod)))
-             (cond ((syntax-object? n)
+             (cond ((syntax? n)
                     (if (not (eq? n id))
                       (resolve-identifier n w r mod resolve-syntax-parameters?)
                       (resolve-identifier
-                        (syntax-object-expression n)
-                        (syntax-object-wrap n)
+                        (syntax-expression n)
+                        (syntax-wrap n)
                         r
-                        (syntax-object-module n)
+                        (syntax-module n)
                         resolve-syntax-parameters?)))
                    ((symbol? n)
-                    (resolve-global
-                      n
-                      (if (syntax-object? id) (syntax-object-module id) mod)))
+                    (resolve-global n (if (syntax? id) (syntax-module id) mod)))
                    ((string? n)
-                    (resolve-lexical
-                      n
-                      (if (syntax-object? id) (syntax-object-module id) mod)))
+                    (resolve-lexical n (if (syntax? id) (syntax-module id) mod)))
                    (else (error "unexpected id-var-name" id w n)))))))
      (transformer-environment
        (make-fluid
@@ -501,8 +470,8 @@
        (lambda (k) ((fluid-ref transformer-environment) k)))
      (free-id=?
        (lambda (i j)
-         (let* ((mi (and (syntax-object? i) (syntax-object-module i)))
-                (mj (and (syntax-object? j) (syntax-object-module j)))
+         (let* ((mi (and (syntax? i) (syntax-module i)))
+                (mj (and (syntax? j) (syntax-module j)))
                 (ni (id-var-name i '(()) mi))
                 (nj (id-var-name j '(()) mj)))
            (letrec*
@@ -510,12 +479,11 @@
                 (lambda (id mod)
                   (module-variable
                     (if mod (resolve-module (cdr mod)) (current-module))
-                    (let ((x id)) (if (syntax-object? x) (syntax-object-expression x) x))))))
-             (cond ((syntax-object? ni) (free-id=? ni j))
-                   ((syntax-object? nj) (free-id=? i nj))
+                    (let ((x id)) (if (syntax? x) (syntax-expression x) x))))))
+             (cond ((syntax? ni) (free-id=? ni j))
+                   ((syntax? nj) (free-id=? i nj))
                    ((symbol? ni)
-                    (and (eq? nj
-                              (let ((x j)) (if (syntax-object? x) (syntax-object-expression x) x)))
+                    (and (eq? nj (let ((x j)) (if (syntax? x) (syntax-expression x) x)))
                          (let ((bi (id-module-binding i mi)))
                            (if bi
                              (eq? bi (id-module-binding j mj))
@@ -524,11 +492,9 @@
                    (else (equal? ni nj)))))))
      (bound-id=?
        (lambda (i j)
-         (if (and (syntax-object? i) (syntax-object? j))
-           (and (eq? (syntax-object-expression i) (syntax-object-expression j))
-                (same-marks?
-                  (car (syntax-object-wrap i))
-                  (car (syntax-object-wrap j))))
+         (if (and (syntax? i) (syntax? j))
+           (and (eq? (syntax-expression i) (syntax-expression j))
+                (same-marks? (car (syntax-wrap i)) (car (syntax-wrap j))))
            (eq? i j))))
      (valid-bound-ids?
        (lambda (ids)
@@ -547,13 +513,13 @@
               (or (bound-id=? x (car list)) (bound-id-member? x (cdr list))))))
      (wrap (lambda (x w defmod)
              (cond ((and (null? (car w)) (null? (cdr w))) x)
-                   ((syntax-object? x)
-                    (make-syntax-object
-                      (syntax-object-expression x)
-                      (join-wraps w (syntax-object-wrap x))
-                      (syntax-object-module x)))
+                   ((syntax? x)
+                    (make-syntax
+                      (syntax-expression x)
+                      (join-wraps w (syntax-wrap x))
+                      (syntax-module x)))
                    ((null? x) x)
-                   (else (make-syntax-object x w defmod)))))
+                   (else (make-syntax x w defmod)))))
      (source-wrap
        (lambda (x w s defmod) (wrap (decorate-source x s) w defmod)))
      (expand-sequence
@@ -577,13 +543,13 @@
                     (extend-ribcage!
                       ribcage
                       id
-                      (cons (syntax-object-module id) (wrap var '((top)) mod))))))
+                      (cons (syntax-module id) (wrap var '((top)) mod))))))
               (macro-introduced-identifier?
-                (lambda (id) (not (equal? (car (syntax-object-wrap id)) '(top)))))
+                (lambda (id) (not (equal? (car (syntax-wrap id)) '(top)))))
               (fresh-derived-name
                 (lambda (id orig-form)
                   (symbol-append
-                    (syntax-object-expression id)
+                    (syntax-expression id)
                     '-
                     (string->symbol
                       (number->string
@@ -614,7 +580,7 @@
                                         (label (gen-label))
                                         (var (if (macro-introduced-identifier? id)
                                                (fresh-derived-name id x)
-                                               (syntax-object-expression id))))
+                                               (syntax-expression id))))
                                    (record-definition! id var)
                                    (list (if (eq? m 'c&e)
                                            (let ((x (build-global-definition s var (expand e r w mod))))
@@ -633,7 +599,7 @@
                                         (label (gen-label))
                                         (var (if (macro-introduced-identifier? id)
                                                (fresh-derived-name id x)
-                                               (syntax-object-expression id))))
+                                               (syntax-expression id))))
                                    (record-definition! id var)
                                    (let ((key m))
                                      (cond ((memv key '(c))
@@ -768,7 +734,7 @@
                               ((memv key '(global))
                                (if (equal? fmod '(primitive))
                                  (values 'primitive-call fval e e w s mod)
-                                 (values 'global-call (make-syntax-object fval w fmod) e e w s mod)))
+                                 (values 'global-call (make-syntax fval w fmod) e e w s mod)))
                               ((memv key '(macro))
                                (syntax-type
                                  (expand-macro fval e r w s rib mod)
@@ -846,14 +812,14 @@
                                      "source expression failed to match any pattern"
                                      tmp-1))))
                               (else (values 'call #f e e w s mod))))))))
-               ((syntax-object? e)
+               ((syntax? e)
                 (syntax-type
-                  (syntax-object-expression e)
+                  (syntax-expression e)
                   r
-                  (join-wraps w (syntax-object-wrap e))
+                  (join-wraps w (syntax-wrap e))
                   (or (source-annotation e) s)
                   rib
-                  (or (syntax-object-module e) mod)
+                  (or (syntax-module e) mod)
                   for-car?))
                ((self-evaluating? e) (values 'constant #f e e w s mod))
                (else (values 'other #f e e w s mod)))))
@@ -878,7 +844,7 @@
                       (build-lexical-reference
                         'fun
                         (source-annotation id)
-                        (if (syntax-object? id) (syntax->datum id) id)
+                        (if (syntax? id) (syntax->datum id) id)
                         value))
                     e
                     r
@@ -889,8 +855,8 @@
                   (expand-call
                     (build-global-reference
                       (source-annotation (car e))
-                      (if (syntax-object? value) (syntax-object-expression value) value)
-                      (if (syntax-object? value) (syntax-object-module value) mod))
+                      (if (syntax? value) (syntax-expression value) value)
+                      (if (syntax? value) (syntax-module value) mod))
                     e
                     r
                     w
@@ -982,19 +948,19 @@
                          (cons (rebuild-macro-output (car x) m)
                                (rebuild-macro-output (cdr x) m))
                          s))
-                      ((syntax-object? x)
-                       (let ((w (syntax-object-wrap x)))
+                      ((syntax? x)
+                       (let ((w (syntax-wrap x)))
                          (let ((ms (car w)) (ss (cdr w)))
                            (if (and (pair? ms) (eq? (car ms) #f))
-                             (make-syntax-object
-                               (syntax-object-expression x)
+                             (make-syntax
+                               (syntax-expression x)
                                (cons (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss)))
-                               (syntax-object-module x))
-                             (make-syntax-object
-                               (decorate-source (syntax-object-expression x) s)
+                               (syntax-module x))
+                             (make-syntax
+                               (decorate-source (syntax-expression x) s)
                                (cons (cons m ms)
                                      (if rib (cons rib (cons 'shift ss)) (cons 'shift ss)))
-                               (syntax-object-module x))))))
+                               (syntax-module x))))))
                       ((vector? x)
                        (let* ((n (vector-length x)) (v (decorate-source (make-vector n) s)))
                          (let loop ((i 0))
@@ -1010,11 +976,11 @@
                          (source-wrap e w (cdr w) mod)
                          x))
                       (else (decorate-source x s))))))
-           (let* ((t-680b775fb37a463-7d8 transformer-environment)
-                  (t-680b775fb37a463-7d9 (lambda (k) (k e r w s rib mod))))
+           (let* ((t-680b775fb37a463-7b8 transformer-environment)
+                  (t-680b775fb37a463-7b9 (lambda (k) (k e r w s rib mod))))
              (with-fluid*
-               t-680b775fb37a463-7d8
-               t-680b775fb37a463-7d9
+               t-680b775fb37a463-7b8
+               t-680b775fb37a463-7b9
                (lambda ()
                  (rebuild-macro-output
                    (p (source-wrap e (anti-mark w) s mod))
@@ -1174,10 +1140,7 @@
               (call-with-values
                 (lambda ()
                   (resolve-identifier
-                    (make-syntax-object
-                      '#{ $sc-ellipsis }#
-                      (syntax-object-wrap e)
-                      (syntax-object-module e))
+                    (make-syntax '#{ $sc-ellipsis }# (syntax-wrap e) (syntax-module e))
                     '(())
                     r
                     mod
@@ -1550,11 +1513,11 @@
                                           s
                                           mod
                                           get-formals
-                                          (map (lambda (tmp-680b775fb37a463-ac9
-                                                        tmp-680b775fb37a463-ac8
-                                                        tmp-680b775fb37a463-ac7)
-                                                 (cons tmp-680b775fb37a463-ac7
-                                                       (cons tmp-680b775fb37a463-ac8 tmp-680b775fb37a463-ac9)))
+                                          (map (lambda (tmp-680b775fb37a463-aa9
+                                                        tmp-680b775fb37a463-aa8
+                                                        tmp-680b775fb37a463-aa7)
+                                                 (cons tmp-680b775fb37a463-aa7
+                                                       (cons tmp-680b775fb37a463-aa8 tmp-680b775fb37a463-aa9)))
                                                e2*
                                                e1*
                                                args*)))
@@ -1571,8 +1534,7 @@
               (if (memq 'top (car w))
                 x
                 (let f ((x x))
-                  (cond ((syntax-object? x)
-                         (strip (syntax-object-expression x) (syntax-object-wrap x)))
+                  (cond ((syntax? x) (strip (syntax-expression x) (syntax-wrap x)))
                         ((pair? x)
                          (let ((a (f (car x))) (d (f (cdr x))))
                            (if (and (eq? a (car x)) (eq? d (cdr x))) x (cons a d))))
@@ -1585,7 +1547,7 @@
                         (else x))))))
      (gen-var
        (lambda (id)
-         (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+         (let ((id (if (syntax? id) (syntax-expression id) id)))
            (module-gensym (symbol->string id)))))
      (lambda-var-list
        (lambda (vars)
@@ -1593,10 +1555,8 @@
            (cond ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls) w))
                  ((id? vars) (cons (wrap vars w #f) ls))
                  ((null? vars) ls)
-                 ((syntax-object? vars)
-                  (lvl (syntax-object-expression vars)
-                       ls
-                       (join-wraps w (syntax-object-wrap vars))))
+                 ((syntax? vars)
+                  (lvl (syntax-expression vars) ls (join-wraps w (syntax-wrap vars))))
                  (else (cons vars ls)))))))
     (global-extend 'local-syntax 'letrec-syntax #t)
     (global-extend 'local-syntax 'let-syntax #f)
@@ -1855,11 +1815,11 @@
               (apply (lambda (args e1 e2)
                        (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-c96
-                                       tmp-680b775fb37a463-c95
-                                       tmp-680b775fb37a463-c94)
-                                (cons tmp-680b775fb37a463-c94
-                                      (cons tmp-680b775fb37a463-c95 tmp-680b775fb37a463-c96)))
+                         (map (lambda (tmp-680b775fb37a463-c76
+                                       tmp-680b775fb37a463-c75
+                                       tmp-680b775fb37a463-c74)
+                                (cons tmp-680b775fb37a463-c74
+                                      (cons tmp-680b775fb37a463-c75 tmp-680b775fb37a463-c76)))
                               e2
                               e1
                               args)))
@@ -1871,11 +1831,11 @@
                   (apply (lambda (docstring args e1 e2)
                            (build-it
                              (list (cons 'documentation (syntax->datum docstring)))
-                             (map (lambda (tmp-680b775fb37a463-cac
-                                           tmp-680b775fb37a463-cab
-                                           tmp-680b775fb37a463-caa)
-                                    (cons tmp-680b775fb37a463-caa
-                                          (cons tmp-680b775fb37a463-cab tmp-680b775fb37a463-cac)))
+                             (map (lambda (tmp-680b775fb37a463-c8c
+                                           tmp-680b775fb37a463-c8b
+                                           tmp-680b775fb37a463-c8a)
+                                    (cons tmp-680b775fb37a463-c8a
+                                          (cons tmp-680b775fb37a463-c8b tmp-680b775fb37a463-c8c)))
                                   e2
                                   e1
                                   args)))
@@ -1898,11 +1858,11 @@
               (apply (lambda (args e1 e2)
                        (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-ccc
-                                       tmp-680b775fb37a463-ccb
-                                       tmp-680b775fb37a463-cca)
-                                (cons tmp-680b775fb37a463-cca
-                                      (cons tmp-680b775fb37a463-ccb tmp-680b775fb37a463-ccc)))
+                         (map (lambda (tmp-680b775fb37a463-cac
+                                       tmp-680b775fb37a463-cab
+                                       tmp-680b775fb37a463-caa)
+                                (cons tmp-680b775fb37a463-caa
+                                      (cons tmp-680b775fb37a463-cab tmp-680b775fb37a463-cac)))
                               e2
                               e1
                               args)))
@@ -1914,11 +1874,11 @@
                   (apply (lambda (docstring args e1 e2)
                            (build-it
                              (list (cons 'documentation (syntax->datum docstring)))
-                             (map (lambda (tmp-680b775fb37a463-ce2
-                                           tmp-680b775fb37a463-ce1
-                                           tmp-680b775fb37a463-ce0)
-                                    (cons tmp-680b775fb37a463-ce0
-                                          (cons tmp-680b775fb37a463-ce1 tmp-680b775fb37a463-ce2)))
+                             (map (lambda (tmp-680b775fb37a463-cc2
+                                           tmp-680b775fb37a463-cc1
+                                           tmp-680b775fb37a463-cc0)
+                                    (cons tmp-680b775fb37a463-cc0
+                                          (cons tmp-680b775fb37a463-cc1 tmp-680b775fb37a463-cc2)))
                                   e2
                                   e1
                                   args)))
@@ -1933,10 +1893,10 @@
             (apply (lambda (dots e1 e2)
                      (let ((id (if (symbol? dots)
                                  '#{ $sc-ellipsis }#
-                                 (make-syntax-object
+                                 (make-syntax
                                    '#{ $sc-ellipsis }#
-                                   (syntax-object-wrap dots)
-                                   (syntax-object-module dots)))))
+                                   (syntax-wrap dots)
+                                   (syntax-module dots)))))
                        (let ((ids (list id))
                              (labels (list (gen-label)))
                              (bindings (list (cons 'ellipsis (source-wrap dots w s mod)))))
@@ -2114,10 +2074,10 @@
           ((remodulate
              (lambda (x mod)
                (cond ((pair? x) (cons (remodulate (car x) mod) (remodulate (cdr x) mod)))
-                     ((syntax-object? x)
-                      (make-syntax-object
-                        (remodulate (syntax-object-expression x) mod)
-                        (syntax-object-wrap x)
+                     ((syntax? x)
+                      (make-syntax
+                        (remodulate (syntax-expression x) mod)
+                        (syntax-wrap x)
                         mod))
                      ((vector? x)
                       (let* ((n (vector-length x)) (v (make-vector n)))
@@ -2137,9 +2097,7 @@
             (if (and tmp-1
                      (apply (lambda (id)
                               (and (id? id)
-                                   (equal?
-                                     (cdr (if (syntax-object? id) (syntax-object-module id) mod))
-                                     '(guile))))
+                                   (equal? (cdr (if (syntax? id) (syntax-module id) mod)) '(guile))))
                             tmp-1))
               (apply (lambda (id) (values (syntax->datum id) r '((top)) #f '(primitive)))
                      tmp-1)
@@ -2417,10 +2375,7 @@
     (set! identifier? (lambda (x) (nonsymbol-id? x)))
     (set! datum->syntax
       (lambda (id datum)
-        (make-syntax-object
-          datum
-          (syntax-object-wrap id)
-          (syntax-object-module id))))
+        (make-syntax datum (syntax-wrap id) (syntax-module id))))
     (set! syntax->datum (lambda (x) (strip x '(()))))
     (set! syntax-source (lambda (x) (source-annotation x)))
     (set! generate-temporaries
@@ -2468,7 +2423,7 @@
            (let ((x id))
              (if (not (nonsymbol-id? x))
                (syntax-violation 'syntax-module "invalid argument" x)))
-           (let ((mod (syntax-object-module id)))
+           (let ((mod (syntax-module id)))
              (and (not (equal? mod '(primitive))) (cdr mod)))))
        (syntax-local-binding
          (lambda* (id
@@ -2489,10 +2444,10 @@
                  (call-with-values
                    (lambda ()
                      (resolve-identifier
-                       (syntax-object-expression id)
-                       (strip-anti-mark (syntax-object-wrap id))
+                       (syntax-expression id)
+                       (strip-anti-mark (syntax-wrap id))
                        r
-                       (syntax-object-module id)
+                       (syntax-module id)
                        resolve-syntax-parameters?))
                    (lambda (type value mod)
                      (let ((key type))
@@ -2508,10 +2463,10 @@
                              ((memv key '(ellipsis))
                               (values
                                 'ellipsis
-                                (make-syntax-object
-                                  (syntax-object-expression value)
-                                  (anti-mark (syntax-object-wrap value))
-                                  (syntax-object-module value))))
+                                (make-syntax
+                                  (syntax-expression value)
+                                  (anti-mark (syntax-wrap value))
+                                  (syntax-module value))))
                              (else (values 'other #f)))))))))))
        (syntax-locally-bound-identifiers
          (lambda (id)
@@ -2521,9 +2476,7 @@
                  'syntax-locally-bound-identifiers
                  "invalid argument"
                  x)))
-           (locally-bound-identifiers
-             (syntax-object-wrap id)
-             (syntax-object-module id)))))
+           (locally-bound-identifiers (syntax-wrap id) (syntax-module id)))))
       (define! '%syntax-module %syntax-module)
       (define! 'syntax-local-binding syntax-local-binding)
       (define!
@@ -2538,12 +2491,12 @@
                          (let ((rest (match-each (cdr e) p w mod)))
                            (and rest (cons first rest))))))
                  ((null? e) '())
-                 ((syntax-object? e)
+                 ((syntax? e)
                   (match-each
-                    (syntax-object-expression e)
+                    (syntax-expression e)
                     p
-                    (join-wraps w (syntax-object-wrap e))
-                    (syntax-object-module e)))
+                    (join-wraps w (syntax-wrap e))
+                    (syntax-module e)))
                  (else #f))))
        (match-each+
          (lambda (e x-pat y-pat z-pat w r mod)
@@ -2558,9 +2511,8 @@
                               (if xr (values (cons xr xr*) y-pat r) (values #f #f #f)))
                             (values '() (cdr y-pat) (match (car e) (car y-pat) w r mod)))
                           (values #f #f #f)))))
-                   ((syntax-object? e)
-                    (f (syntax-object-expression e)
-                       (join-wraps w (syntax-object-wrap e))))
+                   ((syntax? e)
+                    (f (syntax-expression e) (join-wraps w (syntax-wrap e))))
                    (else (values '() y-pat (match e z-pat w r mod)))))))
        (match-each-any
          (lambda (e w mod)
@@ -2568,10 +2520,10 @@
                   (let ((l (match-each-any (cdr e) w mod)))
                     (and l (cons (wrap (car e) w mod) l))))
                  ((null? e) '())
-                 ((syntax-object? e)
+                 ((syntax? e)
                   (match-each-any
-                    (syntax-object-expression e)
-                    (join-wraps w (syntax-object-wrap e))
+                    (syntax-expression e)
+                    (join-wraps w (syntax-wrap e))
                     mod))
                  (else #f))))
        (match-empty
@@ -2636,25 +2588,25 @@
                 (cond ((not r) #f)
                       ((eq? p '_) r)
                       ((eq? p 'any) (cons (wrap e w mod) r))
-                      ((syntax-object? e)
+                      ((syntax? e)
                        (match*
-                         (syntax-object-expression e)
+                         (syntax-expression e)
                          p
-                         (join-wraps w (syntax-object-wrap e))
+                         (join-wraps w (syntax-wrap e))
                          r
-                         (syntax-object-module e)))
+                         (syntax-module e)))
                       (else (match* e p w r mod))))))
       (set! $sc-dispatch
         (lambda (e p)
           (cond ((eq? p 'any) (list e))
                 ((eq? p '_) '())
-                ((syntax-object? e)
+                ((syntax? e)
                  (match*
-                   (syntax-object-expression e)
+                   (syntax-expression e)
                    p
-                   (syntax-object-wrap e)
+                   (syntax-wrap e)
                    '()
-                   (syntax-object-module e)))
+                   (syntax-module e)))
                 (else (match* e p '(()) '() #f))))))))
 
 (define with-syntax
@@ -2851,9 +2803,9 @@
                                k
                                (list docstring)
                                (map (lambda (tmp-680b775fb37a463
-                                             tmp-680b775fb37a463-114f
-                                             tmp-680b775fb37a463-114e)
-                                      (list (cons tmp-680b775fb37a463-114e tmp-680b775fb37a463-114f)
+                                             tmp-680b775fb37a463-112f
+                                             tmp-680b775fb37a463-112e)
+                                      (list (cons tmp-680b775fb37a463-112e tmp-680b775fb37a463-112f)
                                             tmp-680b775fb37a463))
                                     template
                                     pattern
@@ -3037,8 +2989,8 @@
                                                (apply (lambda (p)
                                                         (if (= lev 0)
                                                           (quasilist*
-                                                            (map (lambda (tmp-680b775fb37a463-11f3)
-                                                                   (list "value" tmp-680b775fb37a463-11f3))
+                                                            (map (lambda (tmp-680b775fb37a463-11d3)
+                                                                   (list "value" tmp-680b775fb37a463-11d3))
                                                                  p)
                                                             (quasi q lev))
                                                           (quasicons
@@ -3061,8 +3013,8 @@
                                                    (apply (lambda (p)
                                                             (if (= lev 0)
                                                               (quasiappend
-                                                                (map (lambda (tmp-680b775fb37a463-11f8)
-                                                                       (list "value" tmp-680b775fb37a463-11f8))
+                                                                (map (lambda (tmp-680b775fb37a463-11d8)
+                                                                       (list "value" tmp-680b775fb37a463-11d8))
                                                                      p)
                                                                 (quasi q lev))
                                                               (quasicons
@@ -3096,8 +3048,8 @@
                                   (apply (lambda (p)
                                            (if (= lev 0)
                                              (quasilist*
-                                               (map (lambda (tmp-680b775fb37a463-120e)
-                                                      (list "value" tmp-680b775fb37a463-120e))
+                                               (map (lambda (tmp-680b775fb37a463-11ee)
+                                                      (list "value" tmp-680b775fb37a463-11ee))
                                                     p)
                                                (vquasi q lev))
                                              (quasicons
@@ -3116,8 +3068,8 @@
                                       (apply (lambda (p)
                                                (if (= lev 0)
                                                  (quasiappend
-                                                   (map (lambda (tmp-680b775fb37a463)
-                                                          (list "value" tmp-680b775fb37a463))
+                                                   (map (lambda (tmp-680b775fb37a463-11f3)
+                                                          (list "value" tmp-680b775fb37a463-11f3))
                                                         p)
                                                    (vquasi q lev))
                                                  (quasicons
@@ -3207,8 +3159,8 @@
                                 (let ((tmp-1 ls))
                                   (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                     (if tmp
-                                      (apply (lambda (t-680b775fb37a463-125c)
-                                               (cons "vector" t-680b775fb37a463-125c))
+                                      (apply (lambda (t-680b775fb37a463-123c)
+                                               (cons "vector" t-680b775fb37a463-123c))
                                              tmp)
                                       (syntax-violation
                                         #f
@@ -3261,9 +3213,9 @@
                                             (let ((tmp-1 (list (emit (car x*)) (f (cdr x*)))))
                                               (let ((tmp ($sc-dispatch tmp-1 '(any any))))
                                                 (if tmp
-                                                  (apply (lambda (t-680b775fb37a463-129a t-680b775fb37a463)
+                                                  (apply (lambda (t-680b775fb37a463-127a t-680b775fb37a463)
                                                            (list (make-syntax 'cons '((top)) '(hygiene guile))
-                                                                 t-680b775fb37a463-129a
+                                                                 t-680b775fb37a463-127a
                                                                  t-680b775fb37a463))
                                                          tmp)
                                                   (syntax-violation
@@ -3277,9 +3229,9 @@
                                             (let ((tmp-1 (map emit x)))
                                               (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                                 (if tmp
-                                                  (apply (lambda (t-680b775fb37a463-12a6)
+                                                  (apply (lambda (t-680b775fb37a463)
                                                            (cons (make-syntax 'append '((top)) '(hygiene guile))
-                                                                 t-680b775fb37a463-12a6))
+                                                                 t-680b775fb37a463))
                                                          tmp)
                                                   (syntax-violation
                                                     #f
@@ -3292,9 +3244,9 @@
                                                 (let ((tmp-1 (map emit x)))
                                                   (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                                     (if tmp
-                                                      (apply (lambda (t-680b775fb37a463-12b2)
+                                                      (apply (lambda (t-680b775fb37a463)
                                                                (cons (make-syntax 'vector '((top)) '(hygiene guile))
-                                                                     t-680b775fb37a463-12b2))
+                                                                     t-680b775fb37a463))
                                                              tmp)
                                                       (syntax-violation
                                                         #f
@@ -3305,9 +3257,9 @@
                                          (if tmp-1
                                            (apply (lambda (x)
                                                     (let ((tmp (emit x)))
-                                                      (let ((t-680b775fb37a463-12be tmp))
+                                                      (let ((t-680b775fb37a463-129e tmp))
                                                         (list (make-syntax 'list->vector '((top)) '(hygiene guile))
-                                                              t-680b775fb37a463-12be))))
+                                                              t-680b775fb37a463-129e))))
                                                   tmp-1)
                                            (let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any))))
                                              (if tmp-1
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index a51e99d9c..0cad97769 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,7 +1,7 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011,
-;;;;   2012, 2013, 2015, 2016, 2019 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2019
+;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -155,8 +155,8 @@
 
 ;;; Bootstrapping:
 
-;;; When changing syntax-object representations, it is necessary to support
-;;; both old and new syntax-object representations in id-var-name.  It
+;;; When changing syntax representations, it is necessary to support
+;;; both old and new syntax representations in id-var-name.  It
 ;;; should be sufficient to recognize old representations and treat
 ;;; them as not lexically bound.
 
@@ -184,7 +184,7 @@
                           (sfields (map (lambda (f) (datum->syntax x f)) fields))
                           (ctor (datum->syntax x (symbol-append 'make- stem))))
                      (cons #`(define (#,ctor #,@sfields)
-                               (make-struct/no-tail
+                               (make-struct/simple
                                 (vector-ref %expanded-vtables #,n)
                                 #,@sfields))
                            out)))
@@ -450,34 +450,13 @@
       ;; 'gensym' so that the generated identifier is reproducible.
       (module-gensym (symbol->string id)))
 
-    (define (syntax-object? x)
-      (or (syntax? x)
-          (and (allow-legacy-syntax-objects?)
-               (vector? x)
-               (= (vector-length x) 4)
-               (eqv? (vector-ref x 0) 'syntax-object))))
-    (define (make-syntax-object expression wrap module)
-      (make-syntax expression wrap module))
-    (define (syntax-object-expression obj)
-      (if (syntax? obj)
-          (syntax-expression obj)
-          (vector-ref obj 1)))
-    (define (syntax-object-wrap obj)
-      (if (syntax? obj)
-          (syntax-wrap obj)
-          (vector-ref obj 2)))
-    (define (syntax-object-module obj)
-      (if (syntax? obj)
-          (syntax-module obj)
-          (vector-ref obj 3)))
-
     (define-syntax no-source (identifier-syntax #f))
 
     (define source-annotation
       (lambda (x)
         (let ((props (source-properties
-                      (if (syntax-object? x)
-                          (syntax-object-expression x)
+                      (if (syntax? x)
+                          (syntax-expression x)
                           x))))
           (and (pair? props) props))))
 
@@ -599,28 +578,28 @@
 
     (define nonsymbol-id?
       (lambda (x)
-        (and (syntax-object? x)
-             (symbol? (syntax-object-expression x)))))
+        (and (syntax? x)
+             (symbol? (syntax-expression x)))))
 
     (define id?
       (lambda (x)
         (cond
          ((symbol? x) #t)
-         ((syntax-object? x) (symbol? (syntax-object-expression x)))
+         ((syntax? x) (symbol? (syntax-expression x)))
          (else #f))))
 
     (define-syntax-rule (id-sym-name e)
       (let ((x e))
-        (if (syntax-object? x)
-            (syntax-object-expression x)
+        (if (syntax? x)
+            (syntax-expression x)
             x)))
 
     (define id-sym-name&marks
       (lambda (x w)
-        (if (syntax-object? x)
+        (if (syntax? x)
             (values
-             (syntax-object-expression x)
-             (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+             (syntax-expression x)
+             (join-marks (wrap-marks w) (wrap-marks (syntax-wrap x))))
             (values x (wrap-marks w)))))
 
     ;; syntax object wraps
@@ -677,10 +656,10 @@
       ;; must receive ids with complete wraps
       (lambda (ribcage id label)
         (set-ribcage-symnames! ribcage
-                               (cons (syntax-object-expression id)
+                               (cons (syntax-expression id)
                                      (ribcage-symnames ribcage)))
         (set-ribcage-marks! ribcage
-                            (cons (wrap-marks (syntax-object-wrap id))
+                            (cons (wrap-marks (syntax-wrap id))
                                   (ribcage-marks ribcage)))
         (set-ribcage-labels! ribcage
                              (cons label (ribcage-labels ribcage)))))
@@ -810,10 +789,10 @@
         (cond
          ((symbol? id)
           (or (first (search id (wrap-subst w) (wrap-marks w) mod)) id))
-         ((syntax-object? id)
-          (let ((id (syntax-object-expression id))
-                (w1 (syntax-object-wrap id))
-                (mod (syntax-object-module id)))
+         ((syntax? id)
+          (let ((id (syntax-expression id))
+                (w1 (syntax-wrap id))
+                (mod (syntax-module id)))
             (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
               (call-with-values (lambda () (search id (wrap-subst w) marks mod))
                 (lambda (new-id marks)
@@ -942,7 +921,7 @@
               (values 'displaced-lexical #f #f))))
       (let ((n (id-var-name id w mod)))
         (cond
-         ((syntax-object? n)
+         ((syntax? n)
           (cond
            ((not (eq? n id))
             ;; This identifier aliased another; recurse to allow
@@ -952,18 +931,18 @@
            (else
             ;; Resolved to a free variable that was introduced by this
             ;; macro; continue to resolve this global by name.
-            (resolve-identifier (syntax-object-expression n)
-                                (syntax-object-wrap n)
+            (resolve-identifier (syntax-expression n)
+                                (syntax-wrap n)
                                 r
-                                (syntax-object-module n)
+                                (syntax-module n)
                                 resolve-syntax-parameters?))))
          ((symbol? n)
-          (resolve-global n (if (syntax-object? id)
-                                (syntax-object-module id)
+          (resolve-global n (if (syntax? id)
+                                (syntax-module id)
                                 mod)))
          ((string? n)
-          (resolve-lexical n (if (syntax-object? id)
-                                 (syntax-object-module id)
+          (resolve-lexical n (if (syntax? id)
+                                 (syntax-module id)
                                  mod)))
          (else
           (error "unexpected id-var-name" id w n)))))
@@ -981,8 +960,8 @@
 
     (define free-id=?
       (lambda (i j)
-        (let* ((mi (and (syntax-object? i) (syntax-object-module i)))
-               (mj (and (syntax-object? j) (syntax-object-module j)))
+        (let* ((mi (and (syntax? i) (syntax-module i)))
+               (mj (and (syntax? j) (syntax-module j)))
                (ni (id-var-name i empty-wrap mi))
                (nj (id-var-name j empty-wrap mj)))
           (define (id-module-binding id mod)
@@ -995,8 +974,8 @@
                  (current-module))
              (id-sym-name id)))
           (cond
-           ((syntax-object? ni) (free-id=? ni j))
-           ((syntax-object? nj) (free-id=? i nj))
+           ((syntax? ni) (free-id=? ni j))
+           ((syntax? nj) (free-id=? i nj))
            ((symbol? ni)
             ;; `i' is not lexically bound.  Assert that `j' is free,
             ;; and if so, compare their bindings, that they are either
@@ -1020,11 +999,11 @@
 
     (define bound-id=?
       (lambda (i j)
-        (if (and (syntax-object? i) (syntax-object? j))
-            (and (eq? (syntax-object-expression i)
-                      (syntax-object-expression j))
-                 (same-marks? (wrap-marks (syntax-object-wrap i))
-                              (wrap-marks (syntax-object-wrap j))))
+        (if (and (syntax? i) (syntax? j))
+            (and (eq? (syntax-expression i)
+                      (syntax-expression j))
+                 (same-marks? (wrap-marks (syntax-wrap i))
+                              (wrap-marks (syntax-wrap j))))
             (eq? i j))))
 
     ;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
@@ -1065,13 +1044,13 @@
       (lambda (x w defmod)
         (cond
          ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
-         ((syntax-object? x)
-          (make-syntax-object
-           (syntax-object-expression x)
-           (join-wraps w (syntax-object-wrap x))
-           (syntax-object-module x)))
+         ((syntax? x)
+          (make-syntax
+           (syntax-expression x)
+           (join-wraps w (syntax-wrap x))
+           (syntax-module x)))
          ((null? x) x)
-         (else (make-syntax-object x w defmod)))))
+         (else (make-syntax x w defmod)))))
 
     (define source-wrap
       (lambda (x w s defmod)
@@ -1116,13 +1095,13 @@
               ;; the special case of names that are pairs.  See the
               ;; comments in id-var-name for more.
               (extend-ribcage! ribcage id
-                               (cons (syntax-object-module id)
+                               (cons (syntax-module id)
                                      (wrap var top-wrap mod)))))
           (define (macro-introduced-identifier? id)
-            (not (equal? (wrap-marks (syntax-object-wrap id)) '(top))))
+            (not (equal? (wrap-marks (syntax-wrap id)) '(top))))
           (define (fresh-derived-name id orig-form)
             (symbol-append
-             (syntax-object-expression id)
+             (syntax-expression id)
              '-
              (string->symbol
               ;; FIXME: `hash' currently stops descending into nested
@@ -1159,7 +1138,7 @@
                           (label (gen-label))
                           (var (if (macro-introduced-identifier? id)
                                    (fresh-derived-name id x)
-                                   (syntax-object-expression id))))
+                                   (syntax-expression id))))
                      (record-definition! id var)
                      (list
                       (if (eq? m 'c&e)
@@ -1182,7 +1161,7 @@
                           (label (gen-label))
                           (var (if (macro-introduced-identifier? id)
                                    (fresh-derived-name id x)
-                                   (syntax-object-expression id))))
+                                   (syntax-expression id))))
                      (record-definition! id var)
                      (case m
                        ((c)
@@ -1368,7 +1347,7 @@
                        ;; need to make sure the fmod information is
                        ;; propagated back correctly -- hence this
                        ;; consing.
-                       (values 'global-call (make-syntax-object fval w fmod)
+                       (values 'global-call (make-syntax fval w fmod)
                                e e w s mod)))
                   ((macro)
                    (syntax-type (expand-macro fval e r w s rib mod)
@@ -1418,12 +1397,12 @@
                       (values 'define-syntax-parameter-form #'name e #'val w s mod))))
                   (else
                    (values 'call #f e e w s mod)))))))
-         ((syntax-object? e)
-          (syntax-type (syntax-object-expression e)
+         ((syntax? e)
+          (syntax-type (syntax-expression e)
                        r
-                       (join-wraps w (syntax-object-wrap e))
+                       (join-wraps w (syntax-wrap e))
                        (or (source-annotation e) s) rib
-                       (or (syntax-object-module e) mod) for-car?))
+                       (or (syntax-module e) mod) for-car?))
          ((self-evaluating? e) (values 'constant #f e e w s mod))
          (else (values 'other #f e e w s mod)))))
 
@@ -1450,7 +1429,7 @@
            (expand-call
             (let ((id (car e)))
               (build-lexical-reference 'fun (source-annotation id)
-                                       (if (syntax-object? id)
+                                       (if (syntax? id)
                                            (syntax->datum id)
                                            id)
                                        value))
@@ -1458,11 +1437,11 @@
           ((global-call)
            (expand-call
             (build-global-reference (source-annotation (car e))
-                                    (if (syntax-object? value)
-                                        (syntax-object-expression value)
+                                    (if (syntax? value)
+                                        (syntax-expression value)
                                         value)
-                                    (if (syntax-object? value)
-                                        (syntax-object-module value)
+                                    (if (syntax? value)
+                                        (syntax-module value)
                                         mod))
             e r w s mod))
           ((primitive-call)
@@ -1551,23 +1530,23 @@
                     (cons (rebuild-macro-output (car x) m)
                           (rebuild-macro-output (cdr x) m))
                     s))
-                  ((syntax-object? x)
-                   (let ((w (syntax-object-wrap x)))
+                  ((syntax? x)
+                   (let ((w (syntax-wrap x)))
                      (let ((ms (wrap-marks w)) (ss (wrap-subst w)))
                        (if (and (pair? ms) (eq? (car ms) the-anti-mark))
                            ;; output is from original text
-                           (make-syntax-object
-                            (syntax-object-expression x)
+                           (make-syntax
+                            (syntax-expression x)
                             (make-wrap (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss)))
-                            (syntax-object-module x))
+                            (syntax-module x))
                            ;; output introduced by macro
-                           (make-syntax-object
-                            (decorate-source (syntax-object-expression x) s)
+                           (make-syntax
+                            (decorate-source (syntax-expression x) s)
                             (make-wrap (cons m ms)
                                        (if rib
                                            (cons rib (cons 'shift ss))
                                            (cons 'shift ss)))
-                            (syntax-object-module x))))))
+                            (syntax-module x))))))
                 
                   ((vector? x)
                    (let* ((n (vector-length x))
@@ -1773,9 +1752,9 @@
              ;; comparison is done using 'bound-id=?'.
              (call-with-values
                  (lambda () (resolve-identifier
-                             (make-syntax-object '#{ $sc-ellipsis }#
-                                                 (syntax-object-wrap e)
-                                                 (syntax-object-module e))
+                             (make-syntax '#{ $sc-ellipsis }#
+                                                 (syntax-wrap e)
+                                                 (syntax-module e))
                              empty-wrap r mod #f))
                (lambda (type value mod)
                  (if (eq? type 'ellipsis)
@@ -1991,7 +1970,7 @@
 
     ;; data
 
-    ;; strips syntax-objects down to top-wrap
+    ;; strips syntax objects down to top-wrap
     ;;
     ;; since only the head of a list is annotated by the reader, not each pair
     ;; in the spine, we also check for pairs whose cars are annotated in case
@@ -2003,8 +1982,8 @@
             x
             (let f ((x x))
               (cond
-               ((syntax-object? x)
-                (strip (syntax-object-expression x) (syntax-object-wrap x)))
+               ((syntax? x)
+                (strip (syntax-expression x) (syntax-wrap x)))
                ((pair? x)
                 (let ((a (f (car x))) (d (f (cdr x))))
                   (if (and (eq? a (car x)) (eq? d (cdr x)))
@@ -2026,7 +2005,7 @@
 
     (define gen-var
       (lambda (id)
-        (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+        (let ((id (if (syntax? id) (syntax-expression id) id)))
           (build-lexical-var no-source id))))
 
     ;; appears to return a reversed list
@@ -2037,10 +2016,10 @@
            ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls) w))
            ((id? vars) (cons (wrap vars w #f) ls))
            ((null? vars) ls)
-           ((syntax-object? vars)
-            (lvl (syntax-object-expression vars)
+           ((syntax? vars)
+            (lvl (syntax-expression vars)
                  ls
-                 (join-wraps w (syntax-object-wrap vars))))
+                 (join-wraps w (syntax-wrap vars))))
            ;; include anything else to be caught by subsequent error
            ;; checking
            (else (cons vars ls))))))
@@ -2336,9 +2315,9 @@
                         (id? #'dots)
                         (let ((id (if (symbol? #'dots)
                                       '#{ $sc-ellipsis }#
-                                      (make-syntax-object '#{ $sc-ellipsis }#
-                                                          (syntax-object-wrap #'dots)
-                                                          (syntax-object-module #'dots)))))
+                                      (make-syntax '#{ $sc-ellipsis }#
+                                                          (syntax-wrap #'dots)
+                                                          (syntax-module #'dots)))))
                           (let ((ids (list id))
                                 (labels (list (gen-label)))
                                 (bindings (list (make-binding 'ellipsis (source-wrap #'dots w s mod)))))
@@ -2490,10 +2469,10 @@
                          (cond ((pair? x)
                                 (cons (remodulate (car x) mod)
                                       (remodulate (cdr x) mod)))
-                               ((syntax-object? x)
-                                (make-syntax-object
-                                 (remodulate (syntax-object-expression x) mod)
-                                 (syntax-object-wrap x)
+                               ((syntax? x)
+                                (make-syntax
+                                 (remodulate (syntax-expression x) mod)
+                                 (syntax-wrap x)
                                  ;; hither the remodulation
                                  mod))
                                ((vector? x)
@@ -2505,8 +2484,8 @@
                      (syntax-case e (@@ primitive)
                        ((_ primitive id)
                         (and (id? #'id)
-                             (equal? (cdr (if (syntax-object? #'id)
-                                              (syntax-object-module #'id)
+                             (equal? (cdr (if (syntax? #'id)
+                                              (syntax-module #'id)
                                               mod))
                                      '(guile)))
                         ;; Strip the wrap from the identifier and return top-wrap
@@ -2753,8 +2732,8 @@
 
     (set! datum->syntax
           (lambda (id datum)
-            (make-syntax-object datum (syntax-object-wrap id)
-                                (syntax-object-module id))))
+            (make-syntax datum (syntax-wrap id)
+                                (syntax-module id))))
 
     (set! syntax->datum
           ;; accepts any object, since syntax objects may consist partially
@@ -2799,7 +2778,7 @@
     (let ()
       (define (%syntax-module id)
         (arg-check nonsymbol-id? id 'syntax-module)
-        (let ((mod (syntax-object-module id)))
+        (let ((mod (syntax-module id)))
           (and (not (equal? mod '(primitive)))
                (cdr mod))))
 
@@ -2816,10 +2795,10 @@
                    (make-wrap ms (if rib (cons rib s) s)))))
            (call-with-values (lambda ()
                                (resolve-identifier
-                                (syntax-object-expression id)
-                                (strip-anti-mark (syntax-object-wrap id))
+                                (syntax-expression id)
+                                (strip-anti-mark (syntax-wrap id))
                                 r
-                                (syntax-object-module id)
+                                (syntax-module id)
                                 resolve-syntax-parameters?))
              (lambda (type value mod)
                (case type
@@ -2834,15 +2813,15 @@
                       (values 'global (cons value (cdr mod)))))
                  ((ellipsis)
                   (values 'ellipsis
-                          (make-syntax-object (syntax-object-expression value)
-                                              (anti-mark (syntax-object-wrap value))
-                                              (syntax-object-module value))))
+                          (make-syntax (syntax-expression value)
+                                              (anti-mark (syntax-wrap value))
+                                              (syntax-module value))))
                  (else (values 'other #f))))))))
 
       (define (syntax-locally-bound-identifiers id)
         (arg-check nonsymbol-id? id 'syntax-locally-bound-identifiers)
-        (locally-bound-identifiers (syntax-object-wrap id)
-                                   (syntax-object-module id)))
+        (locally-bound-identifiers (syntax-wrap id)
+                                   (syntax-module id)))
 
       ;; Using define! instead of set! to avoid warnings at
       ;; compile-time, after the variables are stolen away into (system
@@ -2886,11 +2865,11 @@
                    (let ((rest (match-each (cdr e) p w mod)))
                      (and rest (cons first rest))))))
            ((null? e) '())
-           ((syntax-object? e)
-            (match-each (syntax-object-expression e)
+           ((syntax? e)
+            (match-each (syntax-expression e)
                         p
-                        (join-wraps w (syntax-object-wrap e))
-                        (syntax-object-module e)))
+                        (join-wraps w (syntax-wrap e))
+                        (syntax-module e)))
            (else #f))))
 
       (define match-each+
@@ -2911,9 +2890,9 @@
                            (cdr y-pat)
                            (match (car e) (car y-pat) w r mod)))
                       (values #f #f #f)))))
-             ((syntax-object? e)
-              (f (syntax-object-expression e)
-                 (join-wraps w (syntax-object-wrap e))))
+             ((syntax? e)
+              (f (syntax-expression e)
+                 (join-wraps w (syntax-wrap e))))
              (else
               (values '() y-pat (match e z-pat w r mod)))))))
 
@@ -2924,9 +2903,9 @@
             (let ((l (match-each-any (cdr e) w mod)))
               (and l (cons (wrap (car e) w mod) l))))
            ((null? e) '())
-           ((syntax-object? e)
-            (match-each-any (syntax-object-expression e)
-                            (join-wraps w (syntax-object-wrap e))
+           ((syntax? e)
+            (match-each-any (syntax-expression e)
+                            (join-wraps w (syntax-wrap e))
                             mod))
            (else #f))))
 
@@ -2997,13 +2976,13 @@
            ((not r) #f)
            ((eq? p '_) r)
            ((eq? p 'any) (cons (wrap e w mod) r))
-           ((syntax-object? e)
+           ((syntax? e)
             (match*
-             (syntax-object-expression e)
+             (syntax-expression e)
              p
-             (join-wraps w (syntax-object-wrap e))
+             (join-wraps w (syntax-wrap e))
              r
-             (syntax-object-module e)))
+             (syntax-module e)))
            (else (match* e p w r mod)))))
 
       (set! $sc-dispatch
@@ -3011,9 +2990,9 @@
               (cond
                ((eq? p 'any) (list e))
                ((eq? p '_) '())
-               ((syntax-object? e)
-                (match* (syntax-object-expression e)
-                        p (syntax-object-wrap e) '() (syntax-object-module e)))
+               ((syntax? e)
+                (match* (syntax-expression e)
+                        p (syntax-wrap e) '() (syntax-module e)))
                (else (match* e p empty-wrap '() #f))))))))
 
 
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index d25dc2d66..bbb811952 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -1,6 +1,6 @@
 ;;; Sandboxed evaluation of Scheme code
 
-;;; Copyright (C) 2017 Free Software Foundation, Inc.
+;;; Copyright (C) 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -260,10 +260,7 @@ allocation limit is exceeded, an exception will be thrown to the
       (call-with-time-and-allocation-limits
        time-limit allocation-limit
        (lambda ()
-         ;; Prevent the expression from forging syntax objects.  See "Syntax
-         ;; Transformer Helpers" in the manual.
-         (parameterize ((allow-legacy-syntax-objects? #f))
-           (eval exp module)))))
+         (eval exp module))))
     (lambda () (when sever-module? (sever-module! module)))))
 
 
diff --git a/module/ice-9/syncase.scm b/module/ice-9/syncase.scm
deleted file mode 100644
index 219803ef0..000000000
--- a/module/ice-9/syncase.scm
+++ /dev/null
@@ -1,37 +0,0 @@
-;;;; 	Copyright (C) 1997, 2000, 2001, 2002, 2003, 2006, 2010 Free Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
-
-
-(define-module (ice-9 syncase)
-  ;; FIXME re-export other procs
-  #:export (datum->syntax-object syntax-object->datum
-            sc-expand))
-
-(issue-deprecation-warning
- "Syntax-case macros are now a part of Guile core; importing (ice-9 syncase) is no longer necessary.")
-
-(define datum->syntax-object datum->syntax)
-(define syntax-object->datum syntax->datum)
-(define sc-expand macroexpand)
-
-;;; Hack to make syncase macros work in the slib module
-;; FIXME wingo is this still necessary?
-;; (let ((m (nested-ref the-root-module '(%app modules ice-9 slib))))
-;;   (if m
-;;       (set-object-property! (module-local-variable m 'define)
-;; 			    '*sc-expander*
-;; 			    '(define))))
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm
index c140b4bb3..ec0392ba4 100644
--- a/module/language/bytecode.scm
+++ b/module/language/bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Bytecode
 
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -24,12 +24,16 @@
   #:export (instruction-list
             instruction-arity
             builtin-name->index
-            builtin-index->name))
+            builtin-index->name
+            intrinsic-name->index
+            intrinsic-index->name))
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_instructions")
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_vm_builtins")
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_intrinsics")
 
 (define (compute-instruction-arity name args)
   (define (first-word-arity word)
@@ -42,6 +46,7 @@
       ((X8_S8_I16) 2)
       ((X8_S12_S12) 2)
       ((X8_S12_C12) 2)
+      ((X8_S12_Z12) 2)
       ((X8_C12_C12) 2)
       ((X8_F12_F12) 2)
       ((X8_S8_S8_S8) 3)
@@ -58,6 +63,8 @@
       ((L32) 1)
       ((LO32) 1)
       ((C8_C24) 2)
+      ((C8_S24) 2)
+      ((C16_C16) 2)
       ((B1_C7_L24) 3)
       ((B1_X7_S24) 2)
       ((B1_X7_F24) 2)
@@ -76,9 +83,9 @@
            args))))
 
 (define *macro-instruction-arities*
-  '((cache-current-module! . (0 . 2))
-    (cached-toplevel-box . (1 . 3))
-    (cached-module-box . (1 . 4))))
+  '((cache-current-module! . (0 . 1))
+    (cached-toplevel-box . (1 . 0))
+    (cached-module-box . (1 . 0))))
 
 (define (compute-instruction-arities)
   (let ((table (make-hash-table)))
@@ -102,3 +109,22 @@
 
 (define (instruction-arity name)
   (hashq-ref (force *instruction-arities*) name))
+
+(define *intrinsic-codes*
+  (delay (let ((tab (make-hash-table)))
+           (for-each (lambda (pair)
+                       (hashv-set! tab (car pair) (cdr pair)))
+                     (intrinsic-list))
+           tab)))
+
+(define *intrinsic-names*
+  (delay (let ((tab (make-hash-table)))
+           (hash-for-each (lambda (k v) (hashq-set! tab v k))
+                          (force *intrinsic-codes*))
+           tab)))
+
+(define (intrinsic-name->index name)
+  (hashq-ref (force *intrinsic-codes*) name))
+
+(define (intrinsic-index->name index)
+  (hashv-ref (force *intrinsic-names*) index))
diff --git a/module/language/cps.scm b/module/language/cps.scm
index 5d4826990..604347dda 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -127,11 +127,11 @@
             $kreceive $kargs $kfun $ktail $kclause
 
             ;; Terms.
-            $continue
+            $continue $branch $prompt $throw
 
             ;; Expressions.
-            $const $prim $fun $rec $closure $branch
-            $call $callk $primcall $values $prompt
+            $const $prim $fun $rec $const-fun $code
+            $call $callk $primcall $values
 
             ;; Building macros.
             build-cont build-term build-exp
@@ -179,19 +179,21 @@
 
 ;; Terms.
 (define-cps-type $continue k src exp)
+(define-cps-type $branch kf kt src op param args)
+(define-cps-type $prompt k kh src escape? tag)
+(define-cps-type $throw src op param args)
 
 ;; Expressions.
 (define-cps-type $const val)
 (define-cps-type $prim name)
 (define-cps-type $fun body) ; Higher-order.
 (define-cps-type $rec names syms funs) ; Higher-order.
-(define-cps-type $closure label nfree) ; First-order.
-(define-cps-type $branch kt exp)
+(define-cps-type $const-fun label) ; First-order.
+(define-cps-type $code label) ; First-order.
 (define-cps-type $call proc args)
 (define-cps-type $callk k proc args) ; First-order.
-(define-cps-type $primcall name args)
+(define-cps-type $primcall name param args)
 (define-cps-type $values args)
-(define-cps-type $prompt escape? tag handler)
 
 (define-syntax build-arity
   (syntax-rules (unquote)
@@ -223,33 +225,45 @@
     ((_ (unquote exp))
      exp)
     ((_ ($continue k src exp))
-     (make-$continue k src (build-exp exp)))))
+     (make-$continue k src (build-exp exp)))
+    ((_ ($branch kf kt src op param (unquote args)))
+     (make-$branch kf kt src op param args))
+    ((_ ($branch kf kt src op param (arg ...)))
+     (make-$branch kf kt src op param (list arg ...)))
+    ((_ ($branch kf kt src op param args))
+     (make-$branch kf kt src op param args))
+    ((_ ($prompt k kh src escape? tag))
+     (make-$prompt k kh src escape? tag))
+    ((_ ($throw src op param (unquote args)))
+     (make-$throw src op param args))
+    ((_ ($throw src op param (arg ...)))
+     (make-$throw src op param (list arg ...)))
+    ((_ ($throw src op param args))
+     (make-$throw src op param args))))
 
 (define-syntax build-exp
   (syntax-rules (unquote
-                 $const $prim $fun $rec $closure $branch
-                 $call $callk $primcall $values $prompt)
+                 $const $prim $fun $rec $const-fun $code
+                 $call $callk $primcall $values)
     ((_ (unquote exp)) exp)
     ((_ ($const val)) (make-$const val))
     ((_ ($prim name)) (make-$prim name))
     ((_ ($fun kentry)) (make-$fun kentry))
     ((_ ($rec names gensyms funs)) (make-$rec names gensyms funs))
-    ((_ ($closure k nfree)) (make-$closure k nfree))
+    ((_ ($const-fun k)) (make-$const-fun k))
+    ((_ ($code k)) (make-$code k))
     ((_ ($call proc (unquote args))) (make-$call proc args))
     ((_ ($call proc (arg ...))) (make-$call proc (list arg ...)))
     ((_ ($call proc args)) (make-$call proc args))
     ((_ ($callk k proc (unquote args))) (make-$callk k proc args))
     ((_ ($callk k proc (arg ...))) (make-$callk k proc (list arg ...)))
     ((_ ($callk k proc args)) (make-$callk k proc args))
-    ((_ ($primcall name (unquote args))) (make-$primcall name args))
-    ((_ ($primcall name (arg ...))) (make-$primcall name (list arg ...)))
-    ((_ ($primcall name args)) (make-$primcall name args))
+    ((_ ($primcall name param (unquote args))) (make-$primcall name param args))
+    ((_ ($primcall name param (arg ...))) (make-$primcall name param (list arg ...)))
+    ((_ ($primcall name param args)) (make-$primcall name param args))
     ((_ ($values (unquote args))) (make-$values args))
     ((_ ($values (arg ...))) (make-$values (list arg ...)))
-    ((_ ($values args)) (make-$values args))
-    ((_ ($branch kt exp)) (make-$branch kt (build-exp exp)))
-    ((_ ($prompt escape? tag handler))
-     (make-$prompt escape? tag handler))))
+    ((_ ($values args)) (make-$values args))))
 
 (define-syntax-rule (rewrite-cont x (pat cont) ...)
   (match x
@@ -280,9 +294,17 @@
     (('kclause (req opt rest kw allow-other-keys?) kbody kalt)
      (build-cont ($kclause (req opt rest kw allow-other-keys?) kbody kalt)))
 
-    ;; Calls.
+    ;; Terms.
     (('continue k exp)
      (build-term ($continue k (src exp) ,(parse-cps exp))))
+    (('branch kf kt op param arg ...)
+     (build-term ($branch kf kt (src exp) op param arg)))
+    (('prompt k kh escape? tag)
+     (build-term ($prompt k kh (src exp) escape? tag)))
+    (('throw op param arg ...)
+     (build-term ($throw (src exp) op param arg)))
+
+    ;; Expressions.
     (('unspecified)
      (build-exp ($const *unspecified*)))
     (('const exp)
@@ -291,22 +313,20 @@
      (build-exp ($prim name)))
     (('fun kbody)
      (build-exp ($fun kbody)))
-    (('closure k nfree)
-     (build-exp ($closure k nfree)))
+    (('const-fun k)
+     (build-exp ($const-fun k)))
+    (('code k)
+     (build-exp ($code k)))
     (('rec (name sym fun) ...)
      (build-exp ($rec name sym (map parse-cps fun))))
     (('call proc arg ...)
      (build-exp ($call proc arg)))
     (('callk k proc arg ...)
      (build-exp ($callk k proc arg)))
-    (('primcall name arg ...)
-     (build-exp ($primcall name arg)))
-    (('branch k exp)
-     (build-exp ($branch k ,(parse-cps exp))))
+    (('primcall name param arg ...)
+     (build-exp ($primcall name param arg)))
     (('values arg ...)
      (build-exp ($values arg)))
-    (('prompt escape? tag handler)
-     (build-exp ($prompt escape? tag handler)))
     (_
      (error "unexpected cps" exp))))
 
@@ -325,9 +345,17 @@
      `(kclause (,req ,opt ,rest ,kw ,allow-other-keys?) ,kbody
                . ,(if kalternate (list kalternate) '())))
 
-    ;; Calls.
+    ;; Terms.
     (($ $continue k src exp)
      `(continue ,k ,(unparse-cps exp)))
+    (($ $branch kf kt src op param args)
+     `(branch ,kf ,kt ,op ,param ,@args))
+    (($ $prompt k kh src escape? tag)
+     `(prompt ,k ,kh ,escape? ,tag))
+    (($ $throw src op param args)
+     `(throw ,op ,param ,@args))
+
+    ;; Expressions.
     (($ $const val)
      (if (unspecified? val)
          '(unspecified)
@@ -336,8 +364,10 @@
      `(prim ,name))
     (($ $fun kbody)
      `(fun ,kbody))
-    (($ $closure k nfree)
-     `(closure ,k ,nfree))
+    (($ $const-fun k)
+     `(const-fun ,k))
+    (($ $code k)
+     `(code ,k))
     (($ $rec names syms funs)
      `(rec ,@(map (lambda (name sym fun)
                     (list name sym (unparse-cps fun)))
@@ -346,13 +376,9 @@
      `(call ,proc ,@args))
     (($ $callk k proc args)
      `(callk ,k ,proc ,@args))
-    (($ $primcall name args)
-     `(primcall ,name ,@args))
-    (($ $branch k exp)
-     `(branch ,k ,(unparse-cps exp)))
+    (($ $primcall name param args)
+     `(primcall ,name ,param ,@args))
     (($ $values args)
      `(values ,@args))
-    (($ $prompt escape? tag handler)
-     `(prompt ,escape? ,tag ,handler))
     (_
      (error "unexpected cps" exp))))
diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm
index 2fe4d8030..1452212f0 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,14 +19,17 @@
 ;;; Commentary:
 ;;;
 ;;; This pass converts a CPS term in such a way that no function has any
-;;; free variables.  Instead, closures are built explicitly with
-;;; make-closure primcalls, and free variables are referenced through
-;;; the closure.
+;;; free variables.  Instead, closures are built explicitly as heap
+;;; objects, and free variables are referenced through the closure.
 ;;;
 ;;; Closure conversion also removes any $rec expressions that
 ;;; contification did not handle.  See (language cps) for a further
 ;;; discussion of $rec.
 ;;;
+;;; Before closure conversion, function self variables are always bound.
+;;; After closure conversion, well-known functions with no free
+;;; variables may have no self reference.
+;;;
 ;;; Code:
 
 (define-module (language cps closure-conversion)
@@ -35,6 +38,7 @@
                                         filter-map
                                         ))
   #:use-module (srfi srfi-11)
+  #:use-module (system base types internal)
   #:use-module (language cps)
   #:use-module (language cps utils)
   #:use-module (language cps with-cps)
@@ -89,14 +93,14 @@ conts."
             (add-uses args uses))
            (($ $call proc args)
             (add-uses args uses))
-           (($ $branch kt ($ $values (arg)))
-            (add-use arg uses))
-           (($ $branch kt ($ $primcall name args))
-            (add-uses args uses))
-           (($ $primcall name args)
-            (add-uses args uses))
-           (($ $prompt escape? tag handler)
-            (add-use tag uses))))
+           (($ $primcall name param args)
+            (add-uses args uses))))
+        (($ $kargs _ _ ($ $branch kf kt src op param args))
+         (add-uses args uses))
+        (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+         (add-use tag uses))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (add-uses args uses))
         (_ uses)))
     conts
     empty-intset)))
@@ -119,8 +123,10 @@ conts."
       (($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
       (($ $ktail) (ref0))
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
-      (($ $kargs names syms ($ $continue k src exp))
-       (ref2 k (match exp (($ $branch k) k) (($ $prompt _ _ k) k) (_ #f))))))
+      (($ $kargs _ _ ($ $continue k)) (ref1 k))
+      (($ $kargs _ _ ($ $branch kf kt)) (ref2 kf kt))
+      (($ $kargs _ _ ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs _ _ ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intset-fold add-ref body single multiple)))
     (intset-subtract (persistent-intset single)
@@ -228,37 +234,37 @@ proc argument.  For recursive calls, use the appropriate 'self'
 variable, if possible.  Also rewrite uses of the non-well-known but
 shared closures to use the appropriate 'self' variable, if possible."
   ;; env := var -> (var . label)
-  (define (rewrite-fun kfun cps env)
+  (define (visit-fun kfun cps env)
     (define (subst var)
       (match (intmap-ref env var (lambda (_) #f))
         (#f var)
         ((var . label) var)))
 
-    (define (rename-exp label cps names vars k src exp)
-      (intmap-replace!
-       cps label
-       (build-cont
-         ($kargs names vars
-           ($continue k src
-             ,(rewrite-exp exp
-                ((or ($ $const) ($ $prim)) ,exp)
-                (($ $call proc args)
-                 ,(let ((args (map subst args)))
-                    (rewrite-exp (intmap-ref env proc (lambda (_) #f))
-                      (#f ($call proc ,args))
-                      ((closure . label) ($callk label closure ,args)))))
-                (($ $primcall name args)
-                 ($primcall name ,(map subst args)))
-                (($ $branch k ($ $values (arg)))
-                 ($branch k ($values ((subst arg)))))
-                (($ $branch k ($ $primcall name args))
-                 ($branch k ($primcall name ,(map subst args))))
-                (($ $values args)
-                 ($values ,(map subst args)))
-                (($ $prompt escape? tag handler)
-                 ($prompt escape? (subst tag) handler))))))))
-
-    (define (visit-exp label cps names vars k src exp)
+    (define (visit-exp exp)
+      (rewrite-exp exp
+        ((or ($ $const) ($ $prim)) ,exp)
+        (($ $call proc args)
+         ,(let ((args (map subst args)))
+            (rewrite-exp (intmap-ref env proc (lambda (_) #f))
+              (#f ($call proc ,args))
+              ((closure . label) ($callk label closure ,args)))))
+        (($ $primcall name param args)
+         ($primcall name param ,(map subst args)))
+        (($ $values args)
+         ($values ,(map subst args)))))
+
+    (define (visit-term term)
+      (rewrite-term term
+        (($ $continue k src exp)
+         ($continue k src ,(visit-exp exp)))
+        (($ $branch kf kt src op param args)
+         ($branch kf kt src op param ,(map subst args)))
+        (($ $prompt k kh src escape? tag)
+         ($prompt k kh src escape? (subst tag)))
+        (($ $throw src op param args)
+         ($throw src op param ,(map subst args)))))
+
+    (define (visit-rec labels vars cps)
       (define (compute-env label bound self rec-bound rec-labels env)
         (define (add-bound-var bound label env)
           (intmap-add env bound (cons self label) (lambda (old new) new)))
@@ -269,26 +275,27 @@ shared closures to use the appropriate 'self' variable, if possible."
             ;; Otherwise be sure to use "self" references in any
             ;; closure.
             (add-bound-var bound label env)))
-      (match exp
-        (($ $fun label)
-         (rewrite-fun label cps env))
-        (($ $rec names vars (($ $fun labels) ...))
-         (fold (lambda (label var cps)
-                 (match (intmap-ref cps label)
-                   (($ $kfun src meta self)
-                    (rewrite-fun label cps
-                                 (compute-env label var self vars labels
-                                              env)))))
-               cps labels vars))
-        (_ (rename-exp label cps names vars k src exp))))
-    
-    (define (rewrite-cont label cps)
+      (fold (lambda (label var cps)
+              (match (intmap-ref cps label)
+                (($ $kfun src meta self)
+                 (visit-fun label cps
+                            (compute-env label var self vars labels env)))))
+            cps labels vars))
+
+    (define (visit-cont label cps)
       (match (intmap-ref cps label)
-        (($ $kargs names vars ($ $continue k src exp))
-         (visit-exp label cps names vars k src exp))
+        (($ $kargs names vars
+            ($ $continue k src ($ $fun label)))
+         (visit-fun label cps env))
+        (($ $kargs _ _
+            ($ $continue k src ($ $rec names vars (($ $fun labels) ...))))
+         (visit-rec labels vars cps))
+        (($ $kargs names vars term)
+         (with-cps cps
+           (setk label ($kargs names vars ,(visit-term term)))))
         (_ cps)))
 
-    (intset-fold rewrite-cont (intmap-ref functions kfun) cps))
+    (intset-fold visit-cont (intmap-ref functions kfun) cps))
 
   ;; Initial environment is bound-var -> (shared-var . label) map for
   ;; functions with shared closures.
@@ -303,7 +310,7 @@ shared closures to use the appropriate 'self' variable, if possible."
                                          env))
                           shared
                           empty-intmap)))
-    (persistent-intmap (rewrite-fun kfun cps env))))
+    (persistent-intmap (visit-fun kfun cps env))))
 
 (define (compute-free-vars conts kfun shared)
   "Compute a FUN-LABEL->FREE-VAR... map describing all free variable
@@ -354,33 +361,35 @@ references."
             (intset-fold
              (lambda (label defs uses)
                (match (intmap-ref conts label)
-                 (($ $kargs names vars ($ $continue k src exp))
+                 (($ $kargs names vars term)
                   (values
                    (add-defs vars defs)
-                   (match exp
-                     ((or ($ $const) ($ $prim)) uses)
-                     (($ $fun kfun)
-                      (intset-union (persistent-intset uses)
-                                    (intmap-ref free kfun)))
-                     (($ $rec names vars (($ $fun kfun) ...))
-                      (fold (lambda (kfun uses)
-                              (intset-union (persistent-intset uses)
-                                            (intmap-ref free kfun)))
-                            uses kfun))
-                     (($ $values args)
-                      (add-uses args uses))
-                     (($ $call proc args)
-                      (add-use proc (add-uses args uses)))
-                     (($ $callk label proc args)
-                      (add-use proc (add-uses args uses)))
-                     (($ $branch kt ($ $values (arg)))
-                      (add-use arg uses))
-                     (($ $branch kt ($ $primcall name args))
+                   (match term
+                     (($ $continue k src exp)
+                      (match exp
+                        ((or ($ $const) ($ $prim)) uses)
+                        (($ $fun kfun)
+                         (intset-union (persistent-intset uses)
+                                       (intmap-ref free kfun)))
+                        (($ $rec names vars (($ $fun kfun) ...))
+                         (fold (lambda (kfun uses)
+                                 (intset-union (persistent-intset uses)
+                                               (intmap-ref free kfun)))
+                               uses kfun))
+                        (($ $values args)
+                         (add-uses args uses))
+                        (($ $call proc args)
+                         (add-use proc (add-uses args uses)))
+                        (($ $callk label proc args)
+                         (add-use proc (add-uses args uses)))
+                        (($ $primcall name param args)
+                         (add-uses args uses))))
+                     (($ $branch kf kt src op param args)
                       (add-uses args uses))
-                     (($ $primcall name args)
-                      (add-uses args uses))
-                     (($ $prompt escape? tag handler)
-                      (add-use tag uses)))))
+                     (($ $prompt k kh src escape? tag)
+                      (add-use tag uses))
+                     (($ $throw src op param args)
+                      (add-uses args uses)))))
                  (($ $kfun src meta self)
                   (values (add-def self defs) uses))
                  (_ (values defs uses))))
@@ -446,7 +455,50 @@ variable, until we reach a fixed point on the free-vars map."
 (define (intset-count set)
   (intset-fold (lambda (_ count) (1+ count)) set 0))
 
-(define (convert-one cps label body free-vars bound->label well-known shared)
+(define (compute-elidable-closures cps well-known shared free-vars)
+  "Compute the set of well-known callees with no free variables.  Calls
+to these functions can avoid passing a closure parameter.  Note however
+that we have to exclude well-known callees that are part of a shared
+closure that contains any not-well-known member."
+  (define (intset-map f set)
+    (persistent-intset
+     (intset-fold (lambda (i out) (if (f i) (intset-add! out i) out))
+                  set
+                  empty-intset)))
+
+  (let ((no-free-vars (persistent-intset
+                       (intmap-fold (lambda (label free out)
+                                      (if (eq? empty-intset free)
+                                          (intset-add! out label)
+                                          out))
+                                    free-vars empty-intset)))
+        (shared
+         (intmap-fold
+          (lambda (label cont out)
+            (match cont
+              (($ $kargs _ _
+                  ($ $continue _ _ ($ $rec _ _ (($ $fun kfuns) ...))))
+               ;; Either all of these functions share a closure, in
+               ;; which all or all except one of them are well-known, or
+               ;; none of the functions share a closure.
+               (if (intmap-ref shared (car kfuns) (lambda (_) #f))
+                   (let* ((scc (fold intset-cons empty-intset kfuns)))
+                     (intset-fold (lambda (label out)
+                                    (intmap-add out label scc))
+                                  scc out))
+                   out))
+              (_ out)))
+          cps
+          empty-intmap)))
+    (intmap-fold (lambda (label labels elidable)
+                   (if (eq? labels (intset-intersect labels well-known))
+                       elidable
+                       (intset-subtract elidable labels)))
+                 shared
+                 (intset-intersect well-known no-free-vars))))
+
+(define (convert-one cps label body free-vars bound->label well-known shared
+                     elidable)
   (define (well-known? label)
     (intset-ref well-known label))
 
@@ -473,46 +525,24 @@ Otherwise @var{var} is bound, so @var{k} is called with @var{var}."
                (letv var*)
                (let$ body (k var*))
                (letk k* ($kargs (#f) (var*) ,body))
-               (build-term ($continue k* #f ($closure kfun 0))))))
+               (build-term ($continue k* #f ($const-fun kfun))))))
        ((intset-ref free var)
-        (match (vector self-known? nfree)
-          (#(#t 1)
-           ;; A reference to the one free var of a well-known function.
-           (with-cps cps
-             ($ (k self))))
-          (#(#t 2)
-           ;; A reference to one of the two free vars in a well-known
-           ;; function.
-           (let ((op (if (= var (intset-next free)) 'car 'cdr)))
-             (with-cps cps
-               (letv var*)
-               (let$ body (k var*))
-               (letk k* ($kargs (#f) (var*) ,body))
-               (build-term ($continue k* #f ($primcall op (self)))))))
-          (_
-           (let ((idx (intset-find free var)))
-             (cond
-              (self-known?
-               (with-cps cps
-                 (letv var* u64)
-                 (let$ body (k var*))
-                 (letk k* ($kargs (#f) (var*) ,body))
-                 (letk kunbox ($kargs ('idx) (u64)
-                                ($continue k* #f
-                                  ($primcall 'vector-ref (self u64)))))
-                 ($ (with-cps-constants ((idx idx))
-                      (build-term
-                        ($continue kunbox #f
-                          ($primcall 'scm->u64 (idx))))))))
-              (else
-               (with-cps cps
-                 (letv var*)
-                 (let$ body (k var*))
-                 (letk k* ($kargs (#f) (var*) ,body))
-                 ($ (with-cps-constants ((idx idx))
-                      (build-term
-                        ($continue k* #f
-                          ($primcall 'free-ref (self idx)))))))))))))
+        (if (and self-known? (eqv? 1 nfree))
+            ;; A reference to the one free var of a well-known function.
+            (with-cps cps
+              ($ (k self)))
+            (let* ((idx (intset-find free var))
+                   (param (cond
+                           ((not self-known?) (cons 'closure (+ idx 2)))
+                           ((= nfree 2)       (cons 'pair idx))
+                           (else              (cons 'vector (+ idx 1))))))
+              (with-cps cps
+                (letv var*)
+                (let$ body (k var*))
+                (letk k* ($kargs (#f) (var*) ,body))
+                (build-term
+                  ($continue k* #f
+                    ($primcall 'scm-ref/immediate param (self))))))))
        (else
         (with-cps cps
           ($ (k var))))))
@@ -536,97 +566,106 @@ term."
     (define (allocate-closure cps k src label known? nfree)
       "Allocate a new closure, and pass it to $var{k}."
       (match (vector known? nfree)
+        (#(#f 0)
+         ;; The call sites cannot be enumerated, but the closure has no
+         ;; identity; statically allocate it.
+         (with-cps cps
+           (build-term ($continue k src ($const-fun label)))))
         (#(#f nfree)
          ;; The call sites cannot be enumerated; allocate a closure.
          (with-cps cps
-           (build-term ($continue k src ($closure label nfree)))))
+           (letv closure tag code)
+           (letk k* ($kargs () ()
+                      ($continue k src ($values (closure)))))
+           (letk kinit ($kargs ('code) (code)
+                         ($continue k* src
+                           ($primcall 'word-set!/immediate '(closure . 1)
+                                      (closure code)))))
+           (letk kcode ($kargs () ()
+                         ($continue kinit src ($code label))))
+           (letk ktag1
+                 ($kargs ('tag) (tag)
+                   ($continue kcode src
+                     ($primcall 'word-set!/immediate '(closure . 0)
+                                (closure tag)))))
+           (letk ktag0
+                 ($kargs ('closure) (closure)
+                   ($continue ktag1 src
+                     ($primcall 'load-u64 (+ %tc7-program (ash nfree 16)) ()))))
+           (build-term
+             ($continue ktag0 src
+               ($primcall 'allocate-words/immediate `(closure . ,(+ nfree 2))
+                          ())))))
         (#(#t 2)
          ;; Well-known closure with two free variables; the closure is a
          ;; pair.
          (with-cps cps
-           ($ (with-cps-constants ((false #f))
-                (build-term
-                  ($continue k src ($primcall 'cons (false false))))))))
+           (build-term
+             ($continue k src
+               ($primcall 'allocate-words/immediate `(pair . 2) ())))))
         ;; Well-known callee with more than two free variables; the closure
         ;; is a vector.
         (#(#t nfree)
          (unless (> nfree 2)
            (error "unexpected well-known nullary, unary, or binary closure"))
          (with-cps cps
-           ($ (with-cps-constants ((nfree nfree)
-                                   (false #f))
-                (letv u64)
-                (letk kunbox ($kargs ('nfree) (u64)
-                               ($continue k src
-                                 ($primcall 'make-vector (u64 false)))))
-                (build-term
-                  ($continue kunbox src ($primcall 'scm->u64 (nfree))))))))))
+           (letv v w0)
+           (letk k* ($kargs () () ($continue k src ($values (v)))))
+           (letk ktag1
+                 ($kargs ('w0) (w0)
+                   ($continue k* src
+                     ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+           (letk ktag0
+                 ($kargs ('v) (v)
+                   ($continue ktag1 src
+                     ($primcall 'load-u64 (+ %tc7-vector (ash nfree 8)) ()))))
+           (build-term
+             ($continue ktag0 src
+               ($primcall 'allocate-words/immediate `(vector . ,(1+ nfree))
+                          ())))))))
 
     (define (init-closure cps k src var known? free)
       "Initialize the free variables @var{closure-free} in a closure
 bound to @var{var}, and continue to @var{k}."
-      (match (vector known? (intset-count free))
-        ;; Well-known callee with zero or one free variables; no
-        ;; initialization necessary.
-        (#(#t (or 0 1))
-         (with-cps cps
-           (build-term ($continue k src ($values ())))))
-        ;; Well-known callee with two free variables; do a set-car! and
-        ;; set-cdr!.
-        (#(#t 2)
-         (let* ((free0 (intset-next free))
-                (free1 (intset-next free (1+ free0))))
-           (convert-arg cps free0
-             (lambda (cps v0)
-               (with-cps cps
-                 (let$ body
-                       (convert-arg free1
-                           (lambda (cps v1)
-                             (with-cps cps
-                               (build-term
-                                 ($continue k src
-                                   ($primcall 'set-cdr! (var v1))))))))
-                 (letk kcdr ($kargs () () ,body))
-                 (build-term
-                   ($continue kcdr src ($primcall 'set-car! (var v0)))))))))
-        ;; Otherwise residualize a sequence of vector-set! or free-set!,
-        ;; depending on whether the callee is well-known or not.
-        (_
-         (let lp ((cps cps) (prev #f) (idx 0))
-           (match (intset-next free prev)
-             (#f (with-cps cps
-                   (build-term ($continue k src ($values ())))))
-             (v (with-cps cps
-                  (let$ body (lp (1+ v) (1+ idx)))
-                  (letk k ($kargs () () ,body))
-                  ($ (convert-arg v
-                       (lambda (cps v)
-                         (cond
-                          (known?
-                           (with-cps cps
-                             (letv u64)
-                             (letk kunbox
-                                   ($kargs ('idx) (u64)
-                                     ($continue k src
-                                       ($primcall 'vector-set! (var u64 v)))))
-                             ($ (with-cps-constants ((idx idx))
-                                  (build-term
-                                    ($continue kunbox src
-                                      ($primcall 'scm->u64 (idx))))))))
-                          (else
-                           (with-cps cps
-                             ($ (with-cps-constants ((idx idx))
-                                  (build-term
-                                    ($continue k src
-                                      ($primcall 'free-set!
-                                                 (var idx v)))))))))))))))))))
+      (let ((count (intset-count free)))
+        (cond
+         ((and known? (<= count 1))
+          ;; Well-known callee with zero or one free variables; no
+          ;; initialization necessary.
+          (with-cps cps
+            (build-term ($continue k src ($values ())))))
+         (else
+          ;; Otherwise residualize a sequence of scm-set!.
+          (let-values (((kind offset)
+                        ;; What are we initializing?  A closure if the
+                        ;; procedure is not well-known; a pair if it has
+                        ;; only 2 free variables; otherwise, a vector.
+                        (cond
+                         ((not known?) (values 'closure 2))
+                         ((= count 2)  (values 'pair 0))
+                         (else         (values 'vector 1)))))
+            (let lp ((cps cps) (prev #f) (idx 0))
+              (match (intset-next free prev)
+                (#f (with-cps cps
+                      (build-term ($continue k src ($values ())))))
+                (v (with-cps cps
+                     (let$ body (lp (1+ v) (1+ idx)))
+                     (letk k ($kargs () () ,body))
+                     ($ (convert-arg v
+                          (lambda (cps v)
+                            (with-cps cps
+                              (build-term
+                                ($continue k src
+                                  ($primcall 'scm-set!/immediate
+                                             (cons kind (+ offset idx))
+                                             (var v)))))))))))))))))
 
     (define (make-single-closure cps k src kfun)
       (let ((free (intmap-ref free-vars kfun)))
         (match (vector (well-known? kfun) (intset-count free))
           (#(#f 0)
            (with-cps cps
-             (build-term ($continue k src ($closure kfun 0)))))
+             (build-term ($continue k src ($const-fun kfun)))))
           (#(#t 0)
            (with-cps cps
              (build-term ($continue k src ($const #f)))))
@@ -658,11 +697,14 @@ bound to @var{var}, and continue to @var{k}."
                 ($continue k src ($callk label closure args)))))))
       (cond
        ((eq? (intmap-ref free-vars label) empty-intset)
-        ;; Known call, no free variables; no closure needed.
-        ;; Pass #f as closure argument.
-        (with-cps cps
-          ($ (with-cps-constants ((false #f))
-               ($ (have-closure false))))))
+        ;; Known call, no free variables; no closure needed.  If the
+        ;; callee is well-known, elide the closure argument entirely.
+        ;; Otherwise pass #f.
+        (if (intset-ref elidable label)
+            (have-closure cps #f)
+            (with-cps cps
+              ($ (with-cps-constants ((false #f))
+                   ($ (have-closure false)))))))
        ((and (well-known? (closure-label label shared bound->label))
              (trivial-intset (intmap-ref free-vars label)))
         ;; Well-known closures with one free variable are
@@ -763,43 +805,40 @@ bound to @var{var}, and continue to @var{k}."
         (($ $continue k src ($ $callk label proc args))
          (convert-known-proc-call cps k src label proc args))
 
-        (($ $continue k src ($ $primcall name args))
+        (($ $continue k src ($ $primcall name param args))
          (convert-args cps args
            (lambda (cps args)
              (with-cps cps
                (build-term
-                 ($continue k src ($primcall name args)))))))
+                 ($continue k src ($primcall name param args)))))))
 
-        (($ $continue k src ($ $branch kt ($ $primcall name args)))
+        (($ $continue k src ($ $values args))
          (convert-args cps args
            (lambda (cps args)
              (with-cps cps
                (build-term
-                 ($continue k src
-                   ($branch kt ($primcall name args))))))))
-
-        (($ $continue k src ($ $branch kt ($ $values (arg))))
-         (convert-arg cps arg
-           (lambda (cps arg)
-             (with-cps cps
-               (build-term
-                 ($continue k src
-                   ($branch kt ($values (arg)))))))))
+                 ($continue k src ($values args)))))))
 
-        (($ $continue k src ($ $values args))
+        (($ $branch kf kt src op param args)
          (convert-args cps args
            (lambda (cps args)
              (with-cps cps
                (build-term
-                 ($continue k src ($values args)))))))
+                 ($branch kf kt src op param args))))))
 
-        (($ $continue k src ($ $prompt escape? tag handler))
+        (($ $prompt k kh src escape? tag)
          (convert-arg cps tag
            (lambda (cps tag)
              (with-cps cps
                (build-term
-                 ($continue k src
-                   ($prompt escape? tag handler)))))))))
+                 ($prompt k kh src escape? tag))))))
+
+        (($ $throw src op param args)
+         (convert-args cps args
+           (lambda (cps args)
+             (with-cps cps
+               (build-term
+                 ($throw src op param args))))))))
 
     (intset-fold (lambda (label cps)
                    (match (intmap-ref cps label (lambda (_) #f))
@@ -807,6 +846,11 @@ bound to @var{var}, and continue to @var{k}."
                       (with-cps cps
                         (let$ term (visit-term term))
                         (setk label ($kargs names vars ,term))))
+                     (($ $kfun src meta self ktail kclause)
+                      (if (intset-ref elidable label)
+                          (with-cps cps
+                            (setk label ($kfun src meta #f ktail kclause)))
+                          cps))
                      (_ cps)))
                  body
                  cps)))
@@ -830,7 +874,9 @@ and allocate and initialize flat closures."
                                             kfun))
          ;; label -> free-var...
          (free-vars (compute-free-vars cps kfun shared))
-         (free-vars (prune-free-vars free-vars bound->label well-known shared)))
+         (free-vars (prune-free-vars free-vars bound->label well-known shared))
+         ;; label...
+         (elidable (compute-elidable-closures cps well-known shared free-vars)))
     (let ((free-in-program (intmap-ref free-vars kfun)))
       (unless (eq? empty-intset free-in-program)
         (error "Expected no free vars in program" free-in-program)))
@@ -838,7 +884,8 @@ and allocate and initialize flat closures."
       (persistent-intmap
        (intmap-fold
         (lambda (label body cps)
-          (convert-one cps label body free-vars bound->label well-known shared))
+          (convert-one cps label body free-vars bound->label well-known shared
+                       elidable))
         functions
         cps)))))
 
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index f6805f38d..669be8c9b 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -27,11 +27,10 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (language cps)
-  #:use-module (language cps primitives)
   #:use-module (language cps slot-allocation)
   #:use-module (language cps utils)
   #:use-module (language cps closure-conversion)
-  #:use-module (language cps handle-interrupts)
+  #:use-module (language cps loop-instrumentation)
   #:use-module (language cps optimize)
   #:use-module (language cps reify-primitives)
   #:use-module (language cps renumber)
@@ -39,6 +38,7 @@
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
   #:use-module (system vm assembler)
+  #:use-module (system base types internal)
   #:export (compile-bytecode))
 
 (define (kw-arg-ref args kw default)
@@ -100,9 +100,6 @@
     (define (slot sym)
       (lookup-slot sym allocation))
 
-    (define (constant sym)
-      (lookup-constant-value sym allocation))
-
     (define (from-sp var)
       (- frame-size 1 var))
 
@@ -113,272 +110,299 @@
     (define (compile-tail label exp)
       ;; There are only three kinds of expressions in tail position:
       ;; tail calls, multiple-value returns, and single-value returns.
+      (define (maybe-reset-frame nlocals)
+        (unless (= frame-size nlocals)
+          (emit-reset-frame asm nlocals)))
       (match exp
         (($ $call proc args)
          (for-each (match-lambda
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation))
-         (emit-tail-call asm (1+ (length args))))
+         (maybe-reset-frame (1+ (length args)))
+         (emit-handle-interrupts asm)
+         (emit-tail-call asm))
         (($ $callk k proc args)
          (for-each (match-lambda
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation))
-         (emit-tail-call-label asm (1+ (length args)) k))
+         (let ((nclosure (if proc 1 0)))
+           (maybe-reset-frame (+ nclosure (length args))))
+         (emit-handle-interrupts asm)
+         (emit-tail-call-label asm k))
         (($ $values args)
          (for-each (match-lambda
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation))
-         (emit-return-values asm (1+ (length args))))))
+         (maybe-reset-frame (length args))
+         (emit-handle-interrupts asm)
+         (emit-return-values asm))))
 
     (define (compile-value label exp dst)
       (match exp
         (($ $values (arg))
          (maybe-mov dst (slot arg)))
+        (($ $primcall (or 's64->u64 'u64->s64) #f (arg))
+         (maybe-mov dst (slot arg)))
         (($ $const exp)
          (emit-load-constant asm (from-sp dst) exp))
-        (($ $closure k 0)
+        (($ $const-fun k)
          (emit-load-static-procedure asm (from-sp dst) k))
-        (($ $closure k nfree)
-         (emit-make-closure asm (from-sp dst) k nfree))
+        (($ $code k)
+         (emit-load-label asm (from-sp dst) k))
         (($ $primcall 'current-module)
          (emit-current-module asm (from-sp dst)))
         (($ $primcall 'current-thread)
          (emit-current-thread asm (from-sp dst)))
-        (($ $primcall 'cached-toplevel-box (scope name bound?))
-         (emit-cached-toplevel-box asm (from-sp dst)
-                                   (constant scope) (constant name)
-                                   (constant bound?)))
-        (($ $primcall 'cached-module-box (mod name public? bound?))
-         (emit-cached-module-box asm (from-sp dst)
-                                 (constant mod) (constant name)
-                                 (constant public?) (constant bound?)))
-        (($ $primcall 'define! (sym))
-         (emit-define! asm (from-sp dst) (from-sp (slot sym))))
-        (($ $primcall 'resolve (name bound?))
-         (emit-resolve asm (from-sp dst) (constant bound?)
-                       (from-sp (slot name))))
-        (($ $primcall 'free-ref (closure idx))
-         (emit-free-ref asm (from-sp dst) (from-sp (slot closure))
-                        (constant idx)))
-        (($ $primcall 'vector-ref (vector index))
-         (emit-vector-ref asm (from-sp dst) (from-sp (slot vector))
-                          (from-sp (slot index))))
-        (($ $primcall 'make-vector (length init))
-         (emit-make-vector asm (from-sp dst) (from-sp (slot length))
-                           (from-sp (slot init))))
-        (($ $primcall 'make-vector/immediate (length init))
-         (emit-make-vector/immediate asm (from-sp dst) (constant length)
-                                     (from-sp (slot init))))
-        (($ $primcall 'vector-ref/immediate (vector index))
-         (emit-vector-ref/immediate asm (from-sp dst) (from-sp (slot vector))
-                                    (constant index)))
-        (($ $primcall 'allocate-struct (vtable nfields))
-         (emit-allocate-struct asm (from-sp dst) (from-sp (slot vtable))
-                               (from-sp (slot nfields))))
-        (($ $primcall 'allocate-struct/immediate (vtable nfields))
-         (emit-allocate-struct/immediate asm (from-sp dst)
-                                         (from-sp (slot vtable))
-                                         (constant nfields)))
-        (($ $primcall 'struct-ref (struct n))
-         (emit-struct-ref asm (from-sp dst) (from-sp (slot struct))
-                          (from-sp (slot n))))
-        (($ $primcall 'struct-ref/immediate (struct n))
-         (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
-                                    (constant n)))
-        (($ $primcall 'char->integer (src))
-         (emit-char->integer asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'integer->char (src))
-         (emit-integer->char asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'add/immediate (x y))
-         (emit-add/immediate asm (from-sp dst) (from-sp (slot x)) (constant y)))
-        (($ $primcall 'sub/immediate (x y))
-         (emit-sub/immediate asm (from-sp dst) (from-sp (slot x)) (constant y)))
-        (($ $primcall 'uadd/immediate (x y))
-         (emit-uadd/immediate asm (from-sp dst) (from-sp (slot x))
-                              (constant y)))
-        (($ $primcall 'usub/immediate (x y))
-         (emit-usub/immediate asm (from-sp dst) (from-sp (slot x))
-                              (constant y)))
-        (($ $primcall 'umul/immediate (x y))
-         (emit-umul/immediate asm (from-sp dst) (from-sp (slot x))
-                              (constant y)))
-        (($ $primcall 'ursh/immediate (x y))
-         (emit-ursh/immediate asm (from-sp dst) (from-sp (slot x))
-                              (constant y)))
-        (($ $primcall 'ulsh/immediate (x y))
-         (emit-ulsh/immediate asm (from-sp dst) (from-sp (slot x))
-                              (constant y)))
-        (($ $primcall 'builtin-ref (name))
-         (emit-builtin-ref asm (from-sp dst) (constant name)))
-        (($ $primcall 'scm->f64 (src))
+        (($ $primcall 'define! #f (mod sym))
+         (emit-define! asm (from-sp dst)
+                       (from-sp (slot mod)) (from-sp (slot sym))))
+        (($ $primcall 'resolve (bound?) (name))
+         (emit-resolve asm (from-sp dst) bound? (from-sp (slot name))))
+        (($ $primcall 'allocate-words annotation (nfields))
+         (emit-allocate-words asm (from-sp dst) (from-sp (slot nfields))))
+        (($ $primcall 'allocate-words/immediate (annotation . nfields))
+         (emit-allocate-words/immediate asm (from-sp dst) nfields))
+        (($ $primcall 'scm-ref annotation (obj idx))
+         (emit-scm-ref asm (from-sp dst) (from-sp (slot obj))
+                       (from-sp (slot idx))))
+        (($ $primcall 'scm-ref/tag annotation (obj))
+         (let ((tag (match annotation
+                      ('pair %tc1-pair)
+                      ('struct %tc3-struct))))
+           (emit-scm-ref/tag asm (from-sp dst) (from-sp (slot obj)) tag)))
+        (($ $primcall 'scm-ref/immediate (annotation . idx) (obj))
+         (emit-scm-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
+        (($ $primcall 'word-ref annotation (obj idx))
+         (emit-word-ref asm (from-sp dst) (from-sp (slot obj))
+                       (from-sp (slot idx))))
+        (($ $primcall 'word-ref/immediate (annotation . idx) (obj))
+         (emit-word-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
+        (($ $primcall 'pointer-ref/immediate (annotation . idx) (obj))
+         (emit-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
+        (($ $primcall 'tail-pointer-ref/immediate (annotation . idx) (obj))
+         (emit-tail-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj))
+                                          idx))
+        (($ $primcall 'cache-ref key ())
+         (emit-cache-ref asm (from-sp dst) key))
+        (($ $primcall 'resolve-module public? (name))
+         (emit-resolve-module asm (from-sp dst) (from-sp (slot name)) public?))
+        (($ $primcall 'lookup #f (mod name))
+         (emit-lookup asm (from-sp dst) (from-sp (slot mod)) (from-sp (slot name))))
+        (($ $primcall 'add/immediate y (x))
+         (emit-add/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'sub/immediate y (x))
+         (emit-sub/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'uadd/immediate y (x))
+         (emit-uadd/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'usub/immediate y (x))
+         (emit-usub/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'umul/immediate y (x))
+         (emit-umul/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'rsh (x y))
+         (emit-rsh asm (from-sp dst) (from-sp (slot x)) (from-sp (slot y))))
+        (($ $primcall 'lsh (x y))
+         (emit-lsh asm (from-sp dst) (from-sp (slot x)) (from-sp (slot y))))
+        (($ $primcall 'rsh/immediate y (x))
+         (emit-rsh/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'lsh/immediate y (x))
+         (emit-lsh/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'ursh/immediate y (x))
+         (emit-ursh/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'srsh/immediate y (x))
+         (emit-srsh/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'ulsh/immediate y (x))
+         (emit-ulsh/immediate asm (from-sp dst) (from-sp (slot x)) y))
+        (($ $primcall 'builtin-ref idx ())
+         (emit-builtin-ref asm (from-sp dst) idx))
+        (($ $primcall 'scm->f64 #f (src))
          (emit-scm->f64 asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'load-f64 (src))
-         (emit-load-f64 asm (from-sp dst) (constant src)))
-        (($ $primcall 'f64->scm (src))
-         (emit-f64->scm asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'scm->u64 (src))
+        (($ $primcall 'load-f64 val ())
+         (emit-load-f64 asm (from-sp dst) val))
+        (($ $primcall 'scm->u64 #f (src))
          (emit-scm->u64 asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'scm->u64/truncate (src))
+        (($ $primcall 'scm->u64/truncate #f (src))
          (emit-scm->u64/truncate asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'load-u64 (src))
-         (emit-load-u64 asm (from-sp dst) (constant src)))
-        (($ $primcall 'u64->scm (src))
+        (($ $primcall 'load-u64 val ())
+         (emit-load-u64 asm (from-sp dst) val))
+        (($ $primcall 'u64->scm #f (src))
          (emit-u64->scm asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'scm->s64 (src))
+        (($ $primcall 'scm->s64 #f (src))
          (emit-scm->s64 asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'load-s64 (src))
-         (emit-load-s64 asm (from-sp dst) (constant src)))
-        (($ $primcall 's64->scm (src))
+        (($ $primcall 'load-s64 val ())
+         (emit-load-s64 asm (from-sp dst) val))
+        (($ $primcall 's64->scm #f (src))
          (emit-s64->scm asm (from-sp dst) (from-sp (slot src))))
-        (($ $primcall 'bv-length (bv))
-         (emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
-        (($ $primcall 'bv-u8-ref (bv idx))
-         (emit-bv-u8-ref asm (from-sp dst) (from-sp (slot bv))
-                         (from-sp (slot idx))))
-        (($ $primcall 'bv-s8-ref (bv idx))
-         (emit-bv-s8-ref asm (from-sp dst) (from-sp (slot bv))
-                         (from-sp (slot idx))))
-        (($ $primcall 'bv-u16-ref (bv idx))
-         (emit-bv-u16-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-s16-ref (bv idx))
-         (emit-bv-s16-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-u32-ref (bv idx val))
-         (emit-bv-u32-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-s32-ref (bv idx val))
-         (emit-bv-s32-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-u64-ref (bv idx val))
-         (emit-bv-u64-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-s64-ref (bv idx val))
-         (emit-bv-s64-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-f32-ref (bv idx val))
-         (emit-bv-f32-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'bv-f64-ref (bv idx val))
-         (emit-bv-f64-ref asm (from-sp dst) (from-sp (slot bv))
-                          (from-sp (slot idx))))
-        (($ $primcall 'make-atomic-box (init))
-         (emit-make-atomic-box asm (from-sp dst) (from-sp (slot init))))
-        (($ $primcall 'atomic-box-ref (box))
-         (emit-atomic-box-ref asm (from-sp dst) (from-sp (slot box))))
-        (($ $primcall 'atomic-box-swap! (box val))
-         (emit-atomic-box-swap! asm (from-sp dst) (from-sp (slot box))
-                                (from-sp (slot val))))
-        (($ $primcall 'atomic-box-compare-and-swap! (box expected desired))
-         (emit-atomic-box-compare-and-swap!
-          asm (from-sp dst) (from-sp (slot box))
-          (from-sp (slot expected)) (from-sp (slot desired))))
-        (($ $primcall name args)
+
+        (($ $primcall 'u8-ref ann (obj ptr idx))
+         (emit-u8-ref asm (from-sp dst) (from-sp (slot ptr))
+                      (from-sp (slot idx))))
+        (($ $primcall 's8-ref ann (obj ptr idx))
+         (emit-s8-ref asm (from-sp dst) (from-sp (slot ptr))
+                      (from-sp (slot idx))))
+        (($ $primcall 'u16-ref ann (obj ptr idx))
+         (emit-u16-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 's16-ref ann (obj ptr idx))
+         (emit-s16-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 'u32-ref ann (obj ptr idx))
+         (emit-u32-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 's32-ref ann (obj ptr idx))
+         (emit-s32-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 'u64-ref ann (obj ptr idx))
+         (emit-u64-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 's64-ref ann (obj ptr idx))
+         (emit-s64-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 'f32-ref ann (obj ptr idx))
+         (emit-f32-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+        (($ $primcall 'f64-ref ann (obj ptr idx))
+         (emit-f64-ref asm (from-sp dst) (from-sp (slot ptr))
+                       (from-sp (slot idx))))
+
+        (($ $primcall 'atomic-scm-ref/immediate (annotation . idx) (obj))
+         (emit-atomic-scm-ref/immediate asm (from-sp dst) (from-sp (slot obj))
+                                        idx))
+        (($ $primcall 'atomic-scm-swap!/immediate (annotation . idx) (obj val))
+         (emit-atomic-scm-swap!/immediate asm (from-sp dst) (from-sp (slot obj))
+                                          idx (from-sp (slot val))))
+        (($ $primcall 'atomic-scm-compare-and-swap!/immediate (annotation . idx)
+            (obj expected desired))
+         (emit-atomic-scm-compare-and-swap!/immediate
+          asm (from-sp dst) (from-sp (slot obj)) idx (from-sp (slot expected))
+          (from-sp (slot desired))))
+
+        (($ $primcall 'untag-fixnum #f (src))
+         (emit-untag-fixnum asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall 'tag-fixnum #f (src))
+         (emit-tag-fixnum asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall 'untag-char #f (src))
+         (emit-untag-char asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall 'tag-char #f (src))
+         (emit-tag-char asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall name #f args)
          ;; FIXME: Inline all the cases.
-         (let ((inst (prim-instruction name)))
-           (emit-text asm `((,inst ,(from-sp dst)
-                                   ,@(map (compose from-sp slot) args))))))))
+         (emit-text asm `((,name ,(from-sp dst)
+                                 ,@(map (compose from-sp slot) args)))))))
 
     (define (compile-effect label exp k)
       (match exp
         (($ $values ()) #f)
-        (($ $prompt escape? tag handler)
-         (match (intmap-ref cps handler)
-           (($ $kreceive ($ $arity req () rest () #f) khandler-body)
-            (let ((receive-args (gensym "handler"))
-                  (nreq (length req))
-                  (proc-slot (lookup-call-proc-slot label allocation)))
-              (emit-prompt asm (from-sp (slot tag)) escape? proc-slot
-                           receive-args)
-              (emit-br asm k)
-              (emit-label asm receive-args)
-              (unless (and rest (zero? nreq))
-                (emit-receive-values asm proc-slot (->bool rest) nreq))
-              (when (and rest
-                         (match (intmap-ref cps khandler-body)
-                           (($ $kargs names (_ ... rest))
-                            (maybe-slot rest))))
-                (emit-bind-rest asm (+ proc-slot 1 nreq)))
-              (for-each (match-lambda
-                          ((src . dst) (emit-fmov asm dst src)))
-                        (lookup-parallel-moves handler allocation))
-              (emit-reset-frame asm frame-size)
-              (emit-br asm (forward-label khandler-body))))))
-        (($ $primcall 'cache-current-module! (sym scope))
-         (emit-cache-current-module! asm (from-sp (slot sym)) (constant scope)))
-        (($ $primcall 'free-set! (closure idx value))
-         (emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value))
-                         (constant idx)))
-        (($ $primcall 'box-set! (box value))
-         (emit-box-set! asm (from-sp (slot box)) (from-sp (slot value))))
-        (($ $primcall 'struct-set! (struct index value))
-         (emit-struct-set! asm (from-sp (slot struct)) (from-sp (slot index))
-                           (from-sp (slot value))))
-        (($ $primcall 'struct-set!/immediate (struct index value))
-         (emit-struct-set!/immediate asm (from-sp (slot struct))
-                                     (constant index) (from-sp (slot value))))
-        (($ $primcall 'vector-set! (vector index value))
-         (emit-vector-set! asm (from-sp (slot vector)) (from-sp (slot index))
-                           (from-sp (slot value))))
-        (($ $primcall 'vector-set!/immediate (vector index value))
-         (emit-vector-set!/immediate asm (from-sp (slot vector))
-                                     (constant index) (from-sp (slot value))))
-        (($ $primcall 'string-set! (string index char))
+        (($ $primcall 'cache-set! key (val))
+         (emit-cache-set! asm key (from-sp (slot val))))
+        (($ $primcall 'scm-set! annotation (obj idx val))
+         (emit-scm-set! asm (from-sp (slot obj)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'scm-set!/tag annotation (obj val))
+         (let ((tag (match annotation
+                      ('pair %tc1-pair)
+                      ('struct %tc3-struct))))
+           (emit-scm-set!/tag asm (from-sp (slot obj)) tag
+                              (from-sp (slot val)))))
+        (($ $primcall 'scm-set!/immediate (annotation . idx) (obj val))
+         (emit-scm-set!/immediate asm (from-sp (slot obj)) idx
+                                  (from-sp (slot val))))
+        (($ $primcall 'word-set! annotation (obj idx val))
+         (emit-word-set! asm (from-sp (slot obj)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'word-set!/immediate (annotation . idx) (obj val))
+         (emit-word-set!/immediate asm (from-sp (slot obj)) idx
+                                   (from-sp (slot val))))
+        (($ $primcall 'pointer-set!/immediate (annotation . idx) (obj val))
+         (emit-pointer-set!/immediate asm (from-sp (slot obj)) idx
+                                      (from-sp (slot val))))
+        (($ $primcall 'string-set! #f (string index char))
          (emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
                            (from-sp (slot char))))
-        (($ $primcall 'set-car! (pair value))
-         (emit-set-car! asm (from-sp (slot pair)) (from-sp (slot value))))
-        (($ $primcall 'set-cdr! (pair value))
-         (emit-set-cdr! asm (from-sp (slot pair)) (from-sp (slot value))))
-        (($ $primcall 'push-fluid (fluid val))
+        (($ $primcall 'push-fluid #f (fluid val))
          (emit-push-fluid asm (from-sp (slot fluid)) (from-sp (slot val))))
-        (($ $primcall 'pop-fluid ())
+        (($ $primcall 'pop-fluid #f ())
          (emit-pop-fluid asm))
-        (($ $primcall 'push-dynamic-state (state))
+        (($ $primcall 'push-dynamic-state #f (state))
          (emit-push-dynamic-state asm (from-sp (slot state))))
-        (($ $primcall 'pop-dynamic-state ())
+        (($ $primcall 'pop-dynamic-state #f ())
          (emit-pop-dynamic-state asm))
-        (($ $primcall 'wind (winder unwinder))
+        (($ $primcall 'wind #f (winder unwinder))
          (emit-wind asm (from-sp (slot winder)) (from-sp (slot unwinder))))
-        (($ $primcall 'bv-u8-set! (bv idx val))
-         (emit-bv-u8-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                          (from-sp (slot val))))
-        (($ $primcall 'bv-s8-set! (bv idx val))
-         (emit-bv-s8-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                          (from-sp (slot val))))
-        (($ $primcall 'bv-u16-set! (bv idx val))
-         (emit-bv-u16-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-s16-set! (bv idx val))
-         (emit-bv-s16-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-u32-set! (bv idx val))
-         (emit-bv-u32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-s32-set! (bv idx val))
-         (emit-bv-s32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-u64-set! (bv idx val))
-         (emit-bv-u64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-s64-set! (bv idx val))
-         (emit-bv-s64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-f32-set! (bv idx val))
-         (emit-bv-f32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'bv-f64-set! (bv idx val))
-         (emit-bv-f64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
-                           (from-sp (slot val))))
-        (($ $primcall 'unwind ())
+
+        (($ $primcall 'u8-set! ann (obj ptr idx val))
+         (emit-u8-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                       (from-sp (slot val))))
+        (($ $primcall 's8-set! ann (obj ptr idx val))
+         (emit-s8-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                       (from-sp (slot val))))
+        (($ $primcall 'u16-set! ann (obj ptr idx val))
+         (emit-u16-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 's16-set! ann (obj ptr idx val))
+         (emit-s16-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'u32-set! ann (obj ptr idx val))
+         (emit-u32-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 's32-set! ann (obj ptr idx val))
+         (emit-s32-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'u64-set! ann (obj ptr idx val))
+         (emit-u64-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 's64-set! ann (obj ptr idx val))
+         (emit-s64-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'f32-set! ann (obj ptr idx val))
+         (emit-f32-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+        (($ $primcall 'f64-set! ann (obj ptr idx val))
+         (emit-f64-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
+                        (from-sp (slot val))))
+
+        (($ $primcall 'unwind #f ())
          (emit-unwind asm))
-        (($ $primcall 'fluid-set! (fluid value))
+        (($ $primcall 'fluid-set! #f (fluid value))
          (emit-fluid-set! asm (from-sp (slot fluid)) (from-sp (slot value))))
-        (($ $primcall 'atomic-box-set! (box val))
-         (emit-atomic-box-set! asm (from-sp (slot box)) (from-sp (slot val))))
-        (($ $primcall 'handle-interrupts ())
+        (($ $primcall 'atomic-scm-set!/immediate (annotation . idx) (obj val))
+         (emit-atomic-scm-set!/immediate asm (from-sp (slot obj)) idx
+                                         (from-sp (slot val))))
+        (($ $primcall 'instrument-loop #f ())
+         (emit-instrument-loop asm)
          (emit-handle-interrupts asm))))
 
+    (define (compile-throw op param args)
+      (match (vector op param args)
+        (#('throw #f (key args))
+         (emit-throw asm (from-sp (slot key)) (from-sp (slot args))))
+        (#('throw/value param (val))
+         (emit-throw/value asm (from-sp (slot val)) param))
+        (#('throw/value+data param (val))
+         (emit-throw/value+data asm (from-sp (slot val)) param))))
+
+    (define (compile-prompt label k kh escape? tag)
+      (match (intmap-ref cps kh)
+        (($ $kreceive ($ $arity req () rest () #f) khandler-body)
+         (let ((receive-args (gensym "handler"))
+               (nreq (length req))
+               (proc-slot (lookup-call-proc-slot label allocation)))
+           (emit-prompt asm (from-sp (slot tag)) escape? proc-slot
+                        receive-args)
+           (emit-j asm k)
+           (emit-label asm receive-args)
+           (unless (and rest (zero? nreq))
+             (emit-receive-values asm proc-slot (->bool rest) nreq))
+           (when (and rest
+                      (match (intmap-ref cps khandler-body)
+                        (($ $kargs names (_ ... rest))
+                         (maybe-slot rest))))
+             (emit-bind-rest asm (+ proc-slot nreq)))
+           (for-each (match-lambda
+                      ((src . dst) (emit-fmov asm dst src)))
+                     (lookup-parallel-moves kh allocation))
+           (emit-reset-frame asm frame-size)
+           (emit-j asm (forward-label khandler-body))))))
+
     (define (compile-values label exp syms)
       (match exp
         (($ $values args)
@@ -386,7 +410,7 @@
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation)))))
 
-    (define (compile-test label exp kt kf next-label)
+    (define (compile-test label next-label kf kt op param args)
       (define (prefer-true?)
         (if (< (max kt kf) label)
             ;; Two backwards branches.  Prefer
@@ -395,82 +419,120 @@
             ;; Otherwise prefer a backwards
             ;; branch or a near jump.
             (< kt kf)))
-      (define (unary op sym)
+      (define (emit-branch emit-jt emit-jf)
         (cond
          ((eq? kt next-label)
-          (op asm (from-sp (slot sym)) #t kf))
+          (emit-jf asm kf))
          ((eq? kf next-label)
-          (op asm (from-sp (slot sym)) #f kt))
+          (emit-jt asm kt))
+         ((prefer-true?)
+          (emit-jt asm kt)
+          (emit-j asm kf))
          (else
-          (let ((invert? (not (prefer-true?))))
-            (op asm (from-sp (slot sym)) invert? (if invert? kf kt))
-            (emit-br asm (if invert? kt kf))))))
-      (define (binary op a b)
-        (cond
-         ((eq? kt next-label)
-          (op asm (from-sp (slot a)) (from-sp (slot b)) #t kf))
-         ((eq? kf next-label)
-          (op asm (from-sp (slot a)) (from-sp (slot b)) #f kt))
-         (else
-          (let ((invert? (not (prefer-true?))))
-            (op asm (from-sp (slot a)) (from-sp (slot b)) invert?
-                (if invert? kf kt))
-            (emit-br asm (if invert? kt kf))))))
-      (match exp
-        (($ $values (sym)) (unary emit-br-if-true sym))
-        (($ $primcall 'null? (a)) (unary emit-br-if-null a))
-        (($ $primcall 'nil? (a)) (unary emit-br-if-nil a))
-        (($ $primcall 'pair? (a)) (unary emit-br-if-pair a))
-        (($ $primcall 'struct? (a)) (unary emit-br-if-struct a))
-        (($ $primcall 'char? (a)) (unary emit-br-if-char a))
-        (($ $primcall 'symbol? (a)) (unary emit-br-if-symbol a))
-        (($ $primcall 'variable? (a)) (unary emit-br-if-variable a))
-        (($ $primcall 'vector? (a)) (unary emit-br-if-vector a))
-        (($ $primcall 'string? (a)) (unary emit-br-if-string a))
-        (($ $primcall 'bytevector? (a)) (unary emit-br-if-bytevector a))
-        (($ $primcall 'bitvector? (a)) (unary emit-br-if-bitvector a))
-        (($ $primcall 'keyword? (a)) (unary emit-br-if-keyword a))
-        ;; Add more TC7 tests here.  Keep in sync with
-        ;; *branching-primcall-arities* in (language cps primitives) and
-        ;; the set of macro-instructions in assembly.scm.
-        (($ $primcall 'eq? (a b)) (binary emit-br-if-eq a b))
-        (($ $primcall 'eqv? (a b)) (binary emit-br-if-eqv a b))
-        (($ $primcall '< (a b)) (binary emit-br-if-< a b))
-        (($ $primcall '<= (a b)) (binary emit-br-if-<= a b))
-        (($ $primcall '= (a b)) (binary emit-br-if-= a b))
-        (($ $primcall '>= (a b)) (binary emit-br-if-<= b a))
-        (($ $primcall '> (a b)) (binary emit-br-if-< b a))
-        (($ $primcall 'u64-< (a b)) (binary emit-br-if-u64-< a b))
-        (($ $primcall 'u64-<= (a b)) (binary emit-br-if-u64-<= a b))
-        (($ $primcall 'u64-= (a b)) (binary emit-br-if-u64-= a b))
-        (($ $primcall 'u64->= (a b)) (binary emit-br-if-u64-<= b a))
-        (($ $primcall 'u64-> (a b)) (binary emit-br-if-u64-< b a))
-        (($ $primcall 'u64-<-scm (a b)) (binary emit-br-if-u64-<-scm a b))
-        (($ $primcall 'u64-<=-scm (a b)) (binary emit-br-if-u64-<=-scm a b))
-        (($ $primcall 'u64-=-scm (a b)) (binary emit-br-if-u64-=-scm a b))
-        (($ $primcall 'u64->=-scm (a b)) (binary emit-br-if-u64->=-scm a b))
-        (($ $primcall 'u64->-scm (a b)) (binary emit-br-if-u64->-scm a b))
-        (($ $primcall 'logtest (a b)) (binary emit-br-if-logtest a b))
-        (($ $primcall 'f64-< (a b)) (binary emit-br-if-f64-< a b))
-        (($ $primcall 'f64-<= (a b)) (binary emit-br-if-f64-<= a b))
-        (($ $primcall 'f64-= (a b)) (binary emit-br-if-f64-= a b))
-        (($ $primcall 'f64->= (a b)) (binary emit-br-if-f64->= a b))
-        (($ $primcall 'f64-> (a b)) (binary emit-br-if-f64-> a b))))
+          (emit-jf asm kf)
+          (emit-j asm kt))))
+      (define (unary op a)
+        (op asm (from-sp (slot a)))
+        (emit-branch emit-je emit-jne))
+      (define (binary op emit-jt emit-jf a b)
+        (op asm (from-sp (slot a)) (from-sp (slot b)))
+        (emit-branch emit-jt emit-jf))
+      (define (binary-test op a b)
+        (binary op emit-je emit-jne a b))
+      (define (binary-< emit-<? a b)
+        (binary emit-<? emit-jl emit-jnl a b))
+      (define (binary-<= emit-<? a b)
+        (binary emit-<? emit-jge emit-jnge b a))
+      (define (binary-test/imm op a b)
+        (op asm (from-sp (slot a)) b)
+        (emit-branch emit-je emit-jne))
+      (define (binary-</imm op a b)
+        (op asm (from-sp (slot a)) b)
+        (emit-branch emit-jl emit-jnl))
+      (match (vector op param args)
+        ;; Immediate type tag predicates.
+        (#('fixnum? #f (a)) (unary emit-fixnum? a))
+        (#('heap-object? #f (a)) (unary emit-heap-object? a))
+        (#('char? #f (a)) (unary emit-char? a))
+        (#('eq-false? #f (a)) (unary emit-eq-false? a))
+        (#('eq-nil? #f (a)) (unary emit-eq-nil? a))
+        (#('eq-null? #f (a)) (unary emit-eq-null? a))
+        (#('eq-true? #f (a)) (unary emit-eq-true? a))
+        (#('unspecified? #f (a)) (unary emit-unspecified? a))
+        (#('undefined? #f (a)) (unary emit-undefined? a))
+        (#('eof-object? #f (a)) (unary emit-eof-object? a))
+        (#('null? #f (a)) (unary emit-null? a))
+        (#('false? #f (a)) (unary emit-false? a))
+        (#('nil? #f (a)) (unary emit-nil? a))
+        ;; Heap type tag predicates.
+        (#('pair? #f (a)) (unary emit-pair? a))
+        (#('struct? #f (a)) (unary emit-struct? a))
+        (#('symbol? #f (a)) (unary emit-symbol? a))
+        (#('variable? #f (a)) (unary emit-variable? a))
+        (#('vector? #f (a)) (unary emit-vector? a))
+        (#('mutable-vector? #f (a)) (unary emit-mutable-vector? a))
+        (#('immutable-vector? #f (a)) (unary emit-immutable-vector? a))
+        (#('string? #f (a)) (unary emit-string? a))
+        (#('heap-number? #f (a)) (unary emit-heap-number? a))
+        (#('hash-table? #f (a)) (unary emit-hash-table? a))
+        (#('pointer? #f (a)) (unary emit-pointer? a))
+        (#('fluid? #f (a)) (unary emit-fluid? a))
+        (#('stringbuf? #f (a)) (unary emit-stringbuf? a))
+        (#('dynamic-state? #f (a)) (unary emit-dynamic-state? a))
+        (#('frame? #f (a)) (unary emit-frame? a))
+        (#('keyword? #f (a)) (unary emit-keyword? a))
+        (#('atomic-box? #f (a)) (unary emit-atomic-box? a))
+        (#('syntax? #f (a)) (unary emit-syntax? a))
+        (#('program? #f (a)) (unary emit-program? a))
+        (#('vm-continuation? #f (a)) (unary emit-vm-continuation? a))
+        (#('bytevector? #f (a)) (unary emit-bytevector? a))
+        (#('weak-set? #f (a)) (unary emit-weak-set? a))
+        (#('weak-table? #f (a)) (unary emit-weak-table? a))
+        (#('array? #f (a)) (unary emit-array? a))
+        (#('bitvector? #f (a)) (unary emit-bitvector? a))
+        (#('smob? #f (a)) (unary emit-smob? a))
+        (#('port? #f (a)) (unary emit-port? a))
+        (#('bignum? #f (a)) (unary emit-bignum? a))
+        (#('flonum? #f (a)) (unary emit-flonum? a))
+        (#('compnum? #f (a)) (unary emit-compnum? a))
+        (#('fracnum? #f (a)) (unary emit-fracnum? a))
+        ;; Binary predicates.
+        (#('eq? #f (a b)) (binary-test emit-eq? a b))
+        (#('heap-numbers-equal? #f (a b))
+         (binary-test emit-heap-numbers-equal? a b))
+        (#('< #f (a b)) (binary-< emit-<? a b))
+        (#('<= #f (a b)) (binary-<= emit-<? a b))
+        (#('= #f (a b)) (binary-test emit-=? a b))
+        (#('u64-< #f (a b)) (binary-< emit-u64<? a b))
+        (#('u64-imm-< b (a)) (binary-</imm emit-u64-imm<? a b))
+        (#('imm-u64-< b (a)) (binary-</imm emit-imm-u64<? a b))
+        (#('u64-= #f (a b)) (binary-test emit-u64=? a b))
+        (#('u64-imm-= b (a)) (binary-test/imm emit-s64-imm=? a b))
+        (#('s64-= #f (a b)) (binary-test emit-u64=? a b))
+        (#('s64-imm-= b (a)) (binary-test/imm emit-s64-imm=? a b))
+        (#('s64-< #f (a b)) (binary-< emit-s64<? a b))
+        (#('s64-imm-< b (a)) (binary-</imm emit-s64-imm<? a b))
+        (#('imm-s64-< b (a)) (binary-</imm emit-imm-s64<? a b))
+        (#('f64-< #f (a b)) (binary-< emit-f64<? a b))
+        (#('f64-<= #f (a b)) (binary-<= emit-f64<? a b))
+        (#('f64-= #f (a b)) (binary-test emit-f64=? a b))))
 
     (define (compile-trunc label k exp nreq rest-var)
       (define (do-call proc args emit-call)
         (let* ((proc-slot (lookup-call-proc-slot label allocation))
-               (nargs (1+ (length args)))
+               (nclosure (if proc 1 0))
+               (nargs (+ nclosure (length args)))
                (arg-slots (map (lambda (x) (+ x proc-slot)) (iota nargs))))
           (for-each (match-lambda
                      ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                     (lookup-parallel-moves label allocation))
+          (emit-handle-interrupts asm)
           (emit-call asm proc-slot nargs)
           (emit-slot-map asm proc-slot (lookup-slot-map label allocation))
           (cond
            ((and (= 1 nreq) (and rest-var) (not (maybe-slot rest-var))
                  (match (lookup-parallel-moves k allocation)
-                   ((((? (lambda (src) (= src (1+ proc-slot))) src)
+                   ((((? (lambda (src) (= src proc-slot)) src)
                       . dst)) dst)
                    (_ #f)))
             ;; The usual case: one required live return value, ignoring
@@ -481,7 +543,7 @@
             (unless (and (zero? nreq) rest-var)
               (emit-receive-values asm proc-slot (->bool rest-var) nreq))
             (when (and rest-var (maybe-slot rest-var))
-              (emit-bind-rest asm (+ proc-slot 1 nreq)))
+              (emit-bind-rest asm (+ proc-slot nreq)))
             (for-each (match-lambda
                        ((src . dst) (emit-fmov asm dst src)))
                       (lookup-parallel-moves k allocation))
@@ -506,7 +568,7 @@
              (fallthrough? (= forwarded-k (skip-elided-conts (1+ label)))))
         (define (maybe-emit-jump)
           (unless fallthrough?
-            (emit-br asm forwarded-k)))
+            (emit-j asm forwarded-k)))
         (match (intmap-ref cps k)
           (($ $ktail)
            (compile-tail label exp))
@@ -516,13 +578,8 @@
                (compile-value label exp dst)))
            (maybe-emit-jump))
           (($ $kargs () ())
-           (match exp
-             (($ $branch kt exp)
-              (compile-test label exp (forward-label kt) forwarded-k
-                            (skip-elided-conts (1+ label))))
-             (_
-              (compile-effect label exp k)
-              (maybe-emit-jump))))
+           (compile-effect label exp k)
+           (maybe-emit-jump))
           (($ $kargs names syms)
            (compile-values label exp syms)
            (maybe-emit-jump))
@@ -535,7 +592,29 @@
                   (fallthrough? (and fallthrough?
                                      (= kargs (skip-elided-conts (1+ k))))))
              (unless fallthrough?
-               (emit-br asm kargs)))))))
+               (emit-j asm kargs)))))))
+
+    (define (compile-term label term)
+      (match term
+        (($ $continue k src exp)
+         (when src
+           (emit-source asm src))
+         (unless (elide-cont? label)
+           (compile-expression label k exp)))
+        (($ $branch kf kt src op param args)
+         (when src
+           (emit-source asm src))
+         (compile-test label (skip-elided-conts (1+ label))
+                       (forward-label kf) (forward-label kt)
+                       op param args))
+        (($ $prompt k kh src escape? tag)
+         (when src
+           (emit-source asm src))
+         (compile-prompt label (skip-elided-conts k) kh escape? tag))
+        (($ $throw src op param args)
+         (when src
+           (emit-source asm src))
+         (compile-throw op param args))))
 
     (define (compile-cont label cont)
       (match cont
@@ -547,6 +626,8 @@
          (let ((first? (match (intmap-ref cps (1- label))
                          (($ $kfun) #t)
                          (_ #f)))
+               (has-closure? (match (intmap-ref cps (intmap-next cps))
+                               (($ $kfun src meta self tail) (->bool self))))
                (kw-indices (map (match-lambda
                                  ((key name sym)
                                   (cons key (lookup-slot sym allocation))))
@@ -554,16 +635,17 @@
            (unless first?
              (emit-end-arity asm))
            (emit-label asm label)
-           (emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
-                                frame-size alt)
-           ;; All arities define a closure binding in slot 0.
-           (emit-definition asm 'closure 0 'scm)
+           (emit-begin-kw-arity asm has-closure? req opt rest kw-indices
+                                allow-other-keys? frame-size alt)
+           (when has-closure?
+             ;; Most arities define a closure binding in slot 0.
+             (emit-definition asm 'closure 0 'scm))
            ;; Usually we just fall through, but it could be the body is
            ;; contified into another clause.
            (let ((body (forward-label body)))
              (unless (= body (skip-elided-conts (1+ label)))
-               (emit-br asm body)))))
-        (($ $kargs names vars ($ $continue k src exp))
+               (emit-j asm body)))))
+        (($ $kargs names vars term)
          (emit-label asm label)
          (for-each (lambda (name var)
                      (let ((slot (maybe-slot var)))
@@ -571,10 +653,7 @@
                          (let ((repr (lookup-representation var allocation)))
                            (emit-definition asm name slot repr)))))
                    names vars)
-         (when src
-           (emit-source asm src))
-         (unless (elide-cont? label)
-           (compile-expression label k exp)))
+         (compile-term label term))
         (($ $kreceive arity kargs)
          (emit-label asm label))
         (($ $ktail)
@@ -602,7 +681,7 @@
   (set! exp (convert-closures exp))
   (set! exp (optimize-first-order-cps exp opts))
   (set! exp (reify-primitives exp))
-  (set! exp (add-handle-interrupts exp))
+  (set! exp (add-loop-instrumentation exp))
   (renumber exp))
 
 (define (compile-bytecode exp env opts)
diff --git a/module/language/cps/constructors.scm b/module/language/cps/constructors.scm
deleted file mode 100644
index 170f0f17d..000000000
--- a/module/language/cps/constructors.scm
+++ /dev/null
@@ -1,106 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-;;;
-;;; Constructor inlining turns "list" primcalls into a series of conses,
-;;; and does similar transformations for "vector".
-;;;
-;;; Code:
-
-(define-module (language cps constructors)
-  #:use-module (ice-9 match)
-  #:use-module (language cps)
-  #:use-module (language cps utils)
-  #:use-module (language cps with-cps)
-  #:use-module (language cps intmap)
-  #:export (inline-constructors))
-
-(define (inline-list out k src args)
-  (define (build-list out args k)
-    (match args
-      (()
-       (with-cps out
-         (build-term ($continue k src ($const '())))))
-      ((arg . args)
-       (with-cps out
-         (letv tail)
-         (letk ktail ($kargs ('tail) (tail)
-                       ($continue k src
-                         ($primcall 'cons (arg tail)))))
-         ($ (build-list args ktail))))))
-  (with-cps out
-    (letv val)
-    (letk kvalues ($kargs ('val) (val)
-                    ($continue k src
-                      ($primcall 'values (val)))))
-    ($ (build-list args kvalues))))
-
-(define (inline-vector out k src args)
-  (define (initialize out vec args n)
-    (match args
-      (()
-       (with-cps out
-         (build-term ($continue k src ($primcall 'values (vec))))))
-      ((arg . args)
-       (with-cps out
-         (let$ next (initialize vec args (1+ n)))
-         (letk knext ($kargs () () ,next))
-         (letv u64)
-         (letk kunbox ($kargs ('idx) (u64)
-                        ($continue knext src
-                          ($primcall 'vector-set! (vec u64 arg)))))
-         ($ (with-cps-constants ((idx n))
-              (build-term ($continue kunbox src
-                            ($primcall 'scm->u64 (idx))))))))))
-  (with-cps out
-    (letv vec)
-    (let$ body (initialize vec args 0))
-    (letk kalloc ($kargs ('vec) (vec) ,body))
-    ($ (with-cps-constants ((len (length args))
-                            (init #f))
-         (letv u64)
-         (letk kunbox ($kargs ('len) (u64)
-                        ($continue kalloc src
-                          ($primcall 'make-vector (u64 init)))))
-         (build-term ($continue kunbox src
-                       ($primcall 'scm->u64 (len))))))))
-
-(define (find-constructor-inliner name)
-  (match name
-    ('list inline-list)
-    ('vector inline-vector)
-    (_ #f)))
-
-(define (inline-constructors conts)
-  (with-fresh-name-state conts
-    (persistent-intmap
-     (intmap-fold
-      (lambda (label cont out)
-        (match cont
-          (($ $kargs names vars ($ $continue k src ($ $primcall name args)))
-           (let ((inline (find-constructor-inliner name)))
-             (if inline
-                 (call-with-values (lambda () (inline out k src args))
-                   (lambda (out term)
-                     (intmap-replace! out label
-                                      (build-cont ($kargs names vars ,term)))))
-                 out)))
-          (_ out)))
-      conts
-      conts))))
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index f5727f842..7587fa3a7 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -37,6 +37,7 @@
   #:use-module (language cps utils)
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
+  #:use-module (language cps with-cps)
   #:export (contify))
 
 (define (compute-singly-referenced-labels conts)
@@ -59,8 +60,10 @@ predecessor."
       (($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
       (($ $ktail) (ref0))
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
-      (($ $kargs names syms ($ $continue k src exp))
-       (ref2 k (match exp (($ $branch k) k) (($ $prompt _ _ k) k) (_ #f))))))
+      (($ $kargs names syms ($ $continue k)) (ref1 k))
+      (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
+      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs names syms ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intmap-fold add-ref conts single multiple)))
     (intset-subtract (persistent-intset single)
@@ -166,7 +169,7 @@ $call, and are always called with a compatible arity."
       (match cont
         (($ $kargs _ _ ($ $continue _ _ exp))
          (match exp
-           ((or ($ $const) ($ $prim) ($ $closure) ($ $fun) ($ $rec))
+           ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $fun) ($ $rec))
             functions)
            (($ $values args)
             (exclude-vars functions args))
@@ -185,15 +188,15 @@ $call, and are always called with a compatible arity."
               ;; compiler handles this fine though, so we allow it.
               (restrict-arity functions proc (length args))))
            (($ $callk k proc args)
-            (exclude-vars functions (cons proc args)))
-           (($ $branch kt ($ $primcall name args))
-            (exclude-vars functions args))
-           (($ $branch kt ($ $values (arg)))
-            (exclude-var functions arg))
-           (($ $primcall name args)
-            (exclude-vars functions args))
-           (($ $prompt escape? tag handler)
-            (exclude-var functions tag))))
+            (exclude-vars functions (if proc (cons proc args) args)))
+           (($ $primcall name param args)
+            (exclude-vars functions args))))
+        (($ $kargs _ _ ($ $branch kf kt src op param args))
+         (exclude-vars functions args))
+        (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+         (exclude-var functions tag))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (exclude-vars functions args))
         (_ functions)))
     (intmap-fold visit-cont conts functions)))
 
@@ -371,72 +374,119 @@ function set."
             (if (arity-matches? arity nargs)
                 body
                 (lp alt))))))))
-  (define (continue k src exp)
+  (define (inline-return cps k* kargs src nreq rest vals)
+    (define (build-list cps k src vals)
+      (match vals
+        (()
+         (with-cps cps
+           (build-term ($continue k src ($const '())))))
+        ((v . vals)
+         (with-cps cps
+           (letv pair tail)
+           (letk kdone ($kargs () () ($continue k src ($values (pair)))))
+           (letk ktail
+                 ($kargs () ()
+                   ($continue kdone src
+                     ($primcall 'scm-set!/immediate '(pair . 1) (pair tail)))))
+           (letk khead
+                 ($kargs ('pair) (pair)
+                   ($continue ktail src
+                     ($primcall 'scm-set!/immediate '(pair . 0) (pair v)))))
+           (letk ktail
+                 ($kargs ('tail) (tail)
+                   ($continue khead src
+                     ($primcall 'allocate-words/immediate '(pair . 2) ()))))
+           ($ (build-list ktail src vals))))))
+    (cond
+     ((and (not rest) (eqv? (length vals) nreq))
+      (with-cps cps
+        (build-term ($continue kargs src ($values vals)))))
+     ((and rest (<= nreq (length vals)))
+      (with-cps cps
+        (letv rest)
+        (letk krest ($kargs ('rest) (rest)
+                      ($continue kargs src
+                        ($values ,(append (list-head vals nreq)
+                                          (list rest))))))
+        ($ (build-list krest src (list-tail vals nreq)))))
+     (else
+      ;; Fallback case if values don't match.
+      (with-cps cps
+        (letv prim)
+        (letk kprim ($kargs ('prim) (prim)
+                      ($continue k* src ($call prim vals))))
+        (build-term ($continue kprim src ($prim 'values)))))))
+  (define (continue cps k src exp)
     (define (lookup-return-cont k)
       (match (return-subst k)
         (#f k)
         (k (lookup-return-cont k))))
     (let ((k* (lookup-return-cont k)))
       (if (eq? k k*)
-          (build-term ($continue k src ,exp))
-          ;; We are contifying this return.  It must be a call, a
-          ;; $values expression, or a return primcall.  k* will be
-          ;; either a $ktail or a $kreceive continuation.  CPS has this
-          ;; thing though where $kreceive can't be the target of a
-          ;; $values expression, and "return" can only continue to a
-          ;; tail continuation, so we might have to rewrite to a
-          ;; "values" primcall.
-          (build-term
-            ($continue k* src
-              ,(match (intmap-ref conts k*)
-                 (($ $kreceive)
-                  (match exp
-                    (($ $call) exp)
-                    ;; A primcall that can continue to $ktail can also
-                    ;; continue to $kreceive.
-                    (($ $primcall) exp)
-                    (($ $values vals)
-                     (build-exp ($primcall 'values vals)))))
-                 (($ $ktail) exp)))))))
-  (define (visit-exp k src exp)
+          (with-cps cps (build-term ($continue k src ,exp)))
+          ;; We are contifying this return.  It must be a call or a
+          ;; $values expression.  k* will be either a $ktail or a
+          ;; $kreceive continuation.
+          (match (intmap-ref conts k*)
+            (($ $kreceive ($ $arity req () rest () #f) kargs)
+             (match exp
+               (($ $call)
+                (with-cps cps (build-term ($continue k* src ,exp))))
+               ;; We need to punch through the $kreceive; otherwise we'd
+               ;; have to rewrite as a call to the 'values primitive.
+               (($ $values vals)
+                (inline-return cps k* kargs src (length req) rest vals))))
+            (($ $ktail)
+             (with-cps cps (build-term ($continue k* src ,exp))))))))
+  (define (visit-exp cps k src exp)
     (match exp
       (($ $call proc args)
        ;; If proc is contifiable, replace call with jump.
        (match (call-subst proc)
-         (#f (continue k src exp))
+         (#f (continue cps k src exp))
          (kfun
           (let ((body (find-body kfun (length args))))
-            (build-term ($continue body src ($values args)))))))
+            (with-cps cps
+              (build-term ($continue body src ($values args))))))))
       (($ $fun kfun)
        ;; If the function's tail continuation has been
        ;; substituted, that means it has been contified.
        (if (return-subst (tail-label conts kfun))
-           (continue k src (build-exp ($values ())))
-           (continue k src exp)))
+           (continue cps k src (build-exp ($values ())))
+           (continue cps k src exp)))
       (($ $rec names vars funs)
        (match (filter (match-lambda ((n v f) (not (call-subst v))))
                       (map list names vars funs))
-         (() (continue k src (build-exp ($values ()))))
+         (() (continue cps k src (build-exp ($values ()))))
          (((names vars funs) ...)
-          (continue k src (build-exp ($rec names vars funs))))))
-      (_ (continue k src exp))))
+          (continue cps k src (build-exp ($rec names vars funs))))))
+      (_ (continue cps k src exp))))
+  (define (visit-term cps term)
+    (match term
+      (($ $continue k src exp)
+       (visit-exp cps k src exp))
+      ((or ($ $branch) ($ $prompt) ($ $throw))
+       (with-cps cps term))))
 
   ;; Renumbering is not strictly necessary but some passes may not be
   ;; equipped to deal with stale $kfun nodes whose bodies have been
   ;; wired into other functions.
   (renumber
-   (intmap-map
-    (lambda (label cont)
-      (match cont
-        (($ $kargs names vars ($ $continue k src exp))
-         ;; Remove bindings for functions that have been contified.
-         (match (filter (match-lambda ((name var) (not (call-subst var))))
-                        (map list names vars))
-           (((names vars) ...)
-            (build-cont
-              ($kargs names vars ,(visit-exp k src exp))))))
-        (_ cont)))
-    conts)))
+   (with-fresh-name-state conts
+     (intmap-fold
+      (lambda (label cont out)
+        (match cont
+          (($ $kargs names vars term)
+           ;; Remove bindings for functions that have been contified.
+           (match (filter (match-lambda ((name var) (not (call-subst var))))
+                          (map list names vars))
+             (((names vars) ...)
+              (with-cps out
+                (let$ term (visit-term term))
+                (setk label ($kargs names vars ,term))))))
+          (_ out)))
+      conts
+      conts))))
 
 (define (contify conts)
   ;; FIXME: Renumbering isn't really needed but dead continuations may
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index a7a77131a..9f3b3da0f 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -114,11 +114,12 @@ false.  It could be that both true and false proofs are available."
           (values (append changed0 changed1) boolv)))
 
       (match (intmap-ref conts label)
-        (($ $kargs names vars ($ $continue k src exp))
-         (match exp
-           (($ $branch kt) (propagate-branch k kt))
-           (($ $prompt escape? tag handler) (propagate2 k handler))
-           (_ (propagate1 k))))
+        (($ $kargs names vars term)
+         (match term
+           (($ $continue k)   (propagate1 k))
+           (($ $branch kf kt) (propagate-branch kf kt))
+           (($ $prompt k kh)  (propagate2 k kh))
+           (($ $throw)        (propagate0))))
         (($ $kreceive arity k)
          (propagate1 k))
         (($ $kfun src meta self tail clause)
@@ -151,7 +152,7 @@ false.  It could be that both true and false proofs are available."
   (intset-map (lambda (label)
                 (match (intmap-ref conts label)
                   (($ $kfun src meta self tail clause)
-                   (list self))
+                   (if self (list self) '()))
                   (($ $kclause arity body alt)
                    (match (intmap-ref conts body)
                      (($ $kargs names vars) vars)))
@@ -160,10 +161,16 @@ false.  It could be that both true and false proofs are available."
                      (($ $kargs names vars) vars)))
                   (($ $ktail)
                    '())
-                  (($ $kargs names vars ($ $continue k))
-                   (match (intmap-ref conts k)
-                     (($ $kargs names vars) vars)
-                     (_ #f)))))
+                  (($ $kargs names vars term)
+                   (match term
+                     (($ $continue k)
+                      (match (intmap-ref conts k)
+                        (($ $kargs names vars) vars)
+                        (_ #f)))
+                     (($ $branch)
+                      '())
+                     ((or ($ $prompt) ($ $throw))
+                      #f)))))
                (compute-function-body conts kfun)))
 
 (define (compute-singly-referenced succs)
@@ -199,144 +206,138 @@ false.  It could be that both true and false proofs are available."
             (() '())
             ((var . vars) (cons (subst-var var-substs var) (lp vars))))))
 
-      (define (compute-exp-key var-substs exp)
-        (match exp
-          (($ $const val) (cons 'const val))
-          (($ $prim name) (cons 'prim name))
-          (($ $fun body) #f)
-          (($ $rec names syms funs) #f)
-          (($ $closure label nfree) #f)
-          (($ $call proc args) #f)
-          (($ $callk k proc args) #f)
-          (($ $primcall name args)
-           (cons* 'primcall name (subst-vars var-substs args)))
-          (($ $branch _ ($ $primcall name args))
-           (cons* 'primcall name (subst-vars var-substs args)))
-          (($ $branch) #f)
-          (($ $values args) #f)
-          (($ $prompt escape? tag handler) #f)))
+      (define (compute-term-key var-substs term)
+        (match term
+          (($ $continue k src exp)
+           (match exp
+             (($ $const val) (cons 'const val))
+             (($ $prim name) (cons 'prim name))
+             (($ $fun body) #f)
+             (($ $rec names syms funs) #f)
+             (($ $const-fun label) #f)
+             (($ $code label) (cons 'code label))
+             (($ $call proc args) #f)
+             (($ $callk k proc args) #f)
+             (($ $primcall name param args)
+              (cons* name param (subst-vars var-substs args)))
+             (($ $values args) #f)))
+          (($ $branch kf kt src op param args)
+           (cons* op param (subst-vars var-substs args)))
+          ((or ($ $prompt) ($ $throw)) #f)))
 
-      (define (add-auxiliary-definitions! label var-substs exp-key)
-        (define (subst var)
-          (subst-var var-substs var))
-        (let ((defs (intmap-ref defs label)))
+      (define (add-auxiliary-definitions! label var-substs term-key)
+        (let ((defs (and=> (intmap-ref defs label)
+                           (lambda (defs) (subst-vars var-substs defs)))))
           (define (add-def! aux-key var)
             (let ((equiv (hash-ref equiv-set aux-key '())))
               (hash-set! equiv-set aux-key
                          (acons label (list var) equiv))))
-          (match exp-key
-            (('primcall 'box val)
-             (match defs
-               ((box)
-                (add-def! `(primcall box-ref ,(subst box)) val))))
-            (('primcall 'box-set! box val)
-             (add-def! `(primcall box-ref ,box) val))
-            (('primcall 'cons car cdr)
-             (match defs
-               ((pair)
-                (add-def! `(primcall car ,(subst pair)) car)
-                (add-def! `(primcall cdr ,(subst pair)) cdr))))
-            (('primcall 'set-car! pair car)
-             (add-def! `(primcall car ,pair) car))
-            (('primcall 'set-cdr! pair cdr)
-             (add-def! `(primcall cdr ,pair) cdr))
-            (('primcall (or 'make-vector 'make-vector/immediate) len fill)
-             (match defs
-               ((vec)
-                (add-def! `(primcall vector-length ,(subst vec)) len))))
-            (('primcall 'vector-set! vec idx val)
-             (add-def! `(primcall vector-ref ,vec ,idx) val))
-            (('primcall 'vector-set!/immediate vec idx val)
-             (add-def! `(primcall vector-ref/immediate ,vec ,idx) val))
-            (('primcall (or 'allocate-struct 'allocate-struct/immediate)
-                        vtable size)
-             (match defs
-               ((struct)
-                (add-def! `(primcall struct-vtable ,(subst struct))
-                          vtable))))
-            (('primcall 'struct-set! struct n val)
-             (add-def! `(primcall struct-ref ,struct ,n) val))
-            (('primcall 'struct-set!/immediate struct n val)
-             (add-def! `(primcall struct-ref/immediate ,struct ,n) val))
-            (('primcall 'scm->f64 scm)
-             (match defs
-               ((f64)
-                (add-def! `(primcall f64->scm ,f64) scm))))
-            (('primcall 'f64->scm f64)
-             (match defs
-               ((scm)
-                (add-def! `(primcall scm->f64 ,scm) f64))))
-            (('primcall 'scm->u64 scm)
-             (match defs
-               ((u64)
-                (add-def! `(primcall u64->scm ,u64) scm))))
-            (('primcall 'u64->scm u64)
-             (match defs
-               ((scm)
-                (add-def! `(primcall scm->u64 ,scm) u64)
-                (add-def! `(primcall scm->u64/truncate ,scm) u64))))
-            (('primcall 'scm->s64 scm)
-             (match defs
-               ((s64)
-                (add-def! `(primcall s64->scm ,s64) scm))))
-            (('primcall 's64->scm s64)
-             (match defs
-               ((scm)
-                (add-def! `(primcall scm->s64 ,scm) s64))))
-            (_ #t))))
+          (define-syntax add-definitions
+            (syntax-rules (<-)
+              ((add-definitions)
+               #f)
+              ((add-definitions
+                ((def <- op arg ...) (aux <- op* arg* ...) ...)
+                . clauses)
+               (match term-key
+                 (('op arg ...)
+                  (match defs
+                    ((def) (add-def! (list 'op* arg* ...) aux) ...)))
+                 (_ (add-definitions . clauses))))
+              ((add-definitions
+                ((op arg ...) (aux <- op* arg* ...) ...)
+                . clauses)
+               (match term-key
+                 (('op arg ...)
+                  (add-def! (list 'op* arg* ...) aux) ...)
+                 (_ (add-definitions . clauses))))))
+          (add-definitions
+           ((scm-set! p s i x)               (x <- scm-ref p s i))
+           ((scm-set!/tag p s x)             (x <- scm-ref/tag p s))
+           ((scm-set!/immediate p s x)       (x <- scm-ref/immediate p s))
+           ((word-set! p s i x)              (x <- word-ref p s i))
+           ((word-set!/immediate p s x)      (x <- word-ref/immediate p s))
+           ((pointer-set!/immediate p s x)   (x <- pointer-ref/immediate p s))
+
+           ((u <- scm->f64 #f s)             (s <- f64->scm #f u))
+           ((s <- f64->scm #f u)             (u <- scm->f64 #f s))
+           ((u <- scm->u64 #f s)             (s <- u64->scm #f u))
+           ((s <- u64->scm #f u)             (u <- scm->u64 #f s)
+                                             (u <- scm->u64/truncate #f s))
+           ((s <- u64->scm/unlikely #f u)    (u <- scm->u64 #f s)
+                                             (u <- scm->u64/truncate #f s))
+           ((u <- scm->s64 #f s)             (s <- s64->scm #f u))
+           ((s <- s64->scm #f u)             (u <- scm->s64 #f s))
+           ((s <- s64->scm/unlikely #f u)    (u <- scm->s64 #f s))
+           ((u <- untag-fixnum #f s)         (s <- s64->scm #f u)
+                                             (s <- tag-fixnum #f u))
+           ;; NB: These definitions rely on U having top 2 bits equal to
+           ;; 3rd (sign) bit.
+           ((s <- tag-fixnum #f u)           (u <- scm->s64 #f s)
+                                             (u <- untag-fixnum #f s))
+           ((s <- u64->s64 #f u)             (u <- s64->u64 #f s))
+           ((u <- s64->u64 #f s)             (s <- u64->s64 #f u))
+
+           ((u <- untag-char #f s)           (s <- tag-char #f u))
+           ((s <- tag-char #f u)             (u <- untag-char #f s)))))
 
       (define (visit-label label equiv-labels var-substs)
+        (define (term-defs term)
+          (match term
+            (($ $continue k)
+             (and (intset-ref singly-referenced k)
+                  (intmap-ref defs label)))
+            (($ $branch) '())))
         (match (intmap-ref conts label)
-          (($ $kargs names vars ($ $continue k src exp))
-           (let* ((exp-key (compute-exp-key var-substs exp))
-                  (equiv (hash-ref equiv-set exp-key '()))
-                  (fx (intmap-ref effects label))
-                  (avail (intmap-ref avail label)))
-             (define (finish equiv-labels var-substs)
-               ;; If this expression defines auxiliary definitions,
-               ;; as `cons' does for the results of `car' and `cdr',
-               ;; define those.  Do so after finding equivalent
-               ;; expressions, so that we can take advantage of
-               ;; subst'd output vars.
-               (add-auxiliary-definitions! label var-substs exp-key)
-               (values equiv-labels var-substs))
-             (let lp ((candidates equiv))
-               (match candidates
-                 (()
-                  ;; No matching expressions.  Add our expression
-                  ;; to the equivalence set, if appropriate.  Note
-                  ;; that expressions that allocate a fresh object
-                  ;; or change the current fluid environment can't
-                  ;; be eliminated by CSE (though DCE might do it
-                  ;; if the value proves to be unused, in the
-                  ;; allocation case).
-                  (when (and exp-key
-                             (not (causes-effect? fx &allocation))
-                             (not (effect-clobbers? fx (&read-object &fluid))))
-                    (let ((defs (and (intset-ref singly-referenced k)
-                                     (intmap-ref defs label))))
-                      (when defs
-                        (hash-set! equiv-set exp-key
-                                   (acons label defs equiv)))))
-                  (finish equiv-labels var-substs))
-                 (((and head (candidate . vars)) . candidates)
-                  (cond
-                   ((not (intset-ref avail candidate))
-                    ;; This expression isn't available here; try
-                    ;; the next one.
-                    (lp candidates))
-                   (else
-                    ;; Yay, a match.  Mark expression as equivalent.  If
-                    ;; we provide the definitions for the successor, mark
-                    ;; the vars for substitution.
-                    (finish (intmap-add equiv-labels label head)
-                            (let ((defs (and (intset-ref singly-referenced k)
-                                             (intmap-ref defs label))))
-                              (if defs
-                                  (fold (lambda (def var var-substs)
-                                          (intmap-add var-substs def var))
-                                        var-substs defs vars)
-                                  var-substs))))))))))
+          (($ $kargs names vars term)
+           (match (compute-term-key var-substs term)
+             (#f (values equiv-labels var-substs))
+             (term-key
+              (let* ((equiv (hash-ref equiv-set term-key '()))
+                     (fx (intmap-ref effects label))
+                     (avail (intmap-ref avail label)))
+                (define (finish equiv-labels var-substs)
+                  ;; If this expression defines auxiliary definitions,
+                  ;; as `cons' does for the results of `car' and `cdr',
+                  ;; define those.  Do so after finding equivalent
+                  ;; expressions, so that we can take advantage of
+                  ;; subst'd output vars.
+                  (add-auxiliary-definitions! label var-substs term-key)
+                  (values equiv-labels var-substs))
+                (let lp ((candidates equiv))
+                  (match candidates
+                    (()
+                     ;; No matching expressions.  Add our expression
+                     ;; to the equivalence set, if appropriate.  Note
+                     ;; that expressions that allocate a fresh object
+                     ;; or change the current fluid environment can't
+                     ;; be eliminated by CSE (though DCE might do it
+                     ;; if the value proves to be unused, in the
+                     ;; allocation case).
+                     (when (and (not (causes-effect? fx &allocation))
+                                (not (effect-clobbers? fx (&read-object &fluid))))
+                       (let ((defs (term-defs term)))
+                         (when defs
+                           (hash-set! equiv-set term-key
+                                      (acons label defs equiv)))))
+                     (finish equiv-labels var-substs))
+                    (((and head (candidate . vars)) . candidates)
+                     (cond
+                      ((not (intset-ref avail candidate))
+                       ;; This expression isn't available here; try
+                       ;; the next one.
+                       (lp candidates))
+                      (else
+                       ;; Yay, a match.  Mark expression as equivalent.  If
+                       ;; we provide the definitions for the successor, mark
+                       ;; the vars for substitution.
+                       (finish (intmap-add equiv-labels label head)
+                               (let ((defs (term-defs term)))
+                                 (if defs
+                                     (fold (lambda (def var var-substs)
+                                             (intmap-add var-substs def var))
+                                           var-substs defs vars)
+                                     var-substs))))))))))))
           (_ (values equiv-labels var-substs))))
 
       ;; Traverse the labels in fun in reverse post-order, which will
@@ -360,51 +361,52 @@ false.  It could be that both true and false proofs are available."
 
   (define (visit-exp exp)
     (rewrite-exp exp
-      ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure)) ,exp)
+      ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun) ($ $code)) ,exp)
       (($ $call proc args)
        ($call (subst-var proc) ,(map subst-var args)))
       (($ $callk k proc args)
-       ($callk k (subst-var proc) ,(map subst-var args)))
-      (($ $primcall name args)
-       ($primcall name ,(map subst-var args)))
-      (($ $branch k exp)
-       ($branch k ,(visit-exp exp)))
+       ($callk k (and proc (subst-var proc)) ,(map subst-var args)))
+      (($ $primcall name param args)
+       ($primcall name param ,(map subst-var args)))
       (($ $values args)
-       ($values ,(map subst-var args)))
-      (($ $prompt escape? tag handler)
-       ($prompt escape? (subst-var tag) handler))))
+       ($values ,(map subst-var args)))))
+
+  (define (visit-term label term)
+    (match term
+      (($ $branch kf kt src op param args)
+       (match (intmap-ref equiv-labels label (lambda (_) #f))
+         ((equiv) ; A branch defines no values.
+          (let* ((bool (intmap-ref truthy-labels label))
+                 (t (intset-ref bool (true-idx equiv)))
+                 (f (intset-ref bool (false-idx equiv))))
+            (if (eqv? t f)
+                (build-term
+                  ($branch kf kt src op param ,(map subst-var args)))
+                (build-term
+                  ($continue (if t kt kf) src ($values ()))))))
+         (#f
+          (build-term
+            ($branch kf kt src op param ,(map subst-var args))))))
+      (($ $continue k src exp)
+       (match (intmap-ref equiv-labels label (lambda (_) #f))
+         ((equiv . vars)
+          (build-term ($continue k src ($values vars))))
+         (#f
+          (build-term
+            ($continue k src ,(visit-exp exp))))))
+      (($ $prompt k kh src escape? tag)
+       (build-term
+         ($prompt k kh src escape? (subst-var tag))))
+      (($ $throw src op param args)
+       (build-term
+         ($throw src op param ,(map subst-var args))))))
 
   (intmap-map
    (lambda (label cont)
-     (match cont
-       (($ $kargs names vars ($ $continue k src exp))
-        (build-cont
-          ($kargs names vars
-            ,(match (intmap-ref equiv-labels label (lambda (_) #f))
-               ((equiv . vars)
-                (match exp
-                  (($ $branch kt exp)
-                   (let* ((bool (intmap-ref truthy-labels label))
-                          (t (intset-ref bool (true-idx equiv)))
-                          (f (intset-ref bool (false-idx equiv))))
-                     (if (eqv? t f)
-                         (build-term
-                           ($continue k src
-                             ($branch kt ,(visit-exp exp))))
-                         (build-term
-                           ($continue (if t kt k) src ($values ()))))))
-                  (_
-                   ;; For better or for worse, we only replace primcalls
-                   ;; if they have an associated VM op, which allows
-                   ;; them to continue to $kargs and thus we know their
-                   ;; defs and can use a $values expression instead of a
-                   ;; values primcall.
-                   (build-term
-                     ($continue k src ($values vars))))))
-               (#f
-                (build-term
-                  ($continue k src ,(visit-exp exp))))))))
-       (_ cont)))
+     (rewrite-cont cont
+       (($ $kargs names vars term)
+        ($kargs names vars ,(visit-term label term)))
+       (_ ,cont)))
    conts))
 
 (define (eliminate-common-subexpressions conts)
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 52bd70898..5be573d0e 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -80,6 +80,11 @@ sites."
                                      (causes-effect? fx &allocation))
                                 (values (intset-add! known k) unknown)
                                 (values known (intset-add! unknown k)))))
+                         (($ $kargs _ _ (or ($ $branch) ($ $prompt) ($ $throw)))
+                          ;; Branches and prompts pass no values to
+                          ;; their continuations, and throw terms don't
+                          ;; continue at all.
+                          (values known unknown))
                          (($ $kreceive arity kargs)
                           (values known (intset-add! unknown kargs)))
                          (($ $kfun src meta self tail clause)
@@ -129,7 +134,9 @@ sites."
          (values live-labels live-vars))
         (($ $fun body)
          (values (intset-add live-labels body) live-vars))
-        (($ $closure body)
+        (($ $const-fun body)
+         (values (intset-add live-labels body) live-vars))
+        (($ $code body)
          (values (intset-add live-labels body) live-vars))
         (($ $rec names vars (($ $fun kfuns) ...))
          (let lp ((vars vars) (kfuns kfuns)
@@ -142,19 +149,15 @@ sites."
                       (intset-add live-labels kfun)
                       live-labels)
                   live-vars)))))
-        (($ $prompt escape? tag handler)
-         (values live-labels (adjoin-var tag live-vars)))
         (($ $call proc args)
          (values live-labels (adjoin-vars args (adjoin-var proc live-vars))))
         (($ $callk kfun proc args)
          (values (intset-add live-labels kfun)
-                 (adjoin-vars args (adjoin-var proc live-vars))))
-        (($ $primcall name args)
-         (values live-labels (adjoin-vars args live-vars)))
-        (($ $branch k ($ $primcall name args))
+                 (adjoin-vars args (if proc
+                                       (adjoin-var proc live-vars)
+                                       live-vars))))
+        (($ $primcall name param args)
          (values live-labels (adjoin-vars args live-vars)))
-        (($ $branch k ($ $values (arg)))
-         (values live-labels (adjoin-var arg live-vars)))
         (($ $values args)
          (values live-labels
                  (match (cont-defs k)
@@ -175,8 +178,6 @@ sites."
           (or
            ;; No defs; perhaps continuation is $ktail.
            (not defs)
-           ;; We don't remove branches.
-           (match exp (($ $branch) #t) (_ #f))
            ;; Do we have a live def?
            (any-var-live? defs live-vars)
            ;; Does this expression cause all effects?  If so, it's
@@ -191,9 +192,8 @@ sites."
            (and (causes-effect? fx &write)
                 (match exp
                   (($ $primcall
-                      (or 'vector-set! 'vector-set!/immediate
-                          'set-car! 'set-cdr!
-                          'box-set!)
+                      (or 'scm-set! 'scm-set!/tag 'scm-set!/immediate
+                          'word-set! 'word-set!/immediate) _
                       (obj . _))
                    (or (var-live? obj live-vars)
                        (not (intset-ref known-allocations obj))))
@@ -204,6 +204,32 @@ sites."
         ;; Still dead.
         (values live-labels live-vars))))
 
+    (define (visit-branch label kf kt args live-labels live-vars)
+      (define (next-live-term k)
+        ;; FIXME: For a chain of dead branches, this is quadratic.
+        (let lp ((seen empty-intset) (k k))
+          (cond
+           ((intset-ref live-labels k) k)
+           ((intset-ref seen k) k)
+           (else
+            (match (intmap-ref conts k)
+              (($ $kargs _ _ ($ $continue k*))
+               (lp (intset-add seen k) k*))
+              (_ k))))))
+      (cond
+       ((intset-ref live-labels label)
+        ;; Branch live already.
+        (values live-labels (adjoin-vars args live-vars)))
+       ((or (causes-effect? (intmap-ref effects label) &type-check)
+            (not (eqv? (next-live-term kf) (next-live-term kt))))
+        ;; The branch is live if its continuations are not the same, or
+        ;; if the branch itself causes type checks.
+        (values (intset-add live-labels label)
+                (adjoin-vars args live-vars)))
+       (else
+        ;; Still dead.
+        (values live-labels live-vars))))
+
     (define (visit-fun label live-labels live-vars)
       ;; Visit uses before definitions.
       (postorder-fold-local-conts2
@@ -211,12 +237,24 @@ sites."
          (match cont
            (($ $kargs _ _ ($ $continue k src exp))
             (visit-exp label k exp live-labels live-vars))
+           (($ $kargs _ _ ($ $branch kf kt src op param args))
+            (visit-branch label kf kt args live-labels live-vars))
+           (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+            ;; Prompts need special elision passes that would contify
+            ;; aborts and remove corresponding "unwind" primcalls.
+            (values (intset-add live-labels label)
+                    (adjoin-var tag live-vars)))
+           (($ $kargs _ _ ($ $throw src op param args))
+            ;; A reachable "throw" is always live.
+            (values (intset-add live-labels label)
+                    (adjoin-vars args live-vars)))
            (($ $kreceive arity kargs)
             (values live-labels live-vars))
            (($ $kclause arity kargs kalt)
             (values live-labels (adjoin-vars (cont-defs kargs) live-vars)))
            (($ $kfun src meta self)
-            (values live-labels (adjoin-var self live-vars)))
+            (values live-labels
+                    (if self (adjoin-var self live-vars) live-vars)))
            (($ $ktail)
             (values live-labels live-vars))))
        conts label live-labels live-vars))
@@ -272,7 +310,7 @@ sites."
              (($ $fun body)
               (values cps
                       term))
-             (($ $closure body nfree)
+             (($ $const-fun body)
               (values cps
                       term))
              (($ $rec names vars funs)
@@ -312,7 +350,17 @@ sites."
                  (values cps term)))))
            (values cps
                    (build-term
-                     ($continue k src ($values ()))))))))
+                     ($continue k src ($values ()))))))
+      (($ $branch kf kt src op param args)
+       (if (label-live? label)
+           (values cps term)
+           ;; Dead branches continue to the same continuation
+           ;; (eventually).
+           (values cps (build-term ($continue kf src ($values ()))))))
+      (($ $prompt)
+       (values cps term))
+      (($ $throw)
+       (values cps term))))
   (define (visit-cont label cont cps)
     (match cont
       (($ $kargs names vars term)
diff --git a/module/language/cps/devirtualize-integers.scm b/module/language/cps/devirtualize-integers.scm
new file mode 100644
index 000000000..e7efd2137
--- /dev/null
+++ b/module/language/cps/devirtualize-integers.scm
@@ -0,0 +1,263 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;;
+;;; Some parts of programs operate on exact integers.  An exact integer
+;;; is either a fixnum or a bignum.  It's often the case that if we know
+;;; that a number is a fixnum, all operations on it can be unboxed in
+;;; terms of s64 operations.  But if there's a series of operations and
+;;; each one works on either bignums or fixnums, then the mixing of
+;;; fixnums and bignums through that one control and data flow path
+;;; makes it impossible for the compiler to specialize operations to
+;;; either type.
+;;;
+;;; This "integer devirtualization" pass tries to duplicate the control
+;;; and data flow of exact integers into two flows: one for bignums and
+;;; one for fixnums.  This causes code growth, so it's something we need
+;;; to be careful about.
+;;;
+;;; Code:
+
+(define-module (language cps devirtualize-integers)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (language cps)
+  #:use-module (language cps effects-analysis)
+  #:use-module (language cps intmap)
+  #:use-module (language cps intset)
+  #:use-module (language cps utils)
+  #:use-module (language cps with-cps)
+  #:export (devirtualize-integers))
+
+;; Compute a map from VAR -> COUNT, where COUNT indicates the number of
+;; times in the source program that VAR is used.
+(define (compute-use-counts cps)
+  (define (add-use use-counts var)
+    (let ((count (1+ (intmap-ref use-counts var (lambda (_) 0)))))
+      (intmap-add! use-counts var count (lambda (old new) new))))
+  (define (add-uses use-counts vars)
+    (match vars
+      (() use-counts)
+      ((var . vars) (add-uses (add-use use-counts var) vars))))
+  (persistent-intmap
+   (intmap-fold
+    (lambda (label cont use-counts)
+      (match cont
+        (($ $kargs names vars term)
+         (match term
+           (($ $continue k src exp)
+            (match exp
+              ((or ($ $const) ($ $prim) ($ $fun) ($ $const-fun) ($ $code) ($ $rec))
+               use-counts)
+              (($ $values args)
+               (add-uses use-counts args))
+              (($ $call proc args)
+               (add-uses (add-use use-counts proc) args))
+              (($ $callk kfun proc args)
+               (add-uses (if proc (add-use use-counts proc) use-counts) args))
+              (($ $primcall name param args)
+               (add-uses use-counts args))))
+           (($ $branch kf kt src op param args)
+            (add-uses use-counts args))
+           (($ $prompt k kh src escape? tag)
+            (add-use use-counts tag))
+           (($ $throw src op param args)
+            (add-uses use-counts args))))
+        (_ use-counts)))
+    cps
+    (transient-intmap))))
+
+(define (bailout? cps label)
+  (match (intmap-ref cps label)
+    (($ $kargs _ _ ($ $throw)) #t)
+    (_ #f)))
+
+(define (peel-trace cps label fx kexit use-counts)
+  "For the graph starting at LABEL, try to peel out a trace that uses
+the variable FX.  A peelable trace consists of effect-free terms, or
+terms that only have &type-check effect but which use FX or some
+variable that was defined using FX as an input.  No variable defined in
+the trace should be referenced outside of it."
+  (let peel-cont ((cps cps) (label label)
+                  (live-vars empty-intmap) ;; var -> pending refcount
+                  (fresh-vars empty-intmap) ;; old-name -> new name
+                  (vars-of-interest (intset-add empty-intset fx))
+                  (defs-of-interest? #f))
+    (define (fail) (with-cps cps #f))
+    (define (add-live-vars live-vars vars)
+      (match vars
+        (() live-vars)
+        ((var . vars)
+         (add-live-vars
+          (let ((count (intmap-ref use-counts var (lambda (_) 0))))
+            (if (zero? count)
+                live-vars
+                (intmap-add live-vars var count)))
+          vars))))
+    (define (subtract-uses live-vars vars)
+      (match vars
+        (() live-vars)
+        ((var . vars)
+         (subtract-uses
+          (let ((count (intmap-ref live-vars var (lambda (_) #f))))
+            (cond
+             ((not count) live-vars)
+             ((= count 1) (intmap-remove live-vars var))
+             (else (intmap-replace live-vars var (1- count)))))
+          vars))))
+    (match (intmap-ref cps label)
+      ;; We know the initial label is a $kargs, and we won't follow the
+      ;; graph to get to $kreceive etc, so we can stop with these two
+      ;; continuation kinds.  (For our purposes, only $values can
+      ;; continue to $ktail.)
+      (($ $ktail) (fail))
+      (($ $kargs names vars term)
+       (let* ((vars-of-interest
+               (if defs-of-interest?
+                   (fold1 (lambda (var set) (intset-add set var))
+                          vars vars-of-interest)
+                   vars-of-interest))
+              (live-vars (add-live-vars live-vars vars))
+              (fresh-vars (fold (lambda (var fresh-vars)
+                                  (intmap-add fresh-vars var (fresh-var)))
+                                fresh-vars vars))
+              (peeled-vars (map (lambda (var) (intmap-ref fresh-vars var))
+                                vars)))
+         (define (rename-uses args)
+           (map (lambda (arg) (intmap-ref fresh-vars arg (lambda (arg) arg)))
+                args))
+         (define (any-use-of-interest? args)
+           (or-map (lambda (arg) (intset-ref vars-of-interest arg))
+                   args))
+         (define (continue k live-vars defs-of-interest? can-terminate-trace?
+                           make-term)
+           (define (stitch cps k)
+             (with-cps cps
+               (letk label* ($kargs names peeled-vars ,(make-term k)))
+               label*))
+           (define (terminate)
+             (stitch cps k))
+           (with-cps cps
+             (let$ k* (peel-cont k live-vars fresh-vars vars-of-interest
+                                 defs-of-interest?))
+             ($ ((lambda (cps)
+                   (cond
+                    (k* (stitch cps k*))
+                    ((and can-terminate-trace? (eq? live-vars empty-intmap))
+                     (terminate))
+                    (else (fail))))))))
+         (match term
+           (($ $branch kf kt src op param args)
+            ;; kt or k is kf; var of interest is in args
+            (let* ((live-vars (subtract-uses live-vars args))
+                   (uses-of-interest? (any-use-of-interest? args))
+                   (defs-of-interest? #f) ;; Branches don't define values.
+                   (can-terminate-trace? uses-of-interest?)
+                   (peeled-args (rename-uses args)))
+              (cond
+               ((not uses-of-interest?)
+                (fail))
+               ((bailout? cps kt)
+                (continue kf live-vars defs-of-interest? can-terminate-trace?
+                          (lambda (kf)
+                            (build-term
+                              ($branch kf kt src op param peeled-args)))))
+               ((bailout? cps kf)
+                (continue kt live-vars defs-of-interest? can-terminate-trace?
+                          (lambda (kt)
+                            (build-term
+                              ($branch kf kt src op param peeled-args)))))
+               ((eq? live-vars empty-intmap)
+                (with-cps cps
+                  (letk label*
+                        ($kargs names peeled-vars
+                          ($branch kf kt src op param peeled-args)))
+                  label*))
+               (else
+                (fail)))))
+           (($ $continue k src exp)
+            (match exp
+              (($ $const)
+               ;; fine.
+               (continue k live-vars #f #f
+                         (lambda (k)
+                           (build-term ($continue k src ,exp)))))
+              (($ $values args)
+               (let ((uses-of-interest? (any-use-of-interest? args))
+                     (live-vars (subtract-uses live-vars args))
+                     (peeled-args (rename-uses args)))
+                 (continue k live-vars
+                           uses-of-interest? #f
+                           (lambda (k)
+                             (build-term
+                               ($continue k src ($values peeled-args)))))))
+              (($ $primcall name param args)
+               ;; exp is effect-free or var of interest in args
+               (let* ((fx (expression-effects exp))
+                      (uses-of-interest? (any-use-of-interest? args))
+                      (live-vars (subtract-uses live-vars args))
+                      (peeled-args (rename-uses args)))
+                 ;; If the primcall uses a value of interest,
+                 ;; consider it for peeling even if it would cause a
+                 ;; type check; perhaps the peeling causes the type
+                 ;; check to go away.
+                 (if (or (eqv? fx &no-effects)
+                         (and uses-of-interest? (eqv? fx &type-check)))
+                     (continue k live-vars
+                               ;; Primcalls that use values of interest
+                               ;; define values of interest.
+                               uses-of-interest? #t
+                               (lambda (k)
+                                 (build-term
+                                   ($continue k src
+                                     ($primcall name param ,peeled-args)))))
+                     (fail))))
+              (_ (fail))))))))))
+
+(define (peel-traces-in-function cps body use-counts)
+  (intset-fold
+   (lambda (label cps)
+     (match (intmap-ref cps label)
+       ;; Traces start with a fixnum? predicate.  We could expand this
+       ;; in the future if we wanted to.
+       (($ $kargs names vars ($ $branch kf kt src 'fixnum? #f (x)))
+        (if (and (bailout? cps kf) #f)
+            ;; Don't peel traces whose alternate is just a bailout.
+            cps
+            (with-cps cps
+              (let$ kt (peel-trace kt x kf use-counts))
+              ($ ((lambda (cps)
+                    (if kt
+                        (with-cps cps
+                          (setk label
+                                ($kargs names vars
+                                  ($branch kf kt src 'fixnum? #f (x)))))
+                        cps)))))))
+       (_ cps)))
+   body
+   cps))
+
+(define (devirtualize-integers cps)
+  (let ((use-counts (compute-use-counts cps)))
+    (with-fresh-name-state cps
+      (intmap-fold
+       (lambda (kfun body cps)
+         (peel-traces-in-function cps body use-counts))
+       (compute-reachable-functions cps)
+       cps))))
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index fe89a123e..250aec78a 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
 ;;; Effects analysis on CPS
 
-;; Copyright (C) 2011-2015, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -56,8 +56,6 @@
 
             &fluid
             &prompt
-            &car
-            &cdr
             &vector
             &box
             &module
@@ -79,9 +77,6 @@
             &no-effects
             &all-effects
 
-            exclude-effects
-            effect-free?
-            constant?
             causes-effect?
             causes-all-effects?
             effect-clobbers?
@@ -190,7 +185,13 @@
   &bytevector
 
   ;; Indicates a dependency on a free variable of a closure.
-  &closure)
+  &closure
+
+  ;; Indicates a dependency on a raw bitmask, measured in 32-bit units.
+  &bitmask
+
+  ;; Indicates a dependency on the value of a cache cell.
+  &cache)
 
 (define-inlinable (&field kind field)
   (ash (logior (ash field &memory-kind-bits) kind) &effect-kind-bits))
@@ -213,9 +214,6 @@
   (identifier-syntax
    (logior &all-effect-kinds (&object &unknown-memory-kinds))))
 
-(define-inlinable (constant? effects)
-  (zero? effects))
-
 (define-inlinable (causes-effect? x effects)
   (not (zero? (logand x effects))))
 
@@ -271,51 +269,60 @@ the LABELS that are clobbered by the effects of LABEL."
                       empty-intset))
                 effects)))
 
-(define-inlinable (indexed-field kind var constants)
-  (let ((val (intmap-ref constants var (lambda (_) #f))))
-    (if (and (exact-integer? val) (<= 0 val))
-        (&field kind val)
-        (&object kind))))
-
 (define *primitive-effects* (make-hash-table))
 
-(define-syntax-rule (define-primitive-effects* constants
+(define-syntax-rule (define-primitive-effects* param
                       ((name . args) effects ...)
                       ...)
   (begin
     (hashq-set! *primitive-effects* 'name
                 (case-lambda*
-                 ((constants . args) (logior effects ...))
+                 ((param . args) (logior effects ...))
                  (_ &all-effects)))
     ...))
 
 (define-syntax-rule (define-primitive-effects ((name . args) effects ...) ...)
-  (define-primitive-effects* constants ((name . args) effects ...) ...))
+  (define-primitive-effects* param ((name . args) effects ...) ...))
 
 ;; Miscellaneous.
 (define-primitive-effects
+  ((load-const/unlikely))
   ((values . _)))
 
 ;; Generic effect-free predicates.
 (define-primitive-effects
-  ((eq? . _))
-  ((eqv? . _))
-  ((equal? . _))
-  ((pair? arg))
+  ((eq? x y))
+  ((equal? x y))
+  ((fixnum? arg))
+  ((char? arg))
+  ((eq-null? arg))
+  ((eq-nil? arg))
+  ((eq-false? arg))
+  ((eq-true? arg))
+  ((unspecified? arg))
+  ((undefined? arg))
+  ((eof-object? arg))
   ((null? arg))
-  ((nil? arg ))
+  ((false? arg))
+  ((nil? arg))
+  ((heap-object? arg))
+  ((pair? arg))
   ((symbol? arg))
   ((variable? arg))
   ((vector? arg))
   ((struct? arg))
   ((string? arg))
   ((number? arg))
-  ((char? arg))
   ((bytevector? arg))
   ((keyword? arg))
   ((bitvector? arg))
   ((procedure? arg))
-  ((thunk? arg)))
+  ((thunk? arg))
+  ((heap-number? arg))
+  ((bignum? arg))
+  ((flonum? arg))
+  ((compnum? arg))
+  ((fracnum? arg)))
 
 ;; Fluids.
 (define-primitive-effects
@@ -336,148 +343,152 @@ the LABELS that are clobbered by the effects of LABEL."
 (define-primitive-effects
   ((make-prompt-tag #:optional arg) (&allocate &unknown-memory-kinds)))
 
-;; Pairs.
-(define-primitive-effects
-  ((cons a b)                      (&allocate &pair))
-  ((list . _)                      (&allocate &pair))
-  ((car x)                         (&read-field &pair 0)       &type-check)
-  ((set-car! x y)                  (&write-field &pair 0)      &type-check)
-  ((cdr x)                         (&read-field &pair 1)       &type-check)
-  ((set-cdr! x y)                  (&write-field &pair 1)      &type-check)
-  ((memq x y)                      (&read-object &pair)        &type-check)
-  ((memv x y)                      (&read-object &pair)        &type-check)
-  ((list? arg)                     (&read-field &pair 1))
-  ((length l)                      (&read-field &pair 1)       &type-check))
-
-;; Variables.
-(define-primitive-effects
-  ((box v)                         (&allocate &box))
-  ((box-ref v)                     (&read-object &box)         &type-check)
-  ((box-set! v x)                  (&write-object &box)        &type-check))
-
-;; Vectors.
-(define (vector-field n constants)
-  (indexed-field &vector n constants))
-(define (read-vector-field n constants)
-  (logior &read (vector-field n constants)))
-(define (write-vector-field n constants)
-  (logior &write (vector-field n constants)))
-(define-primitive-effects* constants
-  ((vector . _)                    (&allocate &vector))
-  ((make-vector n init)            (&allocate &vector))
-  ((make-vector/immediate n init)  (&allocate &vector))
-  ((vector-ref v n)                (read-vector-field n constants) &type-check)
-  ((vector-ref/immediate v n)      (read-vector-field n constants) &type-check)
-  ((vector-set! v n x)             (write-vector-field n constants) &type-check)
-  ((vector-set!/immediate v n x)   (write-vector-field n constants) &type-check)
-  ((vector-length v)                                           &type-check))
-
-;; Structs.
-(define (struct-field n constants)
-  (indexed-field &struct n constants))
-(define (read-struct-field n constants)
-  (logior &read (struct-field n constants)))
-(define (write-struct-field n constants)
-  (logior &write (struct-field n constants)))
-(define-primitive-effects* constants
-  ((allocate-struct vt n)          (&allocate &struct)         &type-check)
-  ((allocate-struct/immediate v n) (&allocate &struct)         &type-check)
-  ((make-struct/no-tail vt . _)    (&allocate &struct)         &type-check)
-  ((struct-ref s n)                (read-struct-field n constants) &type-check)
-  ((struct-ref/immediate s n)      (read-struct-field n constants) &type-check)
-  ((struct-set! s n x)             (write-struct-field n constants) &type-check)
-  ((struct-set!/immediate s n x)   (write-struct-field n constants) &type-check)
-  ((struct-vtable s)                                           &type-check))
+;; Generic objects.
+(define (annotation->memory-kind annotation)
+  (match annotation
+    ('pair &pair)
+    ('vector &vector)
+    ('string &string)
+    ('stringbuf &string)
+    ('bytevector &bytevector)
+    ('bitmask &bitmask)
+    ('box &box)
+    ('closure &closure)
+    ('struct &struct)
+    ('atomic-box &unknown-memory-kinds)))
+
+(define-primitive-effects* param
+  ((allocate-words size)           (&allocate (annotation->memory-kind param)))
+  ((allocate-words/immediate)      (match param
+                                     ((ann . size)
+                                      (&allocate
+                                       (annotation->memory-kind ann)))))
+  ((scm-ref obj idx)               (&read-object
+                                    (annotation->memory-kind param)))
+  ((scm-ref/tag obj)               (&read-field
+                                    (annotation->memory-kind param) 0))
+  ((scm-ref/immediate obj)         (match param
+                                     ((ann . idx)
+                                      (&read-field
+                                       (annotation->memory-kind ann) idx))))
+  ((scm-set! obj idx val)          (&write-object
+                                    (annotation->memory-kind param)))
+  ((scm-set/tag! obj val)          (&write-field
+                                    (annotation->memory-kind param) 0))
+  ((scm-set!/immediate obj val)    (match param
+                                     ((ann . idx)
+                                      (&write-field
+                                       (annotation->memory-kind ann) idx))))
+  ((word-ref obj idx)              (&read-object
+                                    (annotation->memory-kind param)))
+  ((word-ref/immediate obj)        (match param
+                                     ((ann . idx)
+                                      (&read-field
+                                       (annotation->memory-kind ann) idx))))
+  ((word-set! obj idx val)         (&read-object
+                                    (annotation->memory-kind param)))
+  ((word-set!/immediate obj val)   (match param
+                                     ((ann . idx)
+                                      (&write-field
+                                       (annotation->memory-kind ann) idx))))
+  ((pointer-ref/immediate obj)     (match param
+                                     ((ann . idx)
+                                      (&read-field
+                                       (annotation->memory-kind ann) idx))))
+  ((pointer-set!/immediate obj val)
+                                   (match param
+                                     ((ann . idx)
+                                      (&write-field
+                                       (annotation->memory-kind ann) idx))))
+  ((tail-pointer-ref/immediate obj)))
 
 ;; Strings.
 (define-primitive-effects
-  ((string-ref s n)                (&read-object &string)      &type-check)
   ((string-set! s n c)             (&write-object &string)     &type-check)
   ((number->string _)              (&allocate &string)         &type-check)
-  ((string->number _)              (&read-object &string)      &type-check)
-  ((string-length s)                                           &type-check))
+  ((string->number _)              (&read-object &string)      &type-check))
 
 ;; Unboxed floats and integers.
 (define-primitive-effects
   ((scm->f64 _)                                                &type-check)
-  ((load-f64 _))
+  ((load-f64))
   ((f64->scm _))
   ((scm->u64 _)                                                &type-check)
   ((scm->u64/truncate _)                                       &type-check)
-  ((load-u64 _))
+  ((load-u64))
   ((u64->scm _))
+  ((u64->scm/unlikely _))
   ((scm->s64 _)                                                &type-check)
-  ((load-s64 _))
-  ((s64->scm _)))
-
-;; Bytevectors.
-(define-primitive-effects
-  ((bv-length _)                                               &type-check)
-
-  ((bv-u8-ref bv n)                (&read-object &bytevector)  &type-check)
-  ((bv-s8-ref bv n)                (&read-object &bytevector)  &type-check)
-  ((bv-u16-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-s16-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-u32-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-s32-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-u64-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-s64-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-f32-ref bv n)               (&read-object &bytevector)  &type-check)
-  ((bv-f64-ref bv n)               (&read-object &bytevector)  &type-check)
-
-  ((bv-u8-set! bv n x)             (&write-object &bytevector) &type-check)
-  ((bv-s8-set! bv n x)             (&write-object &bytevector) &type-check)
-  ((bv-u16-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-s16-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-u32-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-s32-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-u64-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-s64-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-f32-set! bv n x)            (&write-object &bytevector) &type-check)
-  ((bv-f64-set! bv n x)            (&write-object &bytevector) &type-check))
-
-;; Closures.
-(define (closure-field n constants)
-  (indexed-field &closure n constants))
-(define (read-closure-field n constants)
-  (logior &read (closure-field n constants)))
-(define (write-closure-field n constants)
-  (logior &write (closure-field n constants)))
-(define-primitive-effects* constants
-  ((free-ref closure idx)          (read-closure-field idx constants))
-  ((free-set! closure idx val)     (write-closure-field idx constants)))
+  ((load-s64))
+  ((s64->scm _))
+  ((s64->scm/unlikely _))
+  ((u64->s64 _))
+  ((s64->u64 _))
+  ((assume-u64 _))
+  ((assume-s64 _))
+  ((untag-fixnum _))
+  ((tag-fixnum _))
+  ((tag-fixnum/unlikely _)))
+
+;; Pointers.
+(define-primitive-effects* param
+  ((u8-ref obj bv n)               (&read-object (annotation->memory-kind param)))
+  ((s8-ref obj bv n)               (&read-object (annotation->memory-kind param)))
+  ((u16-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((s16-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((u32-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((s32-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((u64-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((s64-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((f32-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+  ((f64-ref obj bv n)              (&read-object (annotation->memory-kind param)))
+
+  ((u8-set! obj bv n x)            (&write-object (annotation->memory-kind param)))
+  ((s8-set! obj bv n x)            (&write-object (annotation->memory-kind param)))
+  ((u16-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((s16-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((u32-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((s32-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((u64-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((s64-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((f32-set! obj bv n x)           (&write-object (annotation->memory-kind param)))
+  ((f64-set! obj bv n x)           (&write-object (annotation->memory-kind param))))
 
 ;; Modules.
 (define-primitive-effects
   ((current-module)                (&read-object &module))
-  ((cache-current-module! m scope) (&write-object &box))
-  ((resolve name bound?)           (&read-object &module)      &type-check)
-  ((cached-toplevel-box scope name bound?)                     &type-check)
-  ((cached-module-box mod name public? bound?)                 &type-check)
-  ((define! name)                  (&read-object &module)))
+  ((cache-current-module! m)       (&write-object &cache))
+  ((resolve name)                  (&read-object &module)      &type-check)
+  ((resolve-module mod)            (&read-object &module)      &type-check)
+  ((lookup mod name)               (&read-object &module)      &type-check)
+  ((cached-toplevel-box)                                       &type-check)
+  ((cached-module-box)                                         &type-check)
+  ((define! mod name)              (&read-object &module)))
+
+;; Cache cells.
+(define-primitive-effects
+  ((cache-ref)                     (&read-object &cache))
+  ((cache-set! x)                  (&write-object &cache)))
 
 ;; Numbers.
 (define-primitive-effects
+  ((heap-numbers-equal? . _))
   ((= . _)                         &type-check)
+  ((<= . _)                         &type-check)
   ((< . _)                         &type-check)
-  ((> . _)                         &type-check)
-  ((<= . _)                        &type-check)
-  ((>= . _)                        &type-check)
   ((u64-= . _))
+  ((u64-imm-= . _))
   ((u64-< . _))
-  ((u64-> . _))
-  ((u64-<= . _))
-  ((u64->= . _))
-  ((u64-<-scm . _)                 &type-check)
-  ((u64-<=-scm . _)                &type-check)
-  ((u64-=-scm . _)                 &type-check)
-  ((u64->=-scm . _)                 &type-check)
-  ((u64->-scm . _)                 &type-check)
+  ((u64-imm-< . _))
+  ((imm-u64-< . _))
+  ((s64-= . _))
+  ((s64-imm-= . _))
+  ((s64-< . _))
+  ((s64-imm-< . _))
+  ((imm-s64-< . _))
   ((f64-= . _))
   ((f64-< . _))
-  ((f64-> . _))
   ((f64-<= . _))
-  ((f64->= . _))
   ((zero? . _)                     &type-check)
   ((add . _)                       &type-check)
   ((add/immediate . _)             &type-check)
@@ -495,6 +506,12 @@ the LABELS that are clobbered by the effects of LABEL."
   ((uadd/immediate . _))
   ((usub/immediate . _))
   ((umul/immediate . _))
+  ((sadd . _))
+  ((ssub . _))
+  ((smul . _))
+  ((sadd/immediate . _))
+  ((ssub/immediate . _))
+  ((smul/immediate . _))
   ((quo . _)                       &type-check)
   ((rem . _)                       &type-check)
   ((mod . _)                       &type-check)
@@ -508,7 +525,10 @@ the LABELS that are clobbered by the effects of LABEL."
   ((inexact? _)                    &type-check)
   ((even? _)                       &type-check)
   ((odd? _)                        &type-check)
-  ((ash n m)                       &type-check)
+  ((rsh n m)                       &type-check)
+  ((lsh n m)                       &type-check)
+  ((rsh/immediate n)               &type-check)
+  ((lsh/immediate n)               &type-check)
   ((logand . _)                    &type-check)
   ((logior . _)                    &type-check)
   ((logxor . _)                    &type-check)
@@ -519,9 +539,13 @@ the LABELS that are clobbered by the effects of LABEL."
   ((ulogxor . _))
   ((ulogsub . _))
   ((ursh . _))
+  ((srsh . _))
   ((ulsh . _))
+  ((slsh . _))
   ((ursh/immediate . _))
+  ((srsh/immediate . _))
   ((ulsh/immediate . _))
+  ((slsh/immediate . _))
   ((logtest a b)                   &type-check)
   ((logbit? a b)                   &type-check)
   ((sqrt _)                        &type-check)
@@ -529,55 +553,55 @@ the LABELS that are clobbered by the effects of LABEL."
 
 ;; Characters.
 (define-primitive-effects
-  ((integer->char _)               &type-check)
-  ((char->integer _)               &type-check))
+  ((untag-char _))
+  ((tag-char _)))
 
 ;; Atomics are a memory and a compiler barrier; they cause all effects
 ;; so no need to have a case for them here.  (Though, see
 ;; https://jfbastien.github.io/no-sane-compiler/.)
 
-(define (primitive-effects constants name args)
+(define (primitive-effects param name args)
   (let ((proc (hashq-ref *primitive-effects* name)))
     (if proc
-        (apply proc constants args)
+        (apply proc param args)
         &all-effects)))
 
-(define (expression-effects exp constants)
+(define (expression-effects exp)
   (match exp
-    ((or ($ $const) ($ $prim) ($ $values))
-     &no-effects)
-    (($ $closure _ 0)
+    ((or ($ $const) ($ $prim) ($ $values) ($ $code) ($ $const-fun))
      &no-effects)
-    ((or ($ $fun) ($ $rec) ($ $closure))
+    ((or ($ $fun) ($ $rec))
      (&allocate &unknown-memory-kinds))
-    (($ $prompt)
-     ;; Although the "main" path just writes &prompt, we don't know what
-     ;; nonlocal predecessors of the handler do, so we conservatively
-     ;; assume &all-effects.
-     &all-effects)
     ((or ($ $call) ($ $callk))
      &all-effects)
-    (($ $branch k exp)
-     (expression-effects exp constants))
-    (($ $primcall name args)
-     (primitive-effects constants name args))))
+    (($ $primcall name param args)
+     (primitive-effects param name args))))
 
 (define (compute-effects conts)
-  (let ((constants (compute-constant-values conts)))
-    (intmap-map
-     (lambda (label cont)
-       (match cont
-         (($ $kargs names syms ($ $continue k src exp))
-          (expression-effects exp constants))
-         (($ $kreceive arity kargs)
-          (match arity
-            (($ $arity _ () #f () #f) &type-check)
-            (($ $arity () () _ () #f) (&allocate &pair))
-            (($ $arity _ () _ () #f) (logior (&allocate &pair) &type-check))))
-         (($ $kfun) &type-check)
-         (($ $kclause) &type-check)
-         (($ $ktail) &no-effects)))
-     conts)))
+  (intmap-map
+   (lambda (label cont)
+     (match cont
+       (($ $kargs names syms ($ $continue k src exp))
+        (expression-effects exp))
+       (($ $kargs names syms ($ $branch kf kt src op param args))
+        (primitive-effects param op args))
+       (($ $kargs names syms ($ $prompt))
+        ;; Although the "main" path just writes &prompt, we don't know
+        ;; what nonlocal predecessors of the handler do, so we
+        ;; conservatively assume &all-effects.
+        &all-effects)
+       (($ $kargs names syms ($ $throw))
+        ;; A reachable "throw" term can never be elided.
+        &all-effects)
+       (($ $kreceive arity kargs)
+        (match arity
+          (($ $arity _ () #f () #f) &type-check)
+          (($ $arity () () _ () #f) (&allocate &pair))
+          (($ $arity _ () _ () #f) (logior (&allocate &pair) &type-check))))
+       (($ $kfun) &type-check)
+       (($ $kclause) &type-check)
+       (($ $ktail) &no-effects)))
+   conts))
 
 ;; There is a way to abuse effects analysis in CSE to also do scalar
 ;; replacement, effectively adding `car' and `cdr' expressions to `cons'
diff --git a/module/language/cps/elide-values.scm b/module/language/cps/elide-values.scm
deleted file mode 100644
index 81ccfc200..000000000
--- a/module/language/cps/elide-values.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-;;;
-;;; Primcalls that don't correspond to VM instructions are treated as if
-;;; they are calls, and indeed the later reify-primitives pass turns
-;;; them into calls.  Because no return arity checking is done for these
-;;; primitives, if a later optimization pass simplifies the primcall to
-;;; a VM operation, the tail of the simplification has to be a
-;;; primcall to 'values.  Most of these primcalls can be elided, and
-;;; that is the job of this pass.
-;;;
-;;; Code:
-
-(define-module (language cps elide-values)
-  #:use-module (ice-9 match)
-  #:use-module (language cps)
-  #:use-module (language cps utils)
-  #:use-module (language cps with-cps)
-  #:use-module (language cps intmap)
-  #:export (elide-values))
-
-(define (inline-values cps k src args)
-  (match (intmap-ref cps k)
-    (($ $ktail)
-     (with-cps cps
-       (build-term
-         ($continue k src ($values args)))))
-    (($ $kreceive ($ $arity req () rest () #f) kargs)
-     (cond
-      ((and (not rest) (= (length args) (length req)))
-       (with-cps cps
-         (build-term
-           ($continue kargs src ($values args)))))
-      ((and rest (>= (length args) (length req)))
-       (let ()
-         (define (build-rest cps k tail)
-           (match tail
-             (()
-              (with-cps cps
-                (build-term ($continue k src ($const '())))))
-             ((v . tail)
-              (with-cps cps
-                (letv rest)
-                (letk krest ($kargs ('rest) (rest)
-                              ($continue k src ($primcall 'cons (v rest)))))
-                ($ (build-rest krest tail))))))
-         (with-cps cps
-           (letv rest)
-           (letk krest ($kargs ('rest) (rest)
-                         ($continue kargs src
-                           ($values ,(append (list-head args (length req))
-                                             (list rest))))))
-           ($ (build-rest krest (list-tail args (length req)))))))
-      (else (with-cps cps #f))))))
-
-(define (elide-values conts)
-  (with-fresh-name-state conts
-    (persistent-intmap
-     (intmap-fold
-      (lambda (label cont out)
-        (match cont
-          (($ $kargs names vars ($ $continue k src ($ $primcall 'values args)))
-           (call-with-values (lambda () (inline-values out k src args))
-             (lambda (out term)
-               (if term
-                   (let ((cont (build-cont ($kargs names vars ,term))))
-                     (intmap-replace! out label cont))
-                   out))))
-          (_ out)))
-      conts
-      conts))))
diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm
index a52e2ba32..4ac5d7620 100644
--- a/module/language/cps/intmap.scm
+++ b/module/language/cps/intmap.scm
@@ -1,5 +1,5 @@
 ;;; Functional name maps
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-2017,2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -386,7 +386,9 @@ already, and always calls the meet procedure."
        (let ((root* (remove (- i min) shift root)))
          (if (eq? root root*)
              map
-             (make-intmap/prune min shift root*))))
+             (if (absent? root*)
+                 empty-intmap
+                 (make-intmap/prune min shift root*)))))
       (else map)))
     (($ <transient-intmap>)
      (intmap-remove (persistent-intmap map) i))))
@@ -715,6 +717,7 @@ already, and always calls the meet procedure."
        ;; At this point, A and B cover the same range.
        (let ((root (intersect a-shift a-root b-root)))
          (cond
+          ((absent? root) empty-intmap)
           ((eq? root a-root) a)
           ((eq? root b-root) b)
           (else (make-intmap/prune a-min a-shift root)))))))))
diff --git a/module/language/cps/licm.scm b/module/language/cps/licm.scm
index 3b343a66b..698c2d8c8 100644
--- a/module/language/cps/licm.scm
+++ b/module/language/cps/licm.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -55,7 +55,7 @@
     (and
      (not (causes-effect? fx &allocation))
      (or always-reached?
-         (not (causes-effect? fx &type-check)))
+         (not (causes-effect? fx (logior &type-check &read &write))))
      (or (not (causes-effect? fx &write))
          (intmap-fold (lambda (label fx* invariant?)
                         (and invariant?
@@ -67,11 +67,8 @@
                              (not (effect-clobbers? fx* fx))))
                       loop-effects #t))
      (match exp
-       ((or ($ $const) ($ $prim) ($ $closure)) #t)
-       (($ $prompt) #f) ;; ?
-       (($ $branch) #f)
-       (($ $primcall 'values) #f)
-       (($ $primcall name args)
+       ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) #t)
+       (($ $primcall name param args)
         (and-map (lambda (arg) (not (intset-ref loop-vars arg)))
                  args))
        (($ $values args)
@@ -128,59 +125,12 @@
                pre-header-label pre-header-cont)
               pre-header-label)))
   (match cont
-    (($ $kargs names vars ($ $continue k src exp))
-     ;; If k is a loop exit, it will be nullary.
+    (($ $kargs names vars term)
      (let-values (((names vars) (filter-loop-vars names vars)))
-       (match (intmap-ref cps k)
-         (($ $kargs def-names def-vars)
-          (cond
-           ((not (loop-invariant? label exp loop-vars loop-effects
-                                  always-reached?))
-            (let* ((loop-vars (adjoin-loop-vars loop-vars def-vars))
-                   (loop-vars (match exp
-                                (($ $prompt escape? tag handler)
-                                 (match (intmap-ref cps handler)
-                                   (($ $kreceive arity kargs)
-                                    (match (intmap-ref cps kargs)
-                                      (($ $kargs names vars)
-                                       (adjoin-loop-vars loop-vars vars))))))
-                                (_ loop-vars)))
-                   (cont (build-cont
-                           ($kargs names vars
-                             ($continue k src ,exp))))
-                   (always-reached?
-                    (and always-reached?
-                         (match exp
-                           (($ $branch) #f)
-                           (_ (not (causes-effect? (intmap-ref loop-effects label)
-                                                   &type-check)))))))
-              (values cps cont loop-vars loop-effects
-                      pre-header-label always-reached?)))
-           ((trivial-intset (intmap-ref preds k))
-            (let-values
-                (((cps pre-header-label)
-                  (hoist-exp src exp def-names def-vars pre-header-label))
-                 ((cont) (build-cont
-                           ($kargs names vars
-                             ($continue k src ($values ()))))))
-              (values cps cont loop-vars (intmap-remove loop-effects label)
-                      pre-header-label always-reached?)))
-           (else
-            (let*-values
-                (((def-names def-vars)
-                  (match (intmap-ref cps k)
-                    (($ $kargs names vars) (values names vars))))
-                 ((loop-vars) (adjoin-loop-vars loop-vars def-vars))
-                 ((fresh-vars) (map (lambda (_) (fresh-var)) def-vars))
-                 ((cps pre-header-label)
-                  (hoist-exp src exp def-names fresh-vars pre-header-label))
-                 ((cont) (build-cont
-                           ($kargs names vars
-                             ($continue k src ($values fresh-vars))))))
-              (values cps cont loop-vars (intmap-remove loop-effects label)
-                      pre-header-label always-reached?)))))
-         (($ $kreceive ($ $arity req () rest) kargs)
-          (match (intmap-ref cps kargs)
+       (match term
+         (($ $continue k src exp)
+          ;; If k is a loop exit, it will be nullary.
+          (match (intmap-ref cps k)
             (($ $kargs def-names def-vars)
              (cond
               ((not (loop-invariant? label exp loop-vars loop-effects
@@ -188,33 +138,87 @@
                (let* ((loop-vars (adjoin-loop-vars loop-vars def-vars))
                       (cont (build-cont
                               ($kargs names vars
-                                ($continue k src ,exp)))))
-                 (values cps cont loop-vars loop-effects pre-header-label #f)))
+                                ($continue k src ,exp))))
+                      (always-reached?
+                       (and always-reached?
+                            (not (causes-effect? (intmap-ref loop-effects label)
+                                                 &type-check)))))
+                 (values cps cont loop-vars loop-effects
+                         pre-header-label always-reached?)))
               ((trivial-intset (intmap-ref preds k))
-               (let ((loop-effects
-                      (intmap-remove (intmap-remove loop-effects label) k)))
-                 (let-values
-                     (((cps pre-header-label)
-                       (hoist-call src exp req rest def-names def-vars
-                                   pre-header-label))
-                      ((cont) (build-cont
-                                ($kargs names vars
-                                  ($continue kargs src ($values ()))))))
-                   (values cps cont loop-vars loop-effects
-                           pre-header-label always-reached?))))
+               (let-values
+                   (((cps pre-header-label)
+                     (hoist-exp src exp def-names def-vars pre-header-label))
+                    ((cont) (build-cont
+                              ($kargs names vars
+                                ($continue k src ($values ()))))))
+                 (values cps cont loop-vars (intmap-remove loop-effects label)
+                         pre-header-label always-reached?)))
               (else
                (let*-values
-                   (((loop-vars) (adjoin-loop-vars loop-vars def-vars))
+                   (((def-names def-vars)
+                     (match (intmap-ref cps k)
+                       (($ $kargs names vars) (values names vars))))
+                    ((loop-vars) (adjoin-loop-vars loop-vars def-vars))
                     ((fresh-vars) (map (lambda (_) (fresh-var)) def-vars))
                     ((cps pre-header-label)
-                     (hoist-call src exp req rest def-names fresh-vars
-                                 pre-header-label))
+                     (hoist-exp src exp def-names fresh-vars pre-header-label))
                     ((cont) (build-cont
                               ($kargs names vars
-                                ($continue kargs src
-                                  ($values fresh-vars))))))
-                 (values cps cont loop-vars loop-effects
-                         pre-header-label always-reached?))))))))))
+                                ($continue k src ($values fresh-vars))))))
+                 (values cps cont loop-vars (intmap-remove loop-effects label)
+                         pre-header-label always-reached?)))))
+            (($ $kreceive ($ $arity req () rest) kargs)
+             (match (intmap-ref cps kargs)
+               (($ $kargs def-names def-vars)
+                (cond
+                 ((not (loop-invariant? label exp loop-vars loop-effects
+                                        always-reached?))
+                  (let* ((loop-vars (adjoin-loop-vars loop-vars def-vars))
+                         (cont (build-cont
+                                 ($kargs names vars
+                                   ($continue k src ,exp)))))
+                    (values cps cont loop-vars loop-effects pre-header-label #f)))
+                 ((trivial-intset (intmap-ref preds k))
+                  (let ((loop-effects
+                         (intmap-remove (intmap-remove loop-effects label) k)))
+                    (let-values
+                        (((cps pre-header-label)
+                          (hoist-call src exp req rest def-names def-vars
+                                      pre-header-label))
+                         ((cont) (build-cont
+                                   ($kargs names vars
+                                     ($continue kargs src ($values ()))))))
+                      (values cps cont loop-vars loop-effects
+                              pre-header-label always-reached?))))
+                 (else
+                  (let*-values
+                      (((loop-vars) (adjoin-loop-vars loop-vars def-vars))
+                       ((fresh-vars) (map (lambda (_) (fresh-var)) def-vars))
+                       ((cps pre-header-label)
+                        (hoist-call src exp req rest def-names fresh-vars
+                                    pre-header-label))
+                       ((cont) (build-cont
+                                 ($kargs names vars
+                                   ($continue kargs src
+                                     ($values fresh-vars))))))
+                    (values cps cont loop-vars loop-effects
+                            pre-header-label always-reached?)))))))))
+         ((or ($ $branch) ($ $throw))
+          (let* ((cont (build-cont ($kargs names vars ,term)))
+                 (always-reached? #f))
+            (values cps cont loop-vars loop-effects
+                    pre-header-label always-reached?)))
+         (($ $prompt k kh src escape? tag)
+          (let* ((loop-vars (match (intmap-ref cps kh)
+                              (($ $kreceive arity kargs)
+                               (match (intmap-ref cps kargs)
+                                 (($ $kargs names vars)
+                                  (adjoin-loop-vars loop-vars vars))))))
+                 (cont (build-cont ($kargs names vars ,term)))
+                 (always-reached? #f))
+            (values cps cont loop-vars loop-effects
+                    pre-header-label always-reached?))))))
     (($ $kreceive ($ $arity req () rest) kargs)
      (values cps cont loop-vars loop-effects pre-header-label
              always-reached?))))
@@ -253,9 +257,12 @@
     (define (rename-back-edges cont)
       (define (rename label) (if (eqv? label entry) header-label label))
       (rewrite-cont cont
-        (($ $kargs names vars ($ $continue kf src ($ $branch kt exp)))
+        (($ $kargs names vars ($ $branch kf kt src op param args))
+         ($kargs names vars
+           ($branch (rename kf) (rename kt) src op param args)))
+        (($ $kargs names vars ($ $prompt k kh src escape? tag))
          ($kargs names vars
-           ($continue (rename kf) src ($branch (rename kt) ,exp))))
+           ($prompt (rename k) (rename kh) src escape? tag)))
         (($ $kargs names vars ($ $continue k src exp))
          ($kargs names vars
            ($continue (rename k) src ,exp)))
diff --git a/module/language/cps/handle-interrupts.scm b/module/language/cps/loop-instrumentation.scm
index 55d25f28a..845a35a6c 100644
--- a/module/language/cps/handle-interrupts.scm
+++ b/module/language/cps/loop-instrumentation.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2016, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,12 +18,11 @@
 
 ;;; Commentary:
 ;;;
-;;; A pass to add "handle-interrupts" primcalls before calls, loop
-;;; back-edges, and returns.
+;;; A pass to add "instrument-loop" primcalls at loop headers.
 ;;;
 ;;; Code:
 
-(define-module (language cps handle-interrupts)
+(define-module (language cps loop-instrumentation)
   #:use-module (ice-9 match)
   #:use-module (language cps)
   #:use-module (language cps utils)
@@ -31,39 +30,34 @@
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
   #:use-module (language cps renumber)
-  #:export (add-handle-interrupts))
+  #:export (add-loop-instrumentation))
 
-(define (compute-safepoints cps)
-  (define (visit-cont label cont safepoints)
+(define (compute-loop-headers cps)
+  (define (maybe-add-header label k headers)
+    "Add K to headers if it is a target of a backward branch."
+    (if (<= k label)
+        (intset-add! headers k)
+        headers))
+  (define (visit-cont label cont headers)
     (match cont
-      (($ $kargs names vars ($ $continue k src exp))
-       (let ((safepoints (if (<= k label)
-                             (intset-add! safepoints k)
-                             safepoints)))
-         (if (match exp
-               (($ $call) #t)
-               (($ $callk) #t)
-               (($ $values)
-                (match (intmap-ref cps k)
-                  (($ $ktail) #t)
-                  (_ #f)))
-               (_ #f))
-             (intset-add! safepoints label)
-             safepoints)))
-      (_ safepoints)))
+      (($ $kargs names vars ($ $continue k))
+       (maybe-add-header label k headers))
+      (($ $kargs names vars ($ $branch kf kt))
+       (maybe-add-header label kf (maybe-add-header label kt headers)))
+      (_ headers)))
   (persistent-intset (intmap-fold visit-cont cps empty-intset)))
 
-(define (add-handle-interrupts cps)
-  (define (add-safepoint label cps)
+(define (add-loop-instrumentation cps)
+  (define (add-instrumentation label cps)
     (match (intmap-ref cps label)
-      (($ $kargs names vars ($ $continue k src exp))
+      (($ $kargs names vars term)
        (with-cps cps
-         (letk k* ($kargs () () ($continue k src ,exp)))
+         (letk k ($kargs () () ,term))
          (setk label
                ($kargs names vars
-                 ($continue k* src
-                   ($primcall 'handle-interrupts ()))))))))
+                 ($continue k #f
+                   ($primcall 'instrument-loop #f ()))))))))
   (let* ((cps (renumber cps))
-         (safepoints (compute-safepoints cps)))
+         (headers (compute-loop-headers cps)))
     (with-fresh-name-state cps
-      (persistent-intmap (intset-fold add-safepoint safepoints cps)))))
+      (persistent-intmap (intset-fold add-instrumentation headers cps)))))
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index 522de5124..ef73d4996 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -24,15 +24,13 @@
 
 (define-module (language cps optimize)
   #:use-module (ice-9 match)
-  #:use-module (language cps constructors)
   #:use-module (language cps contification)
   #:use-module (language cps cse)
+  #:use-module (language cps devirtualize-integers)
   #:use-module (language cps dce)
-  #:use-module (language cps elide-values)
   #:use-module (language cps licm)
   #:use-module (language cps peel-loops)
   #:use-module (language cps prune-top-level-scopes)
-  #:use-module (language cps prune-bailouts)
   #:use-module (language cps rotate-loops)
   #:use-module (language cps self-references)
   #:use-module (language cps simplify)
@@ -42,7 +40,7 @@
   #:use-module (language cps verify)
   #:export (optimize-higher-order-cps
             optimize-first-order-cps
-            cps-default-optimization-options))
+            cps-optimizations))
 
 (define (kw-arg-ref args kw default)
   (match (memq kw args)
@@ -93,9 +91,8 @@
   (prune-top-level-scopes #:prune-top-level-scopes? #t)
   (simplify #:simplify? #t)
   (contify #:contify? #t)
-  (inline-constructors #:inline-constructors? #t)
-  (elide-values #:elide-values? #t)
-  (prune-bailouts #:prune-bailouts? #t)
+  (simplify #:simplify? #t)
+  (devirtualize-integers #:devirtualize-integers? #t)
   (peel-loops #:peel-loops? #t)
   (eliminate-common-subexpressions #:cse? #t)
   (type-fold #:type-fold? #t)
@@ -106,30 +103,28 @@
 (define-optimizer optimize-first-order-cps
   (specialize-numbers #:specialize-numbers? #t)
   (hoist-loop-invariant-code #:licm? #t)
+  (specialize-primcalls #:specialize-primcalls? #t)
   (eliminate-common-subexpressions #:cse? #t)
   (eliminate-dead-code #:eliminate-dead-code? #t)
   ;; Running simplify here enables rotate-loops to do a better job.
   (simplify #:simplify? #t)
   (rotate-loops #:rotate-loops? #t)
-  (simplify #:simplify? #t)
-  (specialize-primcalls #:specialize-primcalls? #t))
+  (simplify #:simplify? #t))
 
-(define (cps-default-optimization-options)
-  (list ;; #:split-rec? #t
-   #:simplify? #t
-   #:eliminate-dead-code? #t
-   #:prune-top-level-scopes? #t
-   #:contify? #t
-   #:inline-constructors? #t
-   #:specialize-primcalls? #t
-   #:elide-values? #t
-   #:prune-bailouts? #t
-   #:peel-loops? #t
-   #:cse? #t
-   #:type-fold? #t
-   #:resolve-self-references? #t
-   #:specialize-numbers? #t
-   #:licm? #t
-   #:rotate-loops? #t
-   ;; This one is used by the slot allocator.
-   #:precolor-calls? #t))
+(define (cps-optimizations)
+  '( ;; (#:split-rec? #t)
+    (#:simplify? 2)
+    (#:eliminate-dead-code? 2)
+    (#:prune-top-level-scopes? 2)
+    (#:contify? 2)
+    (#:specialize-primcalls? 2)
+    (#:peel-loops? 2)
+    (#:cse? 2)
+    (#:type-fold? 2)
+    (#:resolve-self-references? 2)
+    (#:devirtualize-integers? 2)
+    (#:specialize-numbers? 2)
+    (#:licm? 2)
+    (#:rotate-loops? 2)
+    ;; This one is used by the slot allocator.
+    (#:precolor-calls? 2)))
diff --git a/module/language/cps/peel-loops.scm b/module/language/cps/peel-loops.scm
index a1b04a45b..b1bb39606 100644
--- a/module/language/cps/peel-loops.scm
+++ b/module/language/cps/peel-loops.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -91,6 +91,14 @@
   (persistent-intset
    (fold1 (lambda (var set) (intset-add! set var)) vars empty-intset)))
 
+(define (compute-bailouts cps labels)
+  (intset-fold (lambda (label bailouts)
+                 (match (intmap-ref cps label)
+                   (($ $kargs () () ($ $throw))
+                    (intset-add bailouts label))
+                   (_ bailouts)))
+               labels empty-intset))
+
 (define (compute-live-variables cps entry body succs)
   (let* ((succs (intset-map (lambda (label)
                               (intset-intersect (intmap-ref succs label) body))
@@ -118,13 +126,13 @@
   (let ((live (compute-live-variables cps entry body succs)))
     (intset-fold-right
      cons
-     (intmap-fold (lambda (label succs live-out)
-                    (if (intset-ref succs exit)
+     (intset-fold (lambda (label live-out)
+                    (if (intset-ref (intmap-ref succs label) exit)
                         (if live-out
                             (intset-intersect live-out (intmap-ref live label))
                             (intmap-ref live label))
                         live-out))
-                  succs #f)
+                  body #f)
      '())))
 
 (define (rename-cont cont fresh-labels fresh-vars)
@@ -134,28 +142,47 @@
     (intmap-ref fresh-vars var (lambda (var) var)))
   (define (rename-exp exp)
     (rewrite-exp exp
-      ((or ($ $const) ($ $prim) ($ $closure) ($ $rec ())) ,exp)
+      ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $rec ())) ,exp)
       (($ $values args)
        ($values ,(map rename-var args)))
       (($ $call proc args)
        ($call (rename-var proc) ,(map rename-var args)))
       (($ $callk k proc args)
-       ($callk k (rename-var proc) ,(map rename-var args)))
-      (($ $branch kt ($ $values (arg)))
-       ($branch (rename-label kt) ($values ((rename-var arg)))))
-      (($ $branch kt ($ $primcall name args))
-       ($branch (rename-label kt) ($primcall name ,(map rename-var args))))
-      (($ $primcall name args)
-       ($primcall name ,(map rename-var args)))
-      (($ $prompt escape? tag handler)
-       ($prompt escape? (rename-var tag) (rename-label handler)))))
+       ($callk k (and proc (rename-var proc)) ,(map rename-var args)))
+      (($ $primcall name param args)
+       ($primcall name param ,(map rename-var args)))))
+  (define (rename-term term)
+    (rewrite-term term
+      (($ $continue k src exp)
+       ($continue (rename-label k) src ,(rename-exp exp)))
+      (($ $branch kf kt src op param args)
+       ($branch (rename-label kf) (rename-label kt) src
+         op param ,(map rename-var args)))
+      (($ $prompt k kh src escape? tag)
+       ($prompt (rename-label k) (rename-label kh) src
+         escape? (rename-var tag)))
+      (($ $throw src op param args)
+       ($throw src op param ,(map rename-var args)))))
   (rewrite-cont cont
-    (($ $kargs names vars ($ $continue k src exp))
-     ($kargs names (map rename-var vars)
-       ($continue (rename-label k) src ,(rename-exp exp))))
+    (($ $kargs names vars term)
+     ($kargs names (map rename-var vars) ,(rename-term term)))
     (($ $kreceive ($ $arity req () rest) kargs)
      ($kreceive req rest (rename-label kargs)))))
 
+(define (add-renamed-bailout cps label new-label fresh-vars)
+  ;; We could recognize longer bailout sequences here; for now just
+  ;; single-term throws.
+  (define (rename-var var)
+    (intmap-ref fresh-vars var (lambda (var) var)))
+  ;; FIXME: Perhaps avoid copying the bailout if it doesn't use any loop
+  ;; var.
+  (match (intmap-ref cps label)
+    (($ $kargs () () ($ $throw src op param args))
+     (intmap-add cps new-label
+                 (build-cont
+                   ($kargs () ()
+                     ($throw src op param ,(map rename-var args))))))))
+
 (define (compute-var-names conts)
   (persistent-intmap
    (intmap-fold (lambda (label cont out)
@@ -167,12 +194,14 @@
                     (_ out)))
                 conts empty-intmap)))
 
-(define (peel-loop cps entry body-labels succs preds)
+(define (peel-loop cps entry body-labels succs preds bailouts)
   (let* ((body-conts (intset-map (lambda (label) (intmap-ref cps label))
                                  body-labels))
          (var-names (compute-var-names body-conts))
-         ;; All loop exits branch to this label.
-         (exit (trivial-intset (loop-successors body-labels succs)))
+         (loop-exits (loop-successors body-labels succs))
+         (loop-bailouts (intset-intersect loop-exits bailouts))
+         ;; All non-bailout loop exits branch to this label.
+         (exit (trivial-intset (intset-subtract loop-exits loop-bailouts)))
          ;; The variables that flow out of the loop, as a list.
          (out-vars (compute-out-vars cps entry body-labels succs exit))
          (out-names (map (lambda (var) (intmap-ref var-names var)) out-vars))
@@ -193,6 +222,9 @@
          (fresh-body-vars
           ;; Fresh vars for the body.
           (intmap-map (lambda (var name) (fresh-var)) var-names))
+         (fresh-body-bailout-labels
+          ;; Fresh labels for bailouts from body.
+          (intset-map (lambda (old) (fresh-label)) loop-bailouts))
          (fresh-body-entry
           ;; The name of the entry, but in the body.
           (intmap-ref fresh-body-labels entry))
@@ -200,6 +232,9 @@
           ;; Fresh names for variables that flow out of the peeled iteration.
           (fold1 (lambda (var out) (intmap-add out var (fresh-var)))
                  out-vars empty-intmap))
+         (peeled-bailout-labels
+          ;; Fresh labels for bailouts from peeled iteration.
+          (intset-map (lambda (old) (fresh-label)) loop-bailouts))
          (peeled-trampoline-label
           ;; Label for trampoline to pass values out of the peeled
           ;; iteration.
@@ -215,7 +250,10 @@
          (peeled-iteration
           ;; The peeled iteration.
           (intmap-map (lambda (label cont)
-                        (rename-cont cont peeled-labels fresh-peeled-vars))
+                        (rename-cont cont
+                                     (intmap-union peeled-labels
+                                                   peeled-bailout-labels)
+                                     fresh-peeled-vars))
                       body-conts))
          (body-trampoline-label
           ;; Label for trampoline to pass values out of the body.
@@ -225,8 +263,10 @@
           (rename-cont trampoline-cont empty-intmap fresh-body-vars))
          (fresh-body
           ;; The body, renamed.
-          (let ((label-map (intmap-add fresh-body-labels
-                                       exit body-trampoline-label)))
+          (let ((label-map (intmap-union
+                            (intmap-add fresh-body-labels
+                                        exit body-trampoline-label)
+                            fresh-body-bailout-labels)))
             (persistent-intmap
              (intmap-fold
               (lambda (label new-label out)
@@ -243,19 +283,31 @@
            (cps (intmap-fold (lambda (label cont cps)
                                (intmap-replace! cps label cont))
                              peeled-iteration cps))
+           (cps (intmap-fold
+                 (lambda (old-label new-label cps)
+                   (add-renamed-bailout cps old-label new-label
+                                        fresh-peeled-vars))
+                 peeled-bailout-labels cps))
            (cps (intmap-fold (lambda (label cont cps)
                                (intmap-add! cps label cont))
-                             fresh-body cps)))
+                             fresh-body cps))
+           (cps (intmap-fold
+                 (lambda (old-label new-label cps)
+                   (add-renamed-bailout cps old-label new-label
+                                        fresh-body-vars))
+                 fresh-body-bailout-labels cps)))
       cps)))
 
 (define (peel-loops-in-function kfun body cps)
   (let* ((succs (compute-successors cps kfun))
+         (bailouts (compute-bailouts cps body))
          (preds (invert-graph succs)))
-    ;; We can peel if there is one successor to the loop, and if the
-    ;; loop has no nested functions.  (Peeling a nested function would
-    ;; cause exponential code growth.)
+    ;; We can peel if there is one non-bailout successor to the loop,
+    ;; and if the loop has no nested functions.  (Peeling a nested
+    ;; function would cause exponential code growth.)
     (define (can-peel? body)
-      (and (trivial-intset (loop-successors body succs))
+      (and (trivial-intset (intset-subtract (loop-successors body succs)
+                                            bailouts))
            (intset-fold (lambda (label peel?)
                           (match (intmap-ref cps label)
                             (($ $kargs _ _ ($ $continue _ _ exp))
@@ -273,7 +325,7 @@
         ((find-entry scc preds)
          => (lambda (entry)
               (if (can-peel? scc)
-                  (peel-loop cps entry scc succs preds)
+                  (peel-loop cps entry scc succs preds bailouts)
                   cps)))
         (else cps)))
      (compute-strongly-connected-components succs kfun)
diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm
deleted file mode 100644
index a3e6e38e6..000000000
--- a/module/language/cps/primitives.scm
+++ /dev/null
@@ -1,141 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-;;;
-;;; Information about named primitives, as they appear in $prim and
-;;; $primcall.
-;;;
-;;; Code:
-
-(define-module (language cps primitives)
-  #:use-module (ice-9 match)
-  #:use-module ((srfi srfi-1) #:select (fold))
-  #:use-module (srfi srfi-26)
-  #:use-module (language bytecode)
-  #:export (prim-instruction
-            branching-primitive?
-            prim-arity
-            ))
-
-(define *instruction-aliases*
-  '((+ . add)
-    (- . sub)
-    (* . mul)
-    (/ . div)
-    (quotient . quo) (remainder . rem)
-    (modulo . mod)
-    (variable-ref . box-ref)
-    (variable-set! . box-set!)
-    (bytevector-length . bv-length)
-    (bytevector-u8-ref . bv-u8-ref)
-    (bytevector-u16-native-ref . bv-u16-ref)
-    (bytevector-u32-native-ref . bv-u32-ref)
-    (bytevector-u64-native-ref . bv-u64-ref)
-    (bytevector-s8-ref . bv-s8-ref)
-    (bytevector-s16-native-ref . bv-s16-ref)
-    (bytevector-s32-native-ref . bv-s32-ref)
-    (bytevector-s64-native-ref . bv-s64-ref)
-    (bytevector-ieee-single-native-ref . bv-f32-ref)
-    (bytevector-ieee-double-native-ref . bv-f64-ref)
-    (bytevector-u8-set! . bv-u8-set!)
-    (bytevector-u16-native-set! . bv-u16-set!)
-    (bytevector-u32-native-set! . bv-u32-set!)
-    (bytevector-u64-native-set! . bv-u64-set!)
-    (bytevector-s8-set! . bv-s8-set!)
-    (bytevector-s16-native-set! . bv-s16-set!)
-    (bytevector-s32-native-set! . bv-s32-set!)
-    (bytevector-s64-native-set! . bv-s64-set!)
-    (bytevector-ieee-single-native-set! . bv-f32-set!)
-    (bytevector-ieee-double-native-set! . bv-f64-set!)))
-
-(define *macro-instruction-arities*
-  '((cache-current-module! . (0 . 2))
-    (cached-toplevel-box . (1 . 3))
-    (cached-module-box . (1 . 4))))
-
-(define *branching-primcall-arities*
-  '((null? . (1 . 1))
-    (nil? . (1 . 1))
-    (pair? . (1 . 1))
-    (struct? . (1 . 1))
-    (string? . (1 . 1))
-    (vector? . (1 . 1))
-    (symbol? . (1 . 1))
-    (keyword? . (1 . 1))
-    (variable? . (1 . 1))
-    (bitvector? . (1 . 1))
-    (bytevector? . (1 . 1))
-    (char? . (1 . 1))
-    (eq? . (1 . 2))
-    (eqv? . (1 . 2))
-    (= . (1 . 2))
-    (< . (1 . 2))
-    (> . (1 . 2))
-    (<= . (1 . 2))
-    (>= . (1 . 2))
-    (u64-= . (1 . 2))
-    (u64-< . (1 . 2))
-    (u64-> . (1 . 2))
-    (u64-<= . (1 . 2))
-    (u64->= . (1 . 2))
-    (u64-<-scm . (1 . 2))
-    (u64-<=-scm . (1 . 2))
-    (u64-=-scm . (1 . 2))
-    (u64->=-scm . (1 . 2))
-    (u64->-scm . (1 . 2))
-    (logtest . (1 . 2))
-    (f64-= . (1 . 2))
-    (f64-< . (1 . 2))
-    (f64-> . (1 . 2))
-    (f64-<= . (1 . 2))
-    (f64->= . (1 . 2))))
-
-(define (compute-prim-instructions)
-  (let ((table (make-hash-table)))
-    (for-each
-     (match-lambda ((inst . _) (hashq-set! table inst inst)))
-     (instruction-list))
-    (for-each
-     (match-lambda ((prim . inst) (hashq-set! table prim inst)))
-     *instruction-aliases*)
-    (for-each
-     (match-lambda ((inst . arity) (hashq-set! table inst inst)))
-     *macro-instruction-arities*)
-    table))
-
-(define *prim-instructions* (delay (compute-prim-instructions)))
-
-;; prim -> instruction | #f
-(define (prim-instruction name)
-  (hashq-ref (force *prim-instructions*) name))
-
-(define (branching-primitive? name)
-  (and (assq name *branching-primcall-arities*) #t))
-
-(define *prim-arities* (make-hash-table))
-
-(define (prim-arity name)
-  (or (hashq-ref *prim-arities* name)
-      (let ((arity (cond
-                    ((prim-instruction name) => instruction-arity)
-                    ((assq name *branching-primcall-arities*) => cdr)
-                    (else
-                     (error "Primitive of unknown arity" name)))))
-        (hashq-set! *prim-arities* name arity)
-        arity)))
diff --git a/module/language/cps/prune-bailouts.scm b/module/language/cps/prune-bailouts.scm
deleted file mode 100644
index 7c10319e8..000000000
--- a/module/language/cps/prune-bailouts.scm
+++ /dev/null
@@ -1,86 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-;;;
-;;; A pass that prunes successors of expressions that bail out.
-;;;
-;;; Code:
-
-(define-module (language cps prune-bailouts)
-  #:use-module (ice-9 match)
-  #:use-module (language cps)
-  #:use-module (language cps utils)
-  #:use-module (language cps with-cps)
-  #:use-module (language cps intmap)
-  #:use-module (language cps intset)
-  #:export (prune-bailouts))
-
-(define (compute-tails conts)
-  "For each LABEL->CONT entry in the intmap CONTS, compute a
-LABEL->TAIL-LABEL indicating the tail continuation of each expression's
-containing function.  In some cases TAIL-LABEL might not be available,
-for example if there is a stale $kfun pointing at a body, or for
-unreferenced terms.  In that case TAIL-LABEL is either absent or #f."
-  (intmap-fold
-   (lambda (label cont out)
-     (match cont
-       (($ $kfun src meta self tail clause)
-        (intset-fold (lambda (label out)
-                       (intmap-add out label tail (lambda (old new) #f)))
-                     (compute-function-body conts label)
-                     out))
-       (_ out)))
-   conts
-   empty-intmap))
-
-(define (prune-bailout out tails k src exp)
-  (match (intmap-ref out k)
-    (($ $ktail)
-     (with-cps out #f))
-    (_
-     (match (intmap-ref tails k (lambda (_) #f))
-       (#f
-        (with-cps out #f))
-       (ktail
-        (with-cps out
-          (letv prim rest)
-          (letk kresult ($kargs ('rest) (rest)
-                          ($continue ktail src ($values ()))))
-          (letk kreceive ($kreceive '() 'rest kresult))
-          (build-term ($continue kreceive src ,exp))))))))
-
-(define (prune-bailouts conts)
-  (let ((tails (compute-tails conts)))
-    (with-fresh-name-state conts
-      (persistent-intmap
-       (intmap-fold
-        (lambda (label cont out)
-          (match cont
-            (($ $kargs names vars
-                ($ $continue k src
-                   (and exp ($ $primcall (or 'error 'scm-error 'throw)))))
-             (call-with-values (lambda () (prune-bailout out tails k src exp))
-               (lambda (out term)
-                 (if term
-                     (let ((cont (build-cont ($kargs names vars ,term))))
-                       (intmap-replace! out label cont))
-                     out))))
-            (_ out)))
-        conts
-        conts)))))
diff --git a/module/language/cps/prune-top-level-scopes.scm b/module/language/cps/prune-top-level-scopes.scm
index 1970d1bc3..56f05c613 100644
--- a/module/language/cps/prune-top-level-scopes.scm
+++ b/module/language/cps/prune-top-level-scopes.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2015, 2017 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -30,7 +30,7 @@
   #:use-module (language cps intset)
   #:export (prune-top-level-scopes))
 
-(define (compute-used-scopes conts constants)
+(define (compute-used-scopes conts)
   (persistent-intset
    (intmap-fold
     (lambda (label cont used-scopes)
@@ -38,26 +38,24 @@
         (($ $kargs _ _
             ($ $continue k src
                ($ $primcall 'cached-toplevel-box (scope name bound?))))
-         (intset-add! used-scopes (intmap-ref constants scope)))
+         (intset-add! used-scopes scope))
         (_
          used-scopes)))
     conts
     empty-intset)))
 
 (define (prune-top-level-scopes conts)
-  (let* ((constants (compute-constant-values conts))
-         (used-scopes (compute-used-scopes conts constants)))
+  (let* ((used-scopes (compute-used-scopes conts)))
     (intmap-map
      (lambda (label cont)
        (match cont
          (($ $kargs names vars
              ($ $continue k src
-                ($ $primcall 'cache-current-module!
-                   (module (? (lambda (scope)
-                                (let ((val (intmap-ref constants scope)))
-                                  (not (intset-ref used-scopes val)))))))))
-          (build-cont ($kargs names vars
-                        ($continue k src ($values ())))))
+                ($ $primcall 'cache-current-module! (scope-id) (module))))
+          (if (intset-ref used-scopes scope-id)
+              cont
+              (build-cont ($kargs names vars
+                                  ($continue k src ($values ()))))))
          (_
           cont)))
      conts)))
diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index 60be330b2..6ec90299e 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -29,24 +29,12 @@
   #:use-module (language cps)
   #:use-module (language cps utils)
   #:use-module (language cps with-cps)
-  #:use-module (language cps primitives)
   #:use-module (language cps intmap)
   #:use-module (language bytecode)
+  #:use-module (system base target)
+  #:use-module (system base types internal)
   #:export (reify-primitives))
 
-(define (module-box cps src module name public? bound? val-proc)
-  (with-cps cps
-    (letv box)
-    (let$ body (val-proc box))
-    (letk kbox ($kargs ('box) (box) ,body))
-    ($ (with-cps-constants ((module module)
-                            (name name)
-                            (public? public?)
-                            (bound? bound?))
-         (build-term ($continue kbox src
-                       ($primcall 'cached-module-box
-                                  (module name public? bound?))))))))
-
 (define (primitive-module name)
   (case name
     ((bytevector?
@@ -91,31 +79,25 @@
     (else '(guile))))
 
 (define (primitive-ref cps name k src)
-  (module-box cps src (primitive-module name) name #f #t
-              (lambda (cps box)
-                (with-cps cps
-                  (build-term
-                    ($continue k src ($primcall 'box-ref (box))))))))
+  (with-cps cps
+    (letv box)
+    (letk kbox ($kargs ('box) (box)
+                 ($continue k src
+                   ($primcall 'scm-ref/immediate '(box . 1) (box)))))
+    ($ ((hashq-ref *ephemeral-reifiers* 'cached-module-box)
+        kbox src (list (primitive-module name) name #f #t) '()))))
 
 (define (builtin-ref cps idx k src)
   (with-cps cps
-    ($ (with-cps-constants ((idx idx))
-         (build-term
-           ($continue k src ($primcall 'builtin-ref (idx))))))))
+    (build-term
+      ($continue k src ($primcall 'builtin-ref idx ())))))
 
-(define (reify-clause cps ktail)
+(define (reify-clause cps)
   (with-cps cps
-    (letv throw)
-    (let$ throw-body
+    (let$ body
           (with-cps-constants ((wna 'wrong-number-of-args)
-                               (false #f)
-                               (str "Wrong number of arguments")
-                               (eol '()))
-            (build-term
-              ($continue ktail #f
-                ($call throw (wna false str eol false))))))
-    (letk kthrow ($kargs ('throw) (throw) ,throw-body))
-    (let$ body (primitive-ref 'throw kthrow #f))
+                               (args '(#f "Wrong number of arguments" () #f)))
+            (build-term ($throw #f 'throw #f (wna args)))))
     (letk kbody ($kargs () () ,body))
     (letk kclause ($kclause ('() '() #f '() #f) kbody #f))
     kclause))
@@ -130,6 +112,241 @@
     (_
      (with-cps cps k))))
 
+(define (wrap-unary cps k src wrap unwrap op param a)
+  (with-cps cps
+    (letv a* res*)
+    (letk kres ($kargs ('res*) (res*)
+                 ($continue k src
+                   ($primcall 'u64->s64 #f (res*)))))
+    (letk ka ($kargs ('a*) (a*)
+               ($continue kres src
+                 ($primcall op param (a*)))))
+    (build-term
+      ($continue ka src
+        ($primcall 's64->u64 #f (a))))))
+
+(define (wrap-binary cps k src wrap unwrap op param a b)
+  (with-cps cps
+    (letv a* b* res*)
+    (letk kres ($kargs ('res*) (res*)
+                 ($continue k src
+                   ($primcall 'u64->s64 #f (res*)))))
+    (letk kb ($kargs ('b*) (b*)
+               ($continue kres src
+                 ($primcall op param (a* b*)))))
+    (letk ka ($kargs ('a*) (a*)
+               ($continue kb src
+                 ($primcall 's64->u64 #f (b)))))
+    (build-term
+      ($continue ka src
+        ($primcall 's64->u64 #f (a))))))
+
+(define (wrap-binary/exp cps k src wrap unwrap op param a b-exp)
+  (with-cps cps
+    (letv a* b* res*)
+    (letk kres ($kargs ('res*) (res*)
+                 ($continue k src
+                   ($primcall 'u64->s64 #f (res*)))))
+    (letk kb ($kargs ('b*) (b*)
+               ($continue kres src
+                 ($primcall op param (a* b*)))))
+    (letk ka ($kargs ('a*) (a*)
+               ($continue kb src ,b-exp)))
+    (build-term
+      ($continue ka src
+        ($primcall 's64->u64 #f (a))))))
+
+;; Primitives that we need to remove.
+(define *ephemeral-reifiers* (make-hash-table))
+
+(define-syntax-rule (define-ephemeral (name cps k src param arg ...)
+                      . body)
+  (hashq-set! *ephemeral-reifiers* 'name
+              (lambda (cps k src param args)
+                (match args ((arg ...) (let () . body))))))
+
+(define-ephemeral (fadd/immediate cps k src param a)
+  (with-cps cps
+    (letv b)
+    (letk kb ($kargs ('b) (b)
+               ($continue k src
+                 ($primcall 'fadd #f (a b)))))
+    (build-term
+      ($continue kb src
+        ($primcall 'load-f64 param ())))))
+
+(define-syntax-rule (define-binary-signed-ephemeral name uname)
+  (define-ephemeral (name cps k src param a b)
+    (wrap-binary cps k src 's64->u64 'u64->s64 'uname #f a b)))
+(define-binary-signed-ephemeral sadd uadd)
+(define-binary-signed-ephemeral ssub usub)
+(define-binary-signed-ephemeral smul umul)
+
+(define-syntax-rule (define-binary-signed-ephemeral/imm name/imm
+                      uname/imm uname)
+  (define-ephemeral (name/imm cps k src param a)
+    (if (and (exact-integer? param) (<= 0 param 255))
+        (wrap-unary cps k src 's64->u64 'u64->s64 'uname/imm param a)
+        (wrap-binary/exp cps k src 's64->u64 'u64->s64 'uname #f a
+                         (let ((param (logand param (1- (ash 1 64)))))
+                           (build-exp ($primcall 'load-u64 param ())))))))
+(define-binary-signed-ephemeral/imm sadd/immediate uadd/immediate uadd)
+(define-binary-signed-ephemeral/imm ssub/immediate usub/immediate usub)
+(define-binary-signed-ephemeral/imm smul/immediate umul/immediate umul)
+
+(define-ephemeral (slsh cps k src param a b)
+  (wrap-binary/exp cps k src 's64->u64 'u64->s64 'ulsh #f a
+                   (build-exp ($values (b)))))
+(define-ephemeral (slsh/immediate cps k src param a)
+  (wrap-unary cps k src 's64->u64 'u64->s64 'ulsh/immediate param a))
+
+(define (reify-lookup cps src mod-var name assert-bound? have-var)
+  (define (%lookup cps kbad k src mod-var name-var var assert-bound?)
+    (if assert-bound?
+        (with-cps cps
+          (letv val)
+          (letk kcheck
+                ($kargs ('val) (val)
+                  ($branch k kbad src 'undefined? #f (val))))
+          (letk kref
+                ($kargs () ()
+                  ($continue kcheck src
+                    ($primcall 'scm-ref/immediate '(box . 1) (var)))))
+          ($ (%lookup kbad kref src mod-var name-var var #f)))
+        (with-cps cps
+          (letk kres
+                ($kargs ('var) (var)
+                  ($branch kbad k src 'heap-object? #f (var))))
+          (build-term
+            ($continue kres src
+              ($primcall 'lookup #f (mod-var name-var)))))))
+  (define %unbound
+    #(unbound-variable #f "Unbound variable: ~S"))
+  (with-cps cps
+    (letv name-var var)
+    (let$ good (have-var var))
+    (letk kgood ($kargs () () ,good))
+    (letk kbad ($kargs () () ($throw src 'throw/value %unbound (name-var))))
+    (let$ body (%lookup kbad kgood src mod-var name-var var assert-bound?))
+    (letk klookup ($kargs ('name) (name-var) ,body))
+    (build-term ($continue klookup src ($const name)))))
+
+(define (reify-resolve-module cps k src module public?)
+  (with-cps cps
+    (letv mod-name)
+    (letk kresolve
+          ($kargs ('mod-name) (mod-name)
+            ($continue k src
+              ($primcall 'resolve-module public? (mod-name)))))
+    (build-term
+      ($continue kresolve src ($const module)))))
+
+(define-ephemeral (cached-module-box cps k src param)
+  (match param
+    ((module name public? bound?)
+     (let ((cache-key (cons module name)))
+       (with-cps cps
+         (letv mod cached)
+         (let$ lookup
+               (reify-lookup
+                src mod name bound?
+                (lambda (cps var)
+                  (with-cps cps
+                    (letk k* ($kargs () () ($continue k src ($values (var)))))
+                    (build-term
+                      ($continue k* src
+                        ($primcall 'cache-set! cache-key (var))))))))
+         (letk kmod ($kargs ('mod) (mod) ,lookup))
+         (let$ module (reify-resolve-module kmod src module public?))
+         (letk kinit ($kargs () () ,module))
+         (letk kok ($kargs () () ($continue k src ($values (cached)))))
+         (letk ktest
+               ($kargs ('cached) (cached)
+                 ($branch kinit kok src 'heap-object? #f (cached))))
+         (build-term
+           ($continue ktest src
+             ($primcall 'cache-ref cache-key ()))))))))
+
+(define-ephemeral (cache-current-module! cps k src param mod)
+  (match param
+    ((scope)
+     (with-cps cps
+       (build-term
+         ($continue k src
+           ($primcall 'cache-set! scope (mod))))))))
+
+(define-ephemeral (cached-toplevel-box cps k src param)
+  (match param
+    ((scope name bound?)
+     (let ((cache-key (cons scope name)))
+       (with-cps cps
+         (letv mod cached)
+         (let$ lookup
+               (reify-lookup
+                src mod name bound?
+                (lambda (cps var)
+                  (with-cps cps
+                    (letk k* ($kargs () () ($continue k src ($values (var)))))
+                    (build-term
+                      ($continue k* src
+                        ($primcall 'cache-set! cache-key (var))))))))
+         (letk kmod ($kargs ('mod) (mod) ,lookup))
+         (letk kinit ($kargs () ()
+                       ($continue kmod src ($primcall 'cache-ref scope ()))))
+         (letk kok ($kargs () () ($continue k src ($values (cached)))))
+         (letk ktest
+               ($kargs ('cached) (cached)
+                 ($branch kinit kok src 'heap-object? #f (cached))))
+         (build-term
+           ($continue ktest src
+             ($primcall 'cache-ref cache-key ()))))))))
+
+;; FIXME: Instead of having to check this, instead every primcall that's
+;; not ephemeral should be handled by compile-bytecode.
+(define (compute-known-primitives)
+  (define *macro-instructions*
+    '(add
+      add/immediate
+      sub
+      sub/immediate
+      mul
+      div
+      quo
+      rem
+      mod
+      logand
+      logior
+      logxor
+      logsub
+      string-set!
+      string->number
+      string->symbol
+      symbol->keyword
+      class-of
+      scm->f64
+      s64->u64 s64->scm scm->s64
+      u64->s64 u64->scm scm->u64 scm->u64/truncate
+      wind unwind
+      push-fluid pop-fluid fluid-ref fluid-set!
+      push-dynamic-state pop-dynamic-state
+      lsh rsh lsh/immediate rsh/immediate
+      cache-ref cache-set!
+      resolve-module lookup define! current-module))
+  (let ((table (make-hash-table)))
+    (for-each
+     (match-lambda ((inst . _) (hashq-set! table inst #t)))
+     (instruction-list))
+    (for-each
+     (lambda (prim) (hashq-set! table prim #t))
+     *macro-instructions*)
+    table))
+
+(define *known-primitives* (delay (compute-known-primitives)))
+
+(define (known-primitive? name)
+  "Is @var{name} a primitive that can be lowered to bytecode?"
+  (hashq-ref (force *known-primitives*) name))
+
 (define (reify-primitives cps)
   (define (visit-cont label cont cps)
     (define (resolve-prim cps name k src)
@@ -141,28 +358,223 @@
     (match cont
       (($ $kfun src meta self tail #f)
        (with-cps cps
-         (let$ clause (reify-clause tail))
+         (let$ clause (reify-clause))
          (setk label ($kfun src meta self tail clause))))
       (($ $kargs names vars ($ $continue k src ($ $prim name)))
        (with-cps cps
-         (let$ k (uniquify-receive k))
          (let$ body (resolve-prim name k src))
          (setk label ($kargs names vars ,body))))
       (($ $kargs names vars
-          ($ $continue k src ($ $primcall 'call-thunk/no-inline (proc))))
+          ($ $continue k src ($ $primcall 'call-thunk/no-inline #f (proc))))
        (with-cps cps
          (setk label ($kargs names vars ($continue k src ($call proc ()))))))
-      (($ $kargs names vars ($ $continue k src ($ $primcall name args)))
-       (if (or (prim-instruction name) (branching-primitive? name))
-           ;; Assume arities are correct.
-           cps
-           (with-cps cps
-             (letv proc)
-             (let$ k (uniquify-receive k))
-             (letk kproc ($kargs ('proc) (proc)
-                           ($continue k src ($call proc args))))
-             (let$ body (resolve-prim name kproc src))
-             (setk label ($kargs names vars ,body)))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 'f64->scm #f (f64))))
+       (with-cps cps
+         (letv scm tag ptr uidx)
+         (letk kdone ($kargs () ()
+                       ($continue k src ($values (scm)))))
+         (letk kinit ($kargs ('uidx) (uidx)
+                       ($continue kdone src
+                         ($primcall 'f64-set! 'flonum (scm ptr uidx f64)))))
+         (letk kidx ($kargs ('ptr) (ptr)
+                      ($continue kinit src ($primcall 'load-u64 0 ()))))
+         (letk kptr ($kargs () ()
+                      ($continue kidx src
+                        ($primcall 'tail-pointer-ref/immediate
+                                   `(flonum . ,(match (target-word-size)
+                                                 (4 2)
+                                                 (8 1)))
+                                   (scm)))))
+         (letk ktag1 ($kargs ('tag) (tag)
+                       ($continue kptr src
+                         ($primcall 'word-set!/immediate '(flonum . 0) (scm tag)))))
+         (letk ktag0 ($kargs ('scm) (scm)
+                      ($continue ktag1 src
+                        ($primcall 'load-u64 %tc16-flonum ()))))
+         (setk label ($kargs names vars
+                       ($continue ktag0 src
+                         ($primcall 'allocate-words/immediate
+                                    `(flonum . ,(match (target-word-size)
+                                                  (4 4)
+                                                  (8 2)))
+                                    ()))))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 'u64->scm/unlikely #f (u64))))
+       (with-cps cps
+         (setk label ($kargs names vars
+                       ($continue k src ($primcall 'u64->scm #f (u64)))))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 's64->scm/unlikely #f (s64))))
+       (with-cps cps
+         (setk label ($kargs names vars
+                       ($continue k src ($primcall 's64->scm #f (s64)))))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 'tag-fixnum/unlikely #f (s64))))
+       (with-cps cps
+         (setk label ($kargs names vars
+                       ($continue k src ($primcall 'tag-fixnum #f (s64)))))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 'load-const/unlikely val ())))
+       (with-cps cps
+         (setk label ($kargs names vars ($continue k src ($const val))))))
+      (($ $kargs names vars
+          ($ $continue k src ($ $primcall 'mul/immediate b (a))))
+       (with-cps cps
+         (letv b*)
+         (letk kb ($kargs ('b) (b*)
+                    ($continue k src ($primcall 'mul #f (a b*)))))
+         (setk label ($kargs names vars
+                       ($continue kb src ($const b))))))
+      (($ $kargs names vars
+          ($ $continue k src
+             ($ $primcall (or 'assume-u64 'assume-s64) (lo . hi) (val))))
+       (with-cps cps
+         (setk label ($kargs names vars
+                       ($continue k src ($values (val)))))))
+      (($ $kargs names vars ($ $continue k src ($ $primcall name param args)))
+       (cond
+        ((hashq-ref *ephemeral-reifiers* name)
+         => (lambda (reify)
+              (with-cps cps
+                (let$ body (reify k src param args))
+                (setk label ($kargs names vars ,body)))))
+        ((known-primitive? name)
+         ;; Assume arities are correct.
+         (let ()
+           (define (u6? val) (and (exact-integer? val) (<= 0 val 63)))
+           (define (u8? val) (and (exact-integer? val) (<= 0 val 255)))
+           (define-syntax-rule (reify-constants
+                                wrap
+                                ((op (pred? c) in ...) (op* out ...))
+                                ...
+                                (_ default))
+             (match name
+               ('op
+                (if (pred? param)
+                    cps
+                    (match args
+                      ((in ...)
+                       (with-cps cps
+                         (letv c)
+                         (letk kconst ($kargs ('c) (c)
+                                        ($continue k src
+                                          ($primcall 'op* #f (out ...)))))
+                         (setk label
+                               ($kargs names vars
+                                 ($continue kconst src wrap))))))))
+               ...
+               (_ default)))
+           (define-syntax-rule (reify-scm-constants clause ...)
+             (reify-constants ($const param) clause ...))
+           (define-syntax-rule (reify-u64-constants clause ...)
+             (reify-constants ($primcall 'load-u64 param ()) clause ...))
+           (reify-scm-constants
+            ((add/immediate (u8? y) x) (add x y))
+            ((sub/immediate (u8? y) x) (sub x y))
+            (_
+             (reify-u64-constants
+              ((uadd/immediate (u8? y) x) (uadd x y))
+              ((usub/immediate (u8? y) x) (usub x y))
+              ((umul/immediate (u8? y) x) (umul x y))
+              ((rsh/immediate (u6? y) x) (rsh x y))
+              ((lsh/immediate (u6? y) x) (lsh x y))
+              ;; These should all be u6's by construction.
+              ;; ((ursh/immediate (u6? y) x) (ursh x y))
+              ;; ((srsh/immediate (u6? y) x) (srsh x y))
+              ;; ((ulsh/immediate (u6? y) x) (ulsh x y))
+              (_
+               (match (cons name args)
+                 (('allocate-words/immediate)
+                  (match param
+                    ((ann . n)
+                     (if (u8? n)
+                         cps
+                         (with-cps cps
+                           (letv n*)
+                           (letk kop ($kargs ('n) (n*)
+                                       ($continue k src
+                                         ($primcall 'allocate-words ann (n*)))))
+                           (setk label ($kargs names vars
+                                         ($continue kop src
+                                           ($primcall 'load-u64 n ())))))))))
+                 ;; Assume (tail-)pointer-ref/immediate is within u8 range.
+                 (((or 'word-ref/immediate 'scm-ref/immediate) obj)
+                  (match param
+                    ((ann . idx)
+                     (if (u8? idx)
+                         cps
+                         (let ((op (match name
+                                     ('word-ref/immediate 'word-ref)
+                                     ('scm-ref/immediate 'scm-ref))))
+                           (with-cps cps
+                             (letv idx*)
+                             (letk kop ($kargs ('idx) (idx*)
+                                         ($continue k src
+                                           ($primcall op ann (obj idx*)))))
+                             (setk label ($kargs names vars
+                                           ($continue kop src
+                                             ($primcall 'load-u64 idx ()))))))))))
+                 (((or 'word-set!/immediate 'scm-set!/immediate) obj val)
+                  (match param
+                    ((ann . idx)
+                     (if (u8? idx)
+                         cps
+                         (let ((op (match name
+                                     ('word-set!/immediate 'word-set!)
+                                     ('scm-set!/immediate 'scm-set!))))
+                           (with-cps cps
+                             (letv idx*)
+                             (letk kop ($kargs ('idx) (idx*)
+                                         ($continue k src
+                                           ($primcall op ann (obj idx* val)))))
+                             (setk label ($kargs names vars
+                                           ($continue kop src
+                                             ($primcall 'load-u64 idx ()))))))))))
+                 (_ cps))))))))
+        (param (error "unexpected param to reified primcall" name))
+        (else
+         (with-cps cps
+           (letv proc)
+           (letk krecv ($kreceive '(res) #f k))
+           (letk kproc ($kargs ('proc) (proc)
+                         ($continue krecv src ($call proc args))))
+           (let$ body (resolve-prim name kproc src))
+           (setk label ($kargs names vars ,body))))))
+      (($ $kargs names vars ($ $branch kf kt src name param args))
+       (let ()
+         (define (u11? val) (<= 0 val #x7ff))
+         (define (u12? val) (<= 0 val #xfff))
+         (define (s12? val) (<= (- #x800) val #x7ff))
+         (define-syntax-rule (reify-constants ((op (pred? c) in ...)
+                                               wrap-op (op* out ...))
+                                              ...
+                                              (_ default))
+           (match name
+             ('op
+              (if (pred? param)
+                  cps
+                  (match args
+                    ((in ...)
+                     (with-cps cps
+                       (letv c)
+                       (letk kconst
+                             ($kargs ('c) (c)
+                               ($branch kf kt src 'op* #f (out ...))))
+                       (setk label
+                             ($kargs names vars
+                               ($continue kconst src
+                                 ($primcall 'wrap-op param ())))))))))
+             ...
+             (_ default)))
+         (reify-constants
+          ((u64-imm-= (u11? b) a) load-u64 (u64-= a b))
+          ((u64-imm-< (u12? b) a) load-u64 (u64-< a b))
+          ((imm-u64-< (u12? a) b) load-u64 (u64-< a b))
+          ((s64-imm-= (s12? b) a) load-s64 (s64-= a b))
+          ((s64-imm-< (s12? b) a) load-s64 (s64-< a b))
+          ((imm-s64-< (s12? a) b) load-s64 (s64-< a b))
+          (_ cps))))
       (($ $kargs names vars ($ $continue k src ($ $call proc args)))
        (with-cps cps
          (let$ k (uniquify-receive k))
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index 8bab8634d..7200a5fcf 100644
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -85,16 +85,18 @@
             (call-with-values
                 (lambda ()
                   (match (intmap-ref conts k)
-                    (($ $kargs names syms ($ $continue k src exp))
-                     (match exp
-                       (($ $prompt escape? tag handler)
-                        (visit2 k handler order visited))
-                       (($ $branch kt)
-                        (if (visit-kf-first? k kt)
-                            (visit2 k kt order visited)
-                            (visit2 kt k order visited)))
-                       (_
-                        (visit k order visited))))
+                    (($ $kargs names syms term)
+                     (match term
+                       (($ $continue k)
+                        (visit k order visited))
+                       (($ $branch kf kt)
+                        (if (visit-kf-first? kf kt)
+                            (visit2 kf kt order visited)
+                            (visit2 kt kf order visited)))
+                       (($ $prompt k kh)
+                        (visit2 k kh order visited))
+                       (($ $throw)
+                        (values order visited))))
                     (($ $kreceive arity k) (visit k order visited))
                     (($ $kclause arity kbody kalt)
                      (if kalt
@@ -125,7 +127,7 @@
             (match (intmap-ref conts label)
               (($ $kargs names syms exp)
                (fold1 rename-var syms vars))
-              (($ $kfun src meta self tail clause)
+              (($ $kfun src meta (and self (not #f)) tail clause)
                (rename-var self vars))
               (_ vars))))
   (define (maybe-visit-fun kfun labels vars)
@@ -139,12 +141,14 @@
       (($ $kargs names syms ($ $continue k src ($ $rec names* syms*
                                                   (($ $fun kfun) ...))))
        (fold2 visit-fun kfun labels vars))
-      (($ $kargs names syms ($ $continue k src ($ $closure kfun nfree)))
+      (($ $kargs names syms ($ $continue k src ($ $const-fun kfun)))
        ;; Closures with zero free vars get copy-propagated so it's
        ;; possible to already have visited them.
        (maybe-visit-fun kfun labels vars))
+      (($ $kargs names syms ($ $continue k src ($ $code kfun)))
+       (maybe-visit-fun kfun labels vars))
       (($ $kargs names syms ($ $continue k src ($ $callk kfun)))
-       ;; Well-known functions never have a $closure created for them
+       ;; Well-known functions never have a $const-fun created for them
        ;; and are only referenced by their $callk call sites.
        (maybe-visit-fun kfun labels vars))
       (_ (values labels vars))))
@@ -165,8 +169,10 @@
     (define (rename-exp exp)
       (rewrite-exp exp
         ((or ($ $const) ($ $prim)) ,exp)
-        (($ $closure k nfree)
-         ($closure (rename-label k) nfree))
+        (($ $const-fun k)
+         ($const-fun (rename-label k)))
+        (($ $code k)
+         ($code (rename-label k)))
         (($ $fun body)
          ($fun (rename-label body)))
         (($ $rec names vars funs)
@@ -176,13 +182,10 @@
         (($ $call proc args)
          ($call (rename-var proc) ,(map rename-var args)))
         (($ $callk k proc args)
-         ($callk (rename-label k) (rename-var proc) ,(map rename-var args)))
-        (($ $branch kt exp)
-         ($branch (rename-label kt) ,(rename-exp exp)))
-        (($ $primcall name args)
-         ($primcall name ,(map rename-var args)))
-        (($ $prompt escape? tag handler)
-         ($prompt escape? (rename-var tag) (rename-label handler)))))
+         ($callk (rename-label k) (and proc (rename-var proc))
+                 ,(map rename-var args)))
+        (($ $primcall name param args)
+         ($primcall name param ,(map rename-var args)))))
     (define (rename-arity arity)
       (match arity
         (($ $arity req opt rest () aok?)
@@ -200,18 +203,28 @@
          out
          new-k
          (rewrite-cont (intmap-ref conts old-k)
-                       (($ $kargs names syms ($ $continue k src exp))
-                        ($kargs names (map rename-var syms)
-                          ($continue (rename-label k) src ,(rename-exp exp))))
-                       (($ $kreceive ($ $arity req () rest () #f) k)
-                        ($kreceive req rest (rename-label k)))
-                       (($ $ktail)
-                        ($ktail))
-                       (($ $kfun src meta self tail clause)
-                        ($kfun src meta (rename-var self) (rename-label tail)
-                          (and clause (rename-label clause))))
-                       (($ $kclause arity body alternate)
-                        ($kclause ,(rename-arity arity) (rename-label body)
-                                  (and alternate (rename-label alternate)))))))
+           (($ $kargs names syms term)
+            ($kargs names (map rename-var syms)
+              ,(rewrite-term term
+                 (($ $continue k src exp)
+                  ($continue (rename-label k) src ,(rename-exp exp)))
+                 (($ $branch kf kt src op param args)
+                  ($branch (rename-label kf) (rename-label kt) src
+                    op param ,(map rename-var args)))
+                 (($ $prompt k kh src escape? tag)
+                  ($prompt (rename-label k) (rename-label kh) src
+                    escape? (rename-var tag)))
+                 (($ $throw src op param args)
+                  ($throw src op param ,(map rename-var args))))))
+           (($ $kreceive ($ $arity req () rest () #f) k)
+            ($kreceive req rest (rename-label k)))
+           (($ $ktail)
+            ($ktail))
+           (($ $kfun src meta self tail clause)
+            ($kfun src meta (and self (rename-var self)) (rename-label tail)
+              (and clause (rename-label clause))))
+           (($ $kclause arity body alternate)
+            ($kclause ,(rename-arity arity) (rename-label body)
+                      (and alternate (rename-label alternate)))))))
       label-map
       empty-intmap))))
diff --git a/module/language/cps/rotate-loops.scm b/module/language/cps/rotate-loops.scm
index 09c133227..d80a2723b 100644
--- a/module/language/cps/rotate-loops.scm
+++ b/module/language/cps/rotate-loops.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -55,6 +55,7 @@
   #:use-module (language cps utils)
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
+  #:use-module (language cps with-cps)
   #:export (rotate-loops))
 
 (define (loop-successors scc succs)
@@ -79,7 +80,8 @@
   (match (intmap-ref cps entry-label)
     ((and entry-cont
           ($ $kargs entry-names entry-vars
-             ($ $continue entry-kf entry-src ($ $branch entry-kt entry-exp))))
+             ($ $branch entry-kf entry-kt entry-src
+                entry-op entry-param entry-args)))
      (let* ((exit-if-true? (intset-ref body-labels entry-kf))
             (loop-exits (find-exits body-labels succs))
             (exit (if exit-if-true? entry-kt entry-kf))
@@ -93,51 +95,52 @@
          (map (lambda (_) (fresh-var)) entry-vars))
        (define (make-trampoline k src values)
          (build-cont ($kargs () () ($continue k src ($values values)))))
-       (define (replace-exit k trampoline)
-         (if (eqv? k exit) trampoline k))
-       (define (rename-exp exp vars)
-         (define (rename-var var)
-           (match (list-index entry-vars var)
-             (#f var)
-             (idx (list-ref vars idx))))
-         (rewrite-exp exp
-           ((or ($ $const) ($ $prim) ($ $closure)) ,exp)
-           (($ $values args)
-            ($values ,(map rename-var args)))
-           (($ $call proc args)
-            ($call (rename-var proc) ,(map rename-var args)))
-           (($ $callk k proc args)
-            ($callk k (rename-var proc) ,(map rename-var args)))
-           (($ $branch kt ($ $values (arg)))
-            ($branch kt ($values ((rename-var arg)))))
-           (($ $branch kt ($ $primcall name args))
-            ($branch kt ($primcall name ,(map rename-var args))))
-           (($ $primcall name args)
-            ($primcall name ,(map rename-var args)))
-           (($ $prompt escape? tag handler)
-            ($prompt escape? (rename-var tag) handler))))
-       (define (attach-trampoline label src names vars args)
-         (let* ((trampoline-out-label (fresh-label))
-                (trampoline-out-cont
-                 (make-trampoline join-label src args))
-                (trampoline-in-label (fresh-label))
-                (trampoline-in-cont
-                 (make-trampoline new-entry-label src args))
-                (kf (if exit-if-true? trampoline-in-label trampoline-out-label))
-                (kt (if exit-if-true? trampoline-out-label trampoline-in-label))
-                (cont (build-cont
-                        ($kargs names vars
-                          ($continue kf entry-src
-                            ($branch kt ,(rename-exp entry-exp args))))))
-                (cps (intmap-replace! cps label cont))
-                (cps (intmap-add! cps trampoline-in-label trampoline-in-cont)))
-           (intmap-add! cps trampoline-out-label trampoline-out-cont)))
+       (define (rename-var var replacements)
+         "If VAR refers to a member of ENTRY-VARS, replace with a
+corresponding var from REPLACEMENTS; otherwise return VAR."
+         (match (list-index entry-vars var)
+           (#f var)
+           (idx (list-ref replacements idx))))
+       (define (rename-vars vars replacements)
+         (map (lambda (var) (rename-var var replacements)) vars))
+       (define (rename-term term replacements)
+         (define (rename arg) (rename-var arg replacements))
+         (define (rename* arg) (rename-vars arg replacements))
+         (rewrite-term term
+           (($ $continue k src exp)
+            ($continue k src
+              ,(rewrite-exp exp
+                 ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) ,exp)
+                 (($ $values args)
+                  ($values ,(rename* args)))
+                 (($ $call proc args)
+                  ($call (rename proc) ,(rename* args)))
+                 (($ $callk k proc args)
+                  ($callk k (and proc (rename proc)) ,(rename* args)))
+                 (($ $primcall name param args)
+                  ($primcall name param ,(rename* args))))))
+           (($ $branch kf kt src op param args)
+            ($branch kf kt src op param ,(rename* args)))
+           (($ $prompt k kh src escape? tag)
+            ($prompt k kh src escape? (rename tag)))
+           (($ $throw src op param args)
+            ($throw src op param ,(rename* args)))))
+       (define (attach-trampoline cps label src names vars args)
+         (with-cps cps
+           (letk ktramp-out ,(make-trampoline join-label src args))
+           (letk ktramp-in ,(make-trampoline new-entry-label src args))
+           (setk label
+                 ($kargs names vars
+                   ($branch (if exit-if-true? ktramp-in ktramp-out)
+                            (if exit-if-true? ktramp-out ktramp-in)
+                            entry-src
+                     entry-op entry-param ,(rename-vars entry-args args))))))
        ;; Rewrite the targets of the entry branch to go to
        ;; trampolines.  One will pass values out of the loop, and
        ;; one will pass values into the loop.
        (let* ((pre-header-vars (make-fresh-vars))
               (body-vars (make-fresh-vars))
-              (cps (attach-trampoline entry-label entry-src
+              (cps (attach-trampoline cps entry-label entry-src
                                       entry-names pre-header-vars
                                       pre-header-vars))
               (new-entry-cont (build-cont
@@ -150,44 +153,38 @@
             (cond
              ((intset-ref back-edges label)
               (match (intmap-ref cps label)
-                (($ $kargs names vars ($ $continue _ src exp))
-                 (match (rename-exp exp body-vars)
-                   (($ $values args)
-                    (attach-trampoline label src names vars args))
-                   (exp
+                (($ $kargs names vars term)
+                 (match (rename-term term body-vars)
+                   (($ $continue _ src ($ $values args))
+                    (attach-trampoline cps label src names vars args))
+                   (($ $continue _ src exp)
                     (let* ((args (make-fresh-vars))
                            (bind-label (fresh-label))
                            (edge* (build-cont
                                     ($kargs names vars
                                       ($continue bind-label src ,exp))))
                            (cps (intmap-replace! cps label edge*))
-                           ;; attach-trampoline uses intmap-replace!.
+                           ;; attach-trampoline uses setk.
                            (cps (intmap-add! cps bind-label #f)))
-                      (attach-trampoline bind-label src
+                      (attach-trampoline cps bind-label src
                                          entry-names args args)))))))
              ((intset-ref loop-exits label)
               (match (intmap-ref cps label)
-                (($ $kargs names vars
-                    ($ $continue kf src ($ $branch kt exp)))
-                 (let* ((trampoline-out-label (fresh-label))
-                        (trampoline-out-cont
-                         (make-trampoline join-label src body-vars))
-                        (kf (if (eqv? kf exit) trampoline-out-label kf))
-                        (kt (if (eqv? kt exit) trampoline-out-label kt))
-                        (cont (build-cont
-                                ($kargs names vars
-                                  ($continue kf src
-                                    ($branch kt ,(rename-exp exp body-vars))))))
-                        (cps (intmap-replace! cps label cont)))
-                   (intmap-add! cps trampoline-out-label trampoline-out-cont)))))
+                (($ $kargs names vars ($ $branch kf kt src op param args))
+                 (with-cps cps
+                   (letk ktramp-out ,(make-trampoline join-label src body-vars))
+                   (setk label
+                         ($kargs names vars
+                           ($branch (if (eqv? kf exit) ktramp-out kf)
+                                    (if (eqv? kt exit) ktramp-out kt)
+                                    src
+                             op param ,(rename-vars args body-vars))))))))
              (else
               (match (intmap-ref cps label)
-                (($ $kargs names vars ($ $continue k src exp))
-                 (let ((cont (build-cont
-                               ($kargs names vars
-                                 ($continue k src
-                                   ,(rename-exp exp body-vars))))))
-                   (intmap-replace! cps label cont)))
+                (($ $kargs names vars term)
+                 (with-cps cps
+                   (setk label ($kargs names vars
+                                 ,(rename-term term body-vars)))))
                 (($ $kreceive) cps)))))
           (intset-remove body-labels entry-label)
           cps))))))
@@ -197,10 +194,8 @@
     (intset-fold (lambda (label rotate?)
                    (match (intmap-ref cps label)
                      (($ $kreceive) #f)
-                     (($ $kargs _ _ ($ $continue _ _ exp))
-                      (match exp
-                        (($ $branch) #f)
-                        (_ rotate?)))))
+                     (($ $kargs _ _ ($ $branch)) #f)
+                     (($ $kargs _ _ ($ $continue)) rotate?)))
                  edges #t))
   (let* ((succs (compute-successors cps kfun))
          (preds (invert-graph succs)))
@@ -218,7 +213,7 @@
                          (trivial-intset (loop-successors scc succs))
                          (match (intmap-ref cps entry)
                            ;; Can't rotate $prompt out of loop header.
-                           (($ $kargs _ _ ($ $continue _ _ ($ $prompt))) #f)
+                           (($ $kargs _ _ ($ $prompt)) #f)
                            (_ #t)))
                     ;; Loop header is an exit, and there is only one
                     ;; exit continuation.  Loop header isn't a prompt,
diff --git a/module/language/cps/self-references.scm b/module/language/cps/self-references.scm
index cbdaaa107..8f678616a 100644
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -36,44 +36,44 @@
   (define (subst var)
     (intmap-ref env var (lambda (var) var)))
 
-  (define (rename-exp label cps names vars k src exp)
-    (let ((exp (rewrite-exp exp
-                 ((or ($ $const) ($ $prim)) ,exp)
-                 (($ $call proc args)
-                  ($call (subst proc) ,(map subst args)))
-                 (($ $callk k proc args)
-                  ($callk k (subst proc) ,(map subst args)))
-                 (($ $primcall name args)
-                  ($primcall name ,(map subst args)))
-                 (($ $branch k ($ $values (arg)))
-                  ($branch k ($values ((subst arg)))))
-                 (($ $branch k ($ $primcall name args))
-                  ($branch k ($primcall name ,(map subst args))))
-                 (($ $values args)
-                  ($values ,(map subst args)))
-                 (($ $prompt escape? tag handler)
-                  ($prompt escape? (subst tag) handler)))))
-      (intmap-replace! cps label
-                       (build-cont
-                         ($kargs names vars ($continue k src ,exp))))))
+  (define (rename-exp exp)
+    (rewrite-exp exp
+      ((or ($ $const) ($ $prim)) ,exp)
+      (($ $call proc args)
+       ($call (subst proc) ,(map subst args)))
+      (($ $callk k proc args)
+       ($callk k (subst proc) ,(map subst args)))
+      (($ $primcall name param args)
+       ($primcall name param ,(map subst args)))
+      (($ $values args)
+       ($values ,(map subst args)))))
 
-  (define (visit-exp cps label names vars k src exp)
-    (match exp
-      (($ $fun label)
+  (define (rename-term term)
+    (rewrite-term term
+      (($ $continue k src exp)
+       ($continue k src ,(rename-exp exp)))
+      (($ $branch kf kt src op param args)
+       ($branch kf kt src op param ,(map subst args)))
+      (($ $prompt k kh src escape? tag)
+       ($prompt k kh src escape? (subst tag)))
+      (($ $throw src op param args)
+       ($throw src op param ,(map subst args)))))
+
+  (define (visit-label label cps)
+    (match (intmap-ref cps label)
+      (($ $kargs _ _ ($ $continue k src ($ $fun label)))
        (resolve-self-references cps label env))
-      (($ $rec names vars (($ $fun labels) ...))
+      (($ $kargs _ _ ($ $continue k src
+                        ($ $rec names vars (($ $fun labels) ...))))
        (fold (lambda (label var cps)
                (match (intmap-ref cps label)
                  (($ $kfun src meta self)
                   (resolve-self-references cps label
                                            (intmap-add env var self)))))
              cps labels vars))
-      (_ (rename-exp label cps names vars k src exp))))
-  
-  (intset-fold (lambda (label cps)
-                 (match (intmap-ref cps label)
-                   (($ $kargs names vars ($ $continue k src exp))
-                    (visit-exp cps label names vars k src exp))
-                   (_ cps)))
-               (compute-function-body cps label)
-               cps))
+      (($ $kargs names vars term)
+       (intmap-replace! cps label
+                        (build-cont ($kargs names vars ,(rename-term term)))))
+      (_ cps)))
+
+  (intset-fold visit-label (compute-function-body cps label) cps))
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 280e2573d..5bb8f4bd2 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015, 2017-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -68,22 +68,22 @@
     (match cont
       (($ $kargs _ _ ($ $continue _ _ exp))
        (match exp
-         ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure))
+         ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun) ($ $code))
           (values single multiple))
          (($ $call proc args)
           (ref* (cons proc args)))
          (($ $callk k proc args)
-          (ref* (cons proc args)))
-         (($ $primcall name args)
+          (ref* (if proc (cons proc args) args)))
+         (($ $primcall name param args)
           (ref* args))
          (($ $values args)
-          (ref* args))
-         (($ $branch kt ($ $values (var)))
-          (ref var))
-         (($ $branch kt ($ $primcall name args))
-          (ref* args))
-         (($ $prompt escape? tag handler)
-          (ref tag))))
+          (ref* args))))
+      (($ $kargs _ _ ($ $branch kf kt src op param args))
+       (ref* args))
+      (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+       (ref tag))
+      (($ $kargs _ _ ($ $throw src op param args))
+       (ref* args))
       (_
        (values single multiple))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
@@ -146,18 +146,21 @@
      (lambda (label cont)
        (and (not (intset-ref label-set label))
             (rewrite-cont cont
-              (($ $kargs names syms ($ $continue kf src ($ $branch kt exp)))
+              (($ $kargs names syms ($ $branch kf kt src op param args))
+               ($kargs names syms
+                 ($branch (subst kf) (subst kt) src op param args)))
+              (($ $kargs names syms ($ $prompt k kh src escape? tag))
                ($kargs names syms
-                 ($continue (subst kf) src ($branch (subst kt) ,exp))))
+                 ($prompt (subst k) (subst kh) src escape? tag)))
               (($ $kargs names syms ($ $continue k src ($ $const val)))
                ,(match (intmap-ref conts k)
                   (($ $kargs (_)
                              ((? (lambda (var) (intset-ref singly-used var))
                                  var))
-                      ($ $continue kf _ ($ $branch kt ($ $values (var)))))
+                             ($ $branch kf kt _ 'false? #f (var)))
                    (build-cont
                      ($kargs names syms
-                       ($continue (subst (if val kt kf)) src ($values ())))))
+                       ($continue (subst (if val kf kt)) src ($values ())))))
                   (_
                    (build-cont
                      ($kargs names syms
@@ -190,8 +193,10 @@
       (($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
       (($ $ktail) (ref0))
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
-      (($ $kargs names syms ($ $continue k src exp))
-       (ref2 k (match exp (($ $branch k) k) (($ $prompt _ _ k) k) (_ #f))))))
+      (($ $kargs names syms ($ $continue k)) (ref1 k))
+      (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
+      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs names syms ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intset-fold add-ref body single multiple)))
     (intset-subtract (persistent-intset single)
@@ -237,37 +242,40 @@
       (match (intmap-ref var-map var (lambda (_) #f))
         (#f var)
         (val (subst val))))
-    (define (transform-exp label k src exp)
+    (define (transform-term label term)
       (if (intset-ref label-set label)
-          (match (intmap-ref conts k)
-            (($ $kargs _ _ ($ $continue k* src* exp*))
-             (transform-exp k k* src* exp*)))
-          (build-term
-           ($continue k src
-             ,(rewrite-exp exp
-                ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure))
-                 ,exp)
-                (($ $call proc args)
-                 ($call (subst proc) ,(map subst args)))
-                (($ $callk k proc args)
-                 ($callk k (subst proc) ,(map subst args)))
-                (($ $primcall name args)
-                 ($primcall name ,(map subst args)))
-                (($ $values args)
-                 ($values ,(map subst args)))
-                (($ $branch kt ($ $values (var)))
-                 ($branch kt ($values ((subst var)))))
-                (($ $branch kt ($ $primcall name args))
-                 ($branch kt ($primcall name ,(map subst args))))
-                (($ $prompt escape? tag handler)
-                 ($prompt escape? (subst tag) handler)))))))
+          (match term
+            (($ $continue k)
+             (match (intmap-ref conts k)
+               (($ $kargs _ _ term)
+                (transform-term k term)))))
+          (rewrite-term term
+            (($ $continue k src exp)
+             ($continue k src
+               ,(rewrite-exp exp
+                  ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun)
+                       ($ $code))
+                   ,exp)
+                  (($ $call proc args)
+                   ($call (subst proc) ,(map subst args)))
+                  (($ $callk k proc args)
+                   ($callk k (and proc (subst proc)) ,(map subst args)))
+                  (($ $primcall name param args)
+                   ($primcall name param ,(map subst args)))
+                  (($ $values args)
+                   ($values ,(map subst args))))))
+            (($ $branch kf kt src op param args)
+             ($branch kf kt src op param ,(map subst args)))
+            (($ $prompt k kh src escape? tag)
+             ($prompt k kh src escape? (subst tag)))
+            (($ $throw src op param args)
+             ($throw src op param ,(map subst args))))))
     (transform-conts
      (lambda (label cont)
-       (match cont
-         (($ $kargs names syms ($ $continue k src exp))
-          (build-cont
-           ($kargs names syms ,(transform-exp label k src exp))))
-         (_ cont)))
+       (rewrite-cont cont
+         (($ $kargs names syms term)
+          ($kargs names syms ,(transform-term label term)))
+         (_ ,cont)))
      conts)))
 
 (define (simplify conts)
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 2d95f4262..247d64869 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -1,6 +1,6 @@
 ;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -37,16 +37,13 @@
             lookup-slot
             lookup-maybe-slot
             lookup-representation
-            lookup-constant-value
-            lookup-maybe-constant-value
             lookup-nlocals
             lookup-call-proc-slot
             lookup-parallel-moves
             lookup-slot-map))
 
 (define-record-type $allocation
-  (make-allocation slots representations constant-values call-allocs
-                   shuffles frame-size)
+  (make-allocation slots representations call-allocs shuffles frame-size)
   allocation?
 
   ;; A map of VAR to slot allocation.  A slot allocation is an integer,
@@ -59,12 +56,8 @@
   ;;
   (representations allocation-representations)
 
-  ;; A map of VAR to constant value, for variables with constant values.
-  ;;
-  (constant-values allocation-constant-values)
-
   ;; A map of LABEL to /call allocs/, for expressions that continue to
-  ;; $kreceive continuations: non-tail calls and $prompt expressions.
+  ;; $kreceive continuations: non-tail calls and $prompt terms.
   ;;
   ;; A call alloc contains two pieces of information: the call's /proc
   ;; slot/ and a /dead slot map/.  The proc slot indicates the slot of a
@@ -111,20 +104,6 @@
 
 (define *absent* (list 'absent))
 
-(define (lookup-constant-value var allocation)
-  (let ((value (intmap-ref (allocation-constant-values allocation) var
-                           (lambda (_) *absent*))))
-    (when (eq? value *absent*)
-      (error "Variable does not have constant value" var))
-    value))
-
-(define (lookup-maybe-constant-value var allocation)
-  (let ((value (intmap-ref (allocation-constant-values allocation) var
-                           (lambda (_) *absent*))))
-    (if (eq? value *absent*)
-        (values #f #f)
-        (values #t value))))
-
 (define (lookup-call-alloc k allocation)
   (intmap-ref (allocation-call-allocs allocation) k))
 
@@ -164,25 +143,26 @@ by a label, respectively."
                 (intmap-add! uses label u)))
       (match cont
         (($ $kfun src meta self)
-         (return (intset self) empty-intset))
+         (return (if self (intset self) empty-intset) empty-intset))
         (($ $kargs _ _ ($ $continue k src exp))
          (match exp
-           ((or ($ $const) ($ $closure))
+           ((or ($ $const) ($ $const-fun) ($ $code))
             (return (get-defs k) empty-intset))
            (($ $call proc args)
             (return (get-defs k) (intset-add (vars->intset args) proc)))
            (($ $callk _ proc args)
-            (return (get-defs k) (intset-add (vars->intset args) proc)))
-           (($ $primcall name args)
+            (let ((args (vars->intset args)))
+              (return (get-defs k) (if proc (intset-add args proc) args))))
+           (($ $primcall name param args)
             (return (get-defs k) (vars->intset args)))
-           (($ $branch kt ($ $primcall name args))
-            (return empty-intset (vars->intset args)))
-           (($ $branch kt ($ $values args))
-            (return empty-intset (vars->intset args)))
            (($ $values args)
-            (return (get-defs k) (vars->intset args)))
-           (($ $prompt escape? tag handler)
-            (return empty-intset (intset tag)))))
+            (return (get-defs k) (vars->intset args)))))
+        (($ $kargs _ _ ($ $branch kf kt src op param args))
+         (return empty-intset (vars->intset args)))
+        (($ $kargs _ _ ($ $prompt k kh src escape? tag))
+         (return empty-intset (intset tag)))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (return empty-intset (vars->intset args)))
         (($ $kclause arity body alt)
          (return (get-defs body) empty-intset))
         (($ $kreceive arity kargs)
@@ -245,26 +225,20 @@ body continuation in the prompt."
         ((zero? level) labels)
         ((intset-ref labels label) labels)
         (else
-         (match (intmap-ref conts label)
-           (($ $ktail)
-            ;; Possible for bailouts; never reached and not part of
-            ;; prompt body.
-            labels)
-           (cont
-            (let ((labels (intset-add! labels label)))
-              (match cont
-                (($ $kreceive arity k) (visit-cont k level labels))
-                (($ $kargs names syms ($ $continue k src ($ $primcall 'wind)))
-                 (visit-cont k (1+ level) labels))
-                (($ $kargs names syms
-                           ($ $continue k src ($ $prompt escape? tag handler)))
-                 (visit-cont handler level (visit-cont k (1+ level) labels)))
-                (($ $kargs names syms ($ $continue k src ($ $primcall 'unwind)))
-                 (visit-cont k (1- level) labels))
-                (($ $kargs names syms ($ $continue k src ($ $branch kt)))
-                 (visit-cont k level (visit-cont kt level labels)))
-                (($ $kargs names syms ($ $continue k src exp))
-                 (visit-cont k level labels)))))))))))
+         (let ((labels (intset-add! labels label)))
+           (match (intmap-ref conts label)
+             (($ $kreceive arity k) (visit-cont k level labels))
+             (($ $kargs names syms ($ $continue k src ($ $primcall 'wind)))
+              (visit-cont k (1+ level) labels))
+             (($ $kargs names syms ($ $continue k src ($ $primcall 'unwind)))
+              (visit-cont k (1- level) labels))
+             (($ $kargs names syms ($ $continue k src exp))
+              (visit-cont k level labels))
+             (($ $kargs names syms ($ $branch kf kt))
+              (visit-cont kf level (visit-cont kt level labels)))
+             (($ $kargs names syms ($ $prompt k kh src escape? tag))
+              (visit-cont kh level (visit-cont k (1+ level) labels)))
+             (($ $kargs names syms ($ $throw)) labels))))))))
   (define (visit-prompt label handler succs)
     (let ((body (compute-prompt-body label)))
       (define (out-or-back-edge? label)
@@ -273,10 +247,9 @@ body continuation in the prompt."
         ;; continuations that postdominate the rest of the body.  Unless
         ;; you pass #:complete? #t, we only invoke F on continuations
         ;; that can leave the body, or on back-edges in loops.
-        (intset-any (lambda (succ)
-                      (or (not (intset-ref body succ))
-                          (<= succ label)))
-                    (intmap-ref succs label)))
+        (not (intset-any (lambda (succ)
+                           (and (intset-ref body succ) (< label succ)))
+                         (intmap-ref succs label))))
       (intset-fold (lambda (pred succs)
                      (intmap-replace succs pred handler intset-add))
                    (if complete? body (intset-filter out-or-back-edge? body))
@@ -284,9 +257,8 @@ body continuation in the prompt."
   (intmap-fold
    (lambda (label cont succs)
      (match cont
-       (($ $kargs _ _
-           ($ $continue k _ ($ $prompt escape? tag handler)))
-        (visit-prompt k handler succs))
+       (($ $kargs _ _ ($ $prompt k kh))
+        (visit-prompt k kh succs))
        (_ succs)))
    conts
    succs))
@@ -344,50 +316,8 @@ the definitions that are live before and after LABEL, as intsets."
      (intset-union
       needs-slot
       (match cont
-        (($ $kargs _ _ ($ $continue k src exp))
-         (let ((defs (get-defs label)))
-           (define (defs+* uses)
-             (intset-union defs uses))
-           (define (defs+ use)
-             (intset-add defs use))
-           (match exp
-             (($ $const)
-              empty-intset)
-             (($ $primcall (or 'load-f64 'load-u64 'load-s64) (val))
-              empty-intset)
-             (($ $primcall 'free-ref (closure slot))
-              (defs+ closure))
-             (($ $primcall 'free-set! (closure slot value))
-              (defs+* (intset closure value)))
-             (($ $primcall 'cache-current-module! (mod . _))
-              (defs+ mod))
-             (($ $primcall 'cached-toplevel-box _)
-              defs)
-             (($ $primcall 'cached-module-box _)
-              defs)
-             (($ $primcall 'resolve (name bound?))
-              (defs+ name))
-             (($ $primcall 'make-vector/immediate (len init))
-              (defs+ init))
-             (($ $primcall 'vector-ref/immediate (v i))
-              (defs+ v))
-             (($ $primcall 'vector-set!/immediate (v i x))
-              (defs+* (intset v x)))
-             (($ $primcall 'allocate-struct/immediate (vtable nfields))
-              (defs+ vtable))
-             (($ $primcall 'struct-ref/immediate (s n))
-              (defs+ s))
-             (($ $primcall 'struct-set!/immediate (s n x))
-              (defs+* (intset s x)))
-             (($ $primcall (or 'add/immediate 'sub/immediate
-                               'uadd/immediate 'usub/immediate 'umul/immediate
-                               'ursh/immediate 'ulsh/immediate)
-                 (x y))
-              (defs+ x))
-             (($ $primcall 'builtin-ref (idx))
-              defs)
-             (_
-              (defs+* (get-uses label))))))
+        (($ $kargs)
+         (intset-union (get-defs label) (get-uses label)))
         (($ $kreceive arity k)
          ;; Only allocate results of function calls to slots if they are
          ;; used.
@@ -395,7 +325,7 @@ the definitions that are live before and after LABEL, as intsets."
         (($ $kclause arity body alternate)
          (get-defs label))
         (($ $kfun src meta self)
-         (intset self))
+         (if self (intset self) empty-intset))
         (($ $ktail)
          empty-intset))))
    cps
@@ -421,8 +351,9 @@ is an active call."
                      (intset-subtract (intset-add (list->intset args) proc)
                                       (intmap-ref live-out label)))
                     (($ $kargs _ _ ($ $continue _ _ ($ $callk _ proc args)))
-                     (intset-subtract (intset-add (list->intset args) proc)
-                                      (intmap-ref live-out label)))
+                     (let ((args (list->intset args)))
+                       (intset-subtract (if proc (intset-add args proc) args)
+                                        (intmap-ref live-out label))))
                     (($ $kargs _ _ ($ $continue k _($ $values args)))
                      (match (intmap-ref cps k)
                        (($ $ktail) (list->intset args))
@@ -599,7 +530,7 @@ are comparable with eqv?.  A tmp slot may be used."
       (($ $kreceive arity kargs)
        (let* ((results (match (get-cont kargs)
                          (($ $kargs names vars) vars)))
-              (value-slots (integers (1+ proc-slot) (length results)))
+              (value-slots (integers proc-slot (length results)))
               (result-slots (get-slots results))
               ;; Filter out unused results.
               (value-slots (filter-map (lambda (val result) (and result val))
@@ -634,7 +565,7 @@ are comparable with eqv?.  A tmp slot may be used."
       (($ $ktail)
        (let* ((live (compute-live-slots label))
               (src-slots (get-slots args))
-              (dst-slots (integers 1 (length args)))
+              (dst-slots (integers 0 (length args)))
               (moves (parallel-move src-slots dst-slots
                                     (compute-tmp-slot live dst-slots))))
          (intmap-add! shuffles label moves)))
@@ -658,12 +589,12 @@ are comparable with eqv?.  A tmp slot may be used."
          (($ $call proc args)
           (add-call-shuffles label k (cons proc args) shuffles))
          (($ $callk _ proc args)
-          (add-call-shuffles label k (cons proc args) shuffles))
+          (add-call-shuffles label k (if proc (cons proc args) args) shuffles))
          (($ $values args)
           (add-values-shuffles label k args shuffles))
-         (($ $prompt escape? tag handler)
-          (add-prompt-shuffles label k handler shuffles))
          (_ shuffles)))
+      (($ $kargs names vars ($ $prompt k kh src escape? tag))
+       (add-prompt-shuffles label k kh shuffles))
       (_ shuffles)))
 
   (persistent-intmap
@@ -694,14 +625,15 @@ are comparable with eqv?.  A tmp slot may be used."
                   (max (+ (get-proc-slot label) nargs) size)))
   (define (measure-cont label cont size)
     (match cont
-      (($ $kargs names vars ($ $continue k src exp))
+      (($ $kargs names vars term)
        (let ((size (max-size* vars size)))
-         (match exp
-           (($ $call proc args)
+         (match term
+           (($ $continue _ _ ($ $call proc args))
             (call-size label (1+ (length args)) size))
-           (($ $callk _ proc args)
-            (call-size label (1+ (length args)) size))
-           (($ $values args)
+           (($ $continue _ _ ($ $callk _ proc args))
+            (let ((nclosure (if proc 1 0)))
+              (call-size label (+ nclosure (length args)) size)))
+           (($ $continue _ _ ($ $values args))
             (shuffle-size (get-shuffles label) size))
            (_ size))))
       (($ $kreceive)
@@ -711,22 +643,27 @@ are comparable with eqv?.  A tmp slot may be used."
   (intmap-fold measure-cont cps minimum-frame-size))
 
 (define (allocate-args cps)
-  (intmap-fold (lambda (label cont slots)
-                 (match cont
-                   (($ $kfun src meta self)
-                    (intmap-add! slots self 0))
-                   (($ $kclause arity body alt)
-                    (match (intmap-ref cps body)
-                      (($ $kargs names vars)
-                       (let lp ((vars vars) (slots slots) (n 1))
-                         (match vars
-                           (() slots)
-                           ((var . vars)
-                            (lp vars
-                                (intmap-add! slots var n)
-                                (1+ n))))))))
-                   (_ slots)))
-               cps empty-intmap))
+  (match (intmap-ref cps (intmap-next cps))
+    (($ $kfun _ _ has-self?)
+     (intmap-fold (lambda (label cont slots)
+                    (match cont
+                      (($ $kfun src meta self)
+                       (if has-self?
+                           (intmap-add! slots self 0)
+                           slots))
+                      (($ $kclause arity body alt)
+                       (match (intmap-ref cps body)
+                         (($ $kargs names vars)
+                          (let lp ((vars vars) (slots slots)
+                                   (n (if has-self? 1 0)))
+                            (match vars
+                              (() slots)
+                              ((var . vars)
+                               (lp vars
+                                   (intmap-add! slots var n)
+                                   (1+ n))))))))
+                      (_ slots)))
+                  cps empty-intmap))))
 
 (define-inlinable (add-live-slot slot live-slots)
   (logior live-slots (ash 1 slot)))
@@ -776,7 +713,7 @@ are comparable with eqv?.  A tmp slot may be used."
   (define (allocate-values label k args slots)
     (match (intmap-ref cps k)
       (($ $ktail)
-       (allocate* args (integers 1 (length args))
+       (allocate* args (integers 0 (length args))
                   slots (compute-live-slots slots label)))
       (($ $kargs names vars)
        (allocate* args
@@ -790,7 +727,7 @@ are comparable with eqv?.  A tmp slot may be used."
          (($ $call proc args)
           (allocate-call label (cons proc args) slots))
          (($ $callk _ proc args)
-          (allocate-call label (cons proc args) slots))
+          (allocate-call label (if proc (cons proc args) args) slots))
          (($ $values args)
           (allocate-values label k args slots))
          (_ slots)))
@@ -818,21 +755,31 @@ are comparable with eqv?.  A tmp slot may be used."
               (intmap-add representations var
                           (intmap-ref representations arg)))
              (($ $primcall (or 'scm->f64 'load-f64
-                               'bv-f32-ref 'bv-f64-ref
+                               'f32-ref 'f64-ref
                                'fadd 'fsub 'fmul 'fdiv))
               (intmap-add representations var 'f64))
              (($ $primcall (or 'scm->u64 'scm->u64/truncate 'load-u64
-                               'char->integer
-                               'bv-length 'vector-length 'string-length
+                               's64->u64
+                               'assume-u64
                                'uadd 'usub 'umul
                                'ulogand 'ulogior 'ulogxor 'ulogsub 'ursh 'ulsh
                                'uadd/immediate 'usub/immediate 'umul/immediate
                                'ursh/immediate 'ulsh/immediate
-                               'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
+                               'u8-ref 'u16-ref 'u32-ref 'u64-ref
+                               'word-ref 'word-ref/immediate
+                               'untag-char))
               (intmap-add representations var 'u64))
-             (($ $primcall (or 'scm->s64 'load-s64
-                               'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
+             (($ $primcall (or 'untag-fixnum
+                               'assume-s64
+                               'scm->s64 'load-s64 'u64->s64
+                               'srsh 'srsh/immediate
+                               's8-ref 's16-ref 's32-ref 's64-ref))
               (intmap-add representations var 's64))
+             (($ $primcall (or 'pointer-ref/immediate
+                               'tail-pointer-ref/immediate))
+              (intmap-add representations var 'ptr))
+             (($ $code)
+              (intmap-add representations var 'u64))
              (_
               (intmap-add representations var 'scm))))
           (vars
@@ -842,8 +789,12 @@ are comparable with eqv?.  A tmp slot may be used."
                       (intmap-add representations var
                                   (intmap-ref representations arg)))
                     representations args vars))))))
+       (($ $kargs _ _ (or ($ $branch) ($ $prompt) ($ $throw)))
+        representations)
        (($ $kfun src meta self)
-        (intmap-add representations self 'scm))
+        (if self
+            (intmap-add representations self 'scm)
+            representations))
        (($ $kclause arity body alt)
         (fold1 (lambda (var representations)
                  (intmap-add representations var 'scm))
@@ -860,23 +811,22 @@ are comparable with eqv?.  A tmp slot may be used."
   (let*-values (((defs uses) (compute-defs-and-uses cps))
                 ((representations) (compute-var-representations cps))
                 ((live-in live-out) (compute-live-variables cps defs uses))
-                ((constants) (compute-constant-values cps))
                 ((needs-slot) (compute-needs-slot cps defs uses))
                 ((lazy) (if precolor-calls?
                             (compute-lazy-vars cps live-in live-out defs
                                                needs-slot)
                             empty-intset)))
 
+    (define frame-size 3)
+
     (define (empty-live-slots)
       #b0)
 
     (define (compute-call-proc-slot live-slots)
-      (+ 2 (find-first-trailing-zero live-slots)))
+      (+ frame-size (find-first-trailing-zero live-slots)))
 
     (define (compute-prompt-handler-proc-slot live-slots)
-      (if (zero? live-slots)
-          0
-          (1- (find-first-trailing-zero live-slots))))
+      (find-first-trailing-zero live-slots))
 
     (define (get-cont label)
       (intmap-ref cps label))
@@ -916,7 +866,7 @@ are comparable with eqv?.  A tmp slot may be used."
            (#f slot-map)
            (slot
             (let ((desc (match (intmap-ref representations var)
-                          ((or 'u64 'f64 's64) slot-desc-live-raw)
+                          ((or 'u64 'f64 's64 'ptr) slot-desc-live-raw)
                           ('scm slot-desc-live-scm))))
               (logior slot-map (ash desc (* 2 slot)))))))
        live-vars 0))
@@ -983,11 +933,11 @@ are comparable with eqv?.  A tmp slot may be used."
                  (($ $kargs () ())
                   (values slots post-live))
                  (($ $kargs (_ . _) (_ . results))
-                  (let ((result-slots (integers (+ proc-slot 2)
+                  (let ((result-slots (integers (+ proc-slot 1)
                                                 (length results))))
                     (allocate* results result-slots slots post-live)))))
               ((slot-map) (compute-slot-map slots (intmap-ref live-out label)
-                                            (- proc-slot 2)))
+                                            (- proc-slot frame-size)))
               ((call) (make-call-alloc proc-slot slot-map)))
            (values slots
                    (intmap-add! call-allocs label call))))))
@@ -1022,10 +972,10 @@ are comparable with eqv?.  A tmp slot may be used."
              (((handler-live) (compute-live-in-slots slots handler))
               ((proc-slot) (compute-prompt-handler-proc-slot handler-live))
               ((slot-map)  (compute-slot-map slots (intmap-ref live-in handler)
-                                             (- proc-slot 2)))
+                                             (- proc-slot frame-size)))
               ((result-vars) (match (get-cont kargs)
                                (($ $kargs names vars) vars)))
-              ((value-slots) (integers (1+ proc-slot) (length result-vars)))
+              ((value-slots) (integers proc-slot (length result-vars)))
               ((slots result-live) (allocate* result-vars value-slots
                                               slots handler-live)))
            (values slots
@@ -1034,17 +984,18 @@ are comparable with eqv?.  A tmp slot may be used."
 
     (define (allocate-cont label cont slots call-allocs)
       (match cont
-        (($ $kargs names vars ($ $continue k src exp))
+        (($ $kargs names vars term)
          (let-values (((slots live) (allocate-defs label vars slots)))
-           (match exp
-             (($ $call proc args)
-              (allocate-call label k (cons proc args) slots call-allocs live))
-             (($ $callk _ proc args)
+           (match term
+             (($ $continue k src ($ $call proc args))
               (allocate-call label k (cons proc args) slots call-allocs live))
-             (($ $values args)
+             (($ $continue k src ($ $callk _ proc args))
+              (allocate-call label k (if proc (cons proc args) args)
+                             slots call-allocs live))
+             (($ $continue k src ($ $values args))
               (allocate-values label k args slots call-allocs))
-             (($ $prompt escape? tag handler)
-              (allocate-prompt label k handler slots call-allocs))
+             (($ $prompt k kh src escape? tag)
+              (allocate-prompt label k kh slots call-allocs))
              (_
               (values slots call-allocs)))))
         (_
@@ -1057,5 +1008,4 @@ are comparable with eqv?.  A tmp slot may be used."
         (let* ((slots (allocate-lazy-vars cps slots calls live-in lazy))
                (shuffles (compute-shuffles cps slots calls live-in))
                (frame-size (compute-frame-size cps slots calls shuffles)))
-          (make-allocation slots representations constants calls
-                           shuffles frame-size))))))
+          (make-allocation slots representations calls shuffles frame-size))))))
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
index d5587037b..dc8e26f29 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016, 2017, 2018, 2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -52,6 +52,7 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (system base target)
   #:use-module (language cps)
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
@@ -61,103 +62,166 @@
   #:use-module (language cps with-cps)
   #:export (specialize-numbers))
 
-(define (specialize-f64-binop cps k src op a b)
-  (let ((fop (match op
-               ('add 'fadd)
-               ('sub 'fsub)
-               ('mul 'fmul)
-               ('div 'fdiv))))
-    (with-cps cps
-      (letv f64-a f64-b result)
-      (letk kbox ($kargs ('result) (result)
-                   ($continue k src
-                     ($primcall 'f64->scm (result)))))
-      (letk kop ($kargs ('f64-b) (f64-b)
-                  ($continue kbox src
-                    ($primcall fop (f64-a f64-b)))))
-      (letk kunbox-b ($kargs ('f64-a) (f64-a)
-                       ($continue kop src
-                         ($primcall 'scm->f64 (b)))))
-      (build-term
-        ($continue kunbox-b src
-          ($primcall 'scm->f64 (a)))))))
-
-(define* (specialize-u64-binop cps k src op a b #:key
-                               (unbox-a 'scm->u64)
-                               (unbox-b 'scm->u64))
-  (let ((uop (match op
-               ('add 'uadd)
-               ('sub 'usub)
-               ('mul 'umul)
-               ('logand 'ulogand)
-               ('logior 'ulogior)
-               ('logxor 'ulogxor)
-               ('logsub 'ulogsub)
-               ('rsh 'ursh)
-               ('lsh 'ulsh))))
-    (with-cps cps
-      (letv u64-a u64-b result)
-      (letk kbox ($kargs ('result) (result)
-                   ($continue k src
-                     ($primcall 'u64->scm (result)))))
-      (letk kop ($kargs ('u64-b) (u64-b)
-                  ($continue kbox src
-                    ($primcall uop (u64-a u64-b)))))
-      (letk kunbox-b ($kargs ('u64-a) (u64-a)
-                       ($continue kop src
-                         ($primcall unbox-b (b)))))
-      (build-term
-        ($continue kunbox-b src
-          ($primcall unbox-a (a)))))))
-
-(define (truncate-u64 cps k src scm)
+;; A note on how to represent unboxing and boxing operations.  We want
+;; to avoid diamond control flows here, like:
+;;
+;;   s64 x = (if (fixnum? x*) (untag-fixnum x*) (untag-bignum x*))
+;;
+;; The reason is that the strategy that this specialize-numbers pass
+;; uses to unbox values is to reify unboxing and boxing conversions
+;; around every newly reified unboxed operation; it then relies heavily
+;; on DCE and CSE to remove redundant conversions.  However DCE and CSE
+;; really work best when there's a linear control flow, so instead we
+;; use a mid-level primcall:
+;;
+;;   (define (scm->s64 x*)
+;;     (if (fixnum? x*) (untag-fixnum x*) (untag-bignum x*)))
+;;
+;; Then, unless we know that we can reduce directly to `untag-fixnum`,
+;; we do:
+;;
+;;   s64 x = (scm->s64 x*)
+;;
+;; That way we keep DCE and CSE happy.  We can inline scm->s64 at the
+;; backend if we choose to (though we might choose to not do so, for
+;; code size reasons).
+
+(define (simple-primcall cps k src op arg)
   (with-cps cps
-    (letv u64)
-    (letk kbox ($kargs ('u64) (u64)
-                 ($continue k src
-                   ($primcall 'u64->scm (u64)))))
     (build-term
-      ($continue kbox src
-        ($primcall 'scm->u64/truncate (scm))))))
+      ($continue k src
+        ($primcall op #f (arg))))))
 
-(define (specialize-u64-comparison cps kf kt src op a b)
-  (let ((op (symbol-append 'u64- op)))
-    (with-cps cps
-      (letv u64-a u64-b)
-      (letk kop ($kargs ('u64-b) (u64-b)
-                  ($continue kf src
-                    ($branch kt ($primcall op (u64-a u64-b))))))
-      (letk kunbox-b ($kargs ('u64-a) (u64-a)
-                       ($continue kop src
-                         ($primcall 'scm->u64 (b)))))
-      (build-term
-        ($continue kunbox-b src
-          ($primcall 'scm->u64 (a)))))))
-
-(define (specialize-u64-scm-comparison cps kf kt src op a-u64 b-scm)
-  (let ((op (symbol-append 'u64- op '-scm)))
-    (with-cps cps
-      (letv u64)
-      (letk kop ($kargs ('u64) (u64)
-                  ($continue kf src
-                    ($branch kt ($primcall op (u64 b-scm))))))
-      (build-term
-        ($continue kop src
-          ($primcall 'scm->u64 (a-u64)))))))
-
-(define (specialize-f64-comparison cps kf kt src op a b)
-  (let ((op (symbol-append 'f64- op)))
+(define-syntax-rule (define-simple-primcall name)
+  (define (name cps k src arg) (simple-primcall cps k src 'name arg)))
+
+(define-simple-primcall untag-fixnum)
+(define-simple-primcall scm->s64)
+(define-simple-primcall tag-fixnum)
+(define-simple-primcall s64->scm)
+(define-simple-primcall tag-fixnum/unlikely)
+(define-simple-primcall s64->scm/unlikely)
+
+(define (fixnum->u64 cps k src fx)
+  (with-cps cps
+    (letv s64)
+    (letk kcvt ($kargs ('s64) (s64)
+                 ($continue k src ($primcall 's64->u64 #f (s64)))))
+    ($ (untag-fixnum kcvt src fx))))
+(define (u64->fixnum cps k src u64)
+  (with-cps cps
+    (letv s64)
+    (let$ tag-body (tag-fixnum k src s64))
+    (letk ks64 ($kargs ('s64) (s64) ,tag-body))
+    (build-term
+      ($continue ks64 src ($primcall 'u64->s64 #f (u64))))))
+(define-simple-primcall scm->u64)
+(define-simple-primcall u64->scm)
+(define-simple-primcall u64->scm/unlikely)
+
+(define-simple-primcall scm->f64)
+(define-simple-primcall f64->scm)
+
+(define (specialize-unop cps k src op param a unbox-a box-result)
+  (with-cps cps
+    (letv a* result)
+    (let$ box-result-body (box-result k src result))
+    (letk kbox ($kargs ('result) (result) ,box-result-body))
+    (letk kop ($kargs ('a) (a*)
+                ($continue kbox src ($primcall op param (a*)))))
+    ($ (unbox-a kop src a))))
+
+(define* (specialize-binop cps k src op a b
+                           unbox-a unbox-b box-result)
+  (with-cps cps
+    (letv a* b* result)
+    (let$ box-result-body (box-result k src result))
+    (letk kbox ($kargs ('result) (result) ,box-result-body))
+    (letk kop ($kargs ('b) (b*)
+                ($continue kbox src ($primcall op #f (a* b*)))))
+    (let$ unbox-b-body (unbox-b kop src b))
+    (letk kunbox-b ($kargs ('a) (a*) ,unbox-b-body))
+    ($ (unbox-a kunbox-b src a))))
+
+(define (specialize-comparison cps kf kt src op a b unbox-a unbox-b)
+  (with-cps cps
+    (letv a* b*)
+    (letk kop ($kargs ('b) (b*) ($branch kf kt src op #f (a* b*))))
+    (let$ unbox-b-body (unbox-b kop src b))
+    (letk kunbox-b ($kargs ('a) (a*) ,unbox-b-body))
+    ($ (unbox-a kunbox-b src a))))
+
+(define* (specialize-comparison/immediate cps kf kt src op a imm
+                                          unbox-a)
+  (with-cps cps
+    (letv ia)
+    (letk kop ($kargs ('ia) (ia) ($branch kf kt src op imm (ia))))
+    ($ (unbox-a kop src a))))
+
+(define (specialize-comparison/s64-integer cps kf kt src op a-s64 b-int
+                                           unbox-a rebox-a)
+  (let ((s64-op (match op ('= 's64-=) ('< 's64-<))))
     (with-cps cps
-      (letv f64-a f64-b)
-      (letk kop ($kargs ('f64-b) (f64-b)
-                  ($continue kf src
-                    ($branch kt ($primcall op (f64-a f64-b))))))
-      (letk kunbox-b ($kargs ('f64-a) (f64-a)
-                       ($continue kop src
-                         ($primcall 'scm->f64 (b)))))
-      (build-term
-        ($continue kunbox-b src
-          ($primcall 'scm->f64 (a)))))))
+      (letv a b sunk)
+      (letk kheap ($kargs ('sunk) (sunk)
+                    ($branch kf kt src op #f (sunk b-int))))
+      ;; Re-box the variable.  FIXME: currently we use a specially
+      ;; marked s64->scm to avoid CSE from hoisting the allocation
+      ;; again.  Instead we should just use a-s64 directly and implement
+      ;; an allocation sinking pass that should handle this..
+      (let$ rebox-a-body (rebox-a kheap src a))
+      (letk kretag ($kargs () () ,rebox-a-body))
+      (letk kb ($kargs ('b) (b) ($branch kf kt src s64-op #f (a b))))
+      (letk kfix ($kargs () ()
+                   ($continue kb src
+                     ($primcall 'untag-fixnum #f (b-int)))))
+      (letk ka ($kargs ('a) (a)
+                 ($branch kretag kfix src 'fixnum? #f (b-int))))
+      ($ (unbox-a ka src a-s64)))))
+
+(define (specialize-comparison/integer-s64 cps kf kt src op a-int b-s64
+                                           unbox-b rebox-b)
+  (match op
+    ('= (specialize-comparison/s64-integer cps kf kt src op b-s64 a-int
+                                           unbox-b rebox-b))
+    ('<
+     (with-cps cps
+       (letv a b sunk)
+       (letk kheap ($kargs ('sunk) (sunk)
+                     ($branch kf kt src '< #f (a-int sunk))))
+       ;; FIXME: We should just use b-s64 directly and implement an
+       ;; allocation sinking pass so that the box op that creates b-64
+       ;; should float down here.  Instead, for now we just rebox the
+       ;; variable, relying on the reboxing op not being available for
+       ;; CSE.
+       (let$ rebox-b-body (rebox-b kheap src b))
+       (letk kretag ($kargs () () ,rebox-b-body))
+       (letk ka ($kargs ('a) (a) ($branch kf kt src 's64-< #f (a b))))
+       (letk kfix ($kargs () ()
+                    ($continue ka src
+                      ($primcall 'untag-fixnum #f (a-int)))))
+       (letk kb ($kargs ('b) (b)
+                  ($branch kretag kfix src 'fixnum? #f (a-int))))
+       ($ (unbox-b kb src b-s64))))))
+
+(define (specialize-comparison/immediate-s64-integer cps kf kt src op a b-int
+                                                     compare-integers)
+  (with-cps cps
+    (letv b sunk)
+    (letk kheap ($kargs ('sunk) (sunk) ,(compare-integers kf kt src sunk)))
+    ;; Re-box the variable.  FIXME: currently we use a specially marked
+    ;; load-const to avoid CSE from hoisting the constant.  Instead we
+    ;; should just use a $const directly and implement an allocation
+    ;; sinking pass that should handle this..
+    (letk kretag ($kargs () ()
+                   ($continue kheap src
+                     ($primcall 'load-const/unlikely a ()))))
+    (letk kb ($kargs ('b) (b)
+               ($branch kf kt src op a (b))))
+    (letk kfix ($kargs () ()
+                 ($continue kb src
+                   ($primcall 'untag-fixnum #f (b-int)))))
+    (build-term ($branch kretag kfix src 'fixnum? #f (b-int)))))
 
 (define (sigbits-union x y)
   (and x y (logior x y)))
@@ -186,7 +250,7 @@
 (define (inferred-sigbits types label var)
   (call-with-values (lambda () (lookup-pre-type types label var))
     (lambda (type min max)
-      (and (or (eqv? type &exact-integer) (eqv? type &u64))
+      (and (type<=? type (logior &exact-integer &u64 &s64))
            (range->sigbits min max)))))
 
 (define significant-bits-handlers (make-hash-table))
@@ -194,7 +258,7 @@
                       ((primop label types out def ...) arg ...)
                       body ...)
   (hashq-set! significant-bits-handlers 'primop
-              (lambda (label types out args defs)
+              (lambda (label types out param args defs)
                 (match args ((arg ...) (match defs ((def ...) body ...)))))))
 
 (define-significant-bits-handler ((logand label types out res) a b)
@@ -241,198 +305,363 @@ BITS indicating the significant bits needed for a variable.  BITS may be
            (continue
             (match (intmap-ref cps label)
               (($ $kfun src meta self)
-               (add-def out self))
-              (($ $kargs names vars ($ $continue k src exp))
+               (if self (add-def out self) out))
+              (($ $kargs names vars term)
                (let ((out (add-defs out vars)))
-                 (match exp
-                   ((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($ $rec))
-                    ;; No uses, so no info added to sigbits.
-                    out)
-                   (($ $values args)
-                    (match (intmap-ref cps k)
-                      (($ $kargs _ vars)
-                       (if (intset-ref visited k)
-                           (fold (lambda (arg var out)
-                                   (intmap-add out arg (intmap-ref out var)
-                                               sigbits-union))
-                                 out args vars)
-                           out))
-                      (($ $ktail)
-                       (add-unknown-uses out args))))
-                   (($ $call proc args)
-                    (add-unknown-use (add-unknown-uses out args) proc))
-                   (($ $callk label proc args)
-                    (add-unknown-use (add-unknown-uses out args) proc))
-                   (($ $branch kt ($ $values (arg)))
-                    (add-unknown-use out arg))
-                   (($ $branch kt ($ $primcall name args))
-                    (add-unknown-uses out args))
-                   (($ $primcall name args)
-                    (let ((h (significant-bits-handler name)))
-                      (if h
-                          (match (intmap-ref cps k)
-                            (($ $kargs _ defs)
-                             (h label types out args defs)))
+                 (match term
+                   (($ $continue k src exp)
+                    (match exp
+                      ((or ($ $const) ($ $prim) ($ $fun) ($ $const-fun)
+                           ($ $code) ($ $rec))
+                       ;; No uses, so no info added to sigbits.
+                       out)
+                      (($ $values args)
+                       (match (intmap-ref cps k)
+                         (($ $kargs _ vars)
+                          (if (intset-ref visited k)
+                              (fold (lambda (arg var out)
+                                      (intmap-add out arg (intmap-ref out var)
+                                                  sigbits-union))
+                                    out args vars)
+                              out))
+                         (($ $ktail)
                           (add-unknown-uses out args))))
-                   (($ $prompt escape? tag handler)
-                    (add-unknown-use out tag)))))
+                      (($ $call proc args)
+                       (add-unknown-use (add-unknown-uses out args) proc))
+                      (($ $callk label proc args)
+                       (let ((out (add-unknown-uses out args)))
+                         (if proc
+                             (add-unknown-use out proc)
+                             out)))
+                      (($ $primcall name param args)
+                       (let ((h (significant-bits-handler name)))
+                         (if h
+                             (match (intmap-ref cps k)
+                               (($ $kargs _ defs)
+                                (h label types out param args defs)))
+                             (add-unknown-uses out args))))))
+                   (($ $branch kf kt src op param args)
+                    (add-unknown-uses out args))
+                   (($ $prompt k kh src escape? tag)
+                    (add-unknown-use out tag))
+                   (($ $throw src op param args)
+                    (add-unknown-uses out args)))))
               (_ out)))))))))
 
 (define (specialize-operations cps)
+  (define (u6-parameter? param)
+    (<= 0 param 63))
+  (define (s64-parameter? param)
+    (<= (ash -1 63) param (1- (ash 1 63))))
+  (define (u64-parameter? param)
+    (<= 0 param (1- (ash 1 64))))
   (define (visit-cont label cont cps types sigbits)
     (define (operand-in-range? var &type &min &max)
       (call-with-values (lambda ()
                           (lookup-pre-type types label var))
         (lambda (type min max)
-          (and (eqv? type &type) (<= &min min max &max)))))
+          (and (type<=? type &type) (<= &min min max &max)))))
     (define (u64-operand? var)
-      (operand-in-range? var &exact-integer 0 #xffffffffffffffff))
-    (define (all-u64-bits-set? var)
+      (operand-in-range? var &exact-integer 0 (1- (ash 1 64))))
+    (define (u6-operand? var)
+      ;; This predicate is only used for the "count" argument to
+      ;; rsh/lsh, which is already unboxed to &u64.
+      (operand-in-range? var &u64 0 63))
+    (define (s64-operand? var)
+      (operand-in-range? var &exact-integer (ash -1 63) (1- (ash 1 63))))
+    (define (fixnum-operand? var)
       (operand-in-range? var &exact-integer
-                         #xffffffffffffffff
-                         #xffffffffffffffff))
+                         (target-most-negative-fixnum)
+                         (target-most-positive-fixnum)))
+    (define (exact-integer-operand? var)
+      (operand-in-range? var &exact-integer -inf.0 +inf.0))
+    (define (all-u64-bits-set? var)
+      (operand-in-range? var &exact-integer (1- (ash 1 64)) (1- (ash 1 64))))
+    (define (only-fixnum-bits-used? var)
+      (let ((bits (intmap-ref sigbits var)))
+        (and bits (= bits (logand bits (target-most-positive-fixnum))))))
+    (define (fixnum-result? result)
+      (or (only-fixnum-bits-used? result)
+          (call-with-values
+              (lambda ()
+                (lookup-post-type types label result 0))
+            (lambda (type min max)
+              (and (type<=? type &exact-integer)
+                   (<= (target-most-negative-fixnum)
+                       min max
+                       (target-most-positive-fixnum)))))))
     (define (only-u64-bits-used? var)
       (let ((bits (intmap-ref sigbits var)))
-        (and bits (= bits (logand bits #xffffFFFFffffFFFF)))))
+        (and bits (= bits (logand bits (1- (ash 1 64)))))))
     (define (u64-result? result)
       (or (only-u64-bits-used? result)
           (call-with-values
               (lambda ()
                 (lookup-post-type types label result 0))
             (lambda (type min max)
-              (and (eqv? type &exact-integer)
-                   (<= 0 min max #xffffffffffffffff))))))
+              (and (type<=? type &exact-integer)
+                   (<= 0 min max (1- (ash 1 64))))))))
+    (define (s64-result? result)
+      (call-with-values
+          (lambda ()
+            (lookup-post-type types label result 0))
+        (lambda (type min max)
+          (and (type<=? type &exact-integer)
+               (<= (ash -1 63) min max (1- (ash 1 63)))))))
+    (define (f64-result? result)
+      (call-with-values
+          (lambda ()
+            (lookup-post-type types label result 0))
+        (lambda (type min max)
+          (eqv? type &flonum))))
     (define (f64-operands? vara varb)
       (let-values (((typea mina maxa) (lookup-pre-type types label vara))
                    ((typeb minb maxb) (lookup-pre-type types label varb)))
-        (and (zero? (logand (logior typea typeb) (lognot &real)))
+        (and (type<=? (logior typea typeb) &real)
              (or (eqv? typea &flonum)
                  (eqv? typeb &flonum)))))
-    (match cont
-      (($ $kfun)
-       (let ((types (infer-types cps label)))
-         (values cps types (compute-significant-bits cps types label))))
-      (($ $kargs names vars
-          ($ $continue k src
-             ($ $primcall (and op (or 'add 'sub 'mul 'div)) (a b))))
-       (match (intmap-ref cps k)
-         (($ $kargs (_) (result))
-          (call-with-values (lambda ()
-                              (lookup-post-type types label result 0))
-            (lambda (type min max)
-              (values
-               (cond
-                ((eqv? type &flonum)
-                 (with-cps cps
-                   (let$ body (specialize-f64-binop k src op a b))
-                   (setk label ($kargs names vars ,body))))
-                ((and (eqv? type &exact-integer)
-                      (or (<= 0 min max #xffffffffffffffff)
-                          (only-u64-bits-used? result))
-                      (u64-operand? a) (u64-operand? b)
-                      (not (eq? op 'div)))
-                 (with-cps cps
-                   (let$ body (specialize-u64-binop k src op a b))
-                   (setk label ($kargs names vars ,body))))
-                (else
-                 cps))
-               types
-               sigbits))))))
-      (($ $kargs names vars
-          ($ $continue k src ($ $primcall 'ash (a b))))
-       (match (intmap-ref cps k)
-         (($ $kargs (_) (result))
-          (call-with-values (lambda ()
-                              (lookup-pre-type types label b))
-            (lambda (b-type b-min b-max)
-              (values
-               (cond
-                ((or (not (u64-result? result))
-                     (not (u64-operand? a))
-                     (not (eqv? b-type &exact-integer))
-                     (< b-min 0 b-max)
-                     (<= b-min -64)
-                     (<= 64 b-max))
-                 cps)
-                ((and (< b-min 0) (= b-min b-max))
-                 (with-cps cps
-                   (let$ body
-                         (with-cps-constants ((bits (- b-min)))
-                           ($ (specialize-u64-binop k src 'rsh a bits))))
-                   (setk label ($kargs names vars ,body))))
-                ((< b-min 0)
-                 (with-cps cps
-                   (let$ body
-                         (with-cps-constants ((zero 0))
-                           (letv bits)
-                           (let$ body
-                                 (specialize-u64-binop k src 'rsh a bits))
-                           (letk kneg ($kargs ('bits) (bits) ,body))
-                           (build-term
-                             ($continue kneg src
-                               ($primcall 'sub (zero b))))))
-                   (setk label ($kargs names vars ,body))))
-                (else
-                 (with-cps cps
-                   (let$ body (specialize-u64-binop k src 'lsh a b))
-                   (setk label ($kargs names vars ,body)))))
-               types
-               sigbits))))))
-      (($ $kargs names vars
-          ($ $continue k src
-             ($ $primcall (and op (or 'logand 'logior 'logsub 'logxor)) (a b))))
-       (match (intmap-ref cps k)
-         (($ $kargs (_) (result))
-          (values
+    (define (constant-arg arg)
+      (let-values (((type min max) (lookup-pre-type types label arg)))
+        (and (= min max) min)))
+    (define (fixnum-range? min max)
+      (<= (target-most-negative-fixnum) min max (target-most-positive-fixnum)))
+    (define (unbox-u64 arg)
+      (if (fixnum-operand? arg) fixnum->u64 scm->u64))
+    (define (unbox-s64 arg)
+      (if (fixnum-operand? arg) untag-fixnum scm->s64))
+    (define (rebox-s64 arg)
+      (if (fixnum-operand? arg) tag-fixnum/unlikely s64->scm/unlikely))
+    (define (unbox-f64 arg)
+      ;; Could be more precise here.
+      scm->f64)
+    (define (box-s64 result)
+      (if (fixnum-result? result) tag-fixnum s64->scm))
+    (define (box-u64 result)
+      (if (fixnum-result? result) u64->fixnum u64->scm))
+    (define (box-f64 result)
+      f64->scm)
+
+    (define (specialize-primcall cps k src op param args)
+      (match (intmap-ref cps k)
+        (($ $kargs (_) (result))
+         (match (cons* op result param args)
+           (((or 'add 'sub 'mul 'div)
+             (? f64-result?) #f a b)
+            (let ((op (match op
+                        ('add 'fadd) ('sub 'fsub) ('mul 'fmul) ('div 'fdiv))))
+              (specialize-binop cps k src op a b
+                                (unbox-f64 a) (unbox-f64 b) (box-f64 result))))
+
+           (((or 'add 'sub 'mul 'logand 'logior 'logxor 'logsub)
+             (? u64-result?) #f (? u64-operand? a) (? u64-operand? b))
+            (let ((op (match op
+                        ('add 'uadd) ('sub 'usub) ('mul 'umul)
+                        ('logand 'ulogand) ('logior 'ulogior)
+                        ('logxor 'ulogxor) ('logsub 'ulogsub))))
+              (specialize-binop cps k src op a b
+                                (unbox-u64 a) (unbox-u64 b) (box-u64 result))))
+
+           (((or 'logand 'logior 'logxor 'logsub)
+             (? u64-result?) #f (? s64-operand? a) (? s64-operand? b))
+            (let ((op (match op
+                        ('logand 'ulogand) ('logior 'ulogior)
+                        ('logxor 'ulogxor) ('logsub 'ulogsub))))
+              (define (unbox-u64* x)
+                (let ((unbox-s64 (unbox-s64 x)))
+                  (lambda (cps k src x)
+                    (with-cps cps
+                      (letv s64)
+                      (letk ks64 ($kargs ('s64) (s64)
+                                         ($continue k src
+                                                    ($primcall 's64->u64 #f (s64)))))
+                      ($ (unbox-s64 k src x))))))
+              (specialize-binop cps k src op a b
+                                (unbox-u64* a) (unbox-u64* b) (box-u64 result))))
+
+           (((or 'add 'sub 'mul)
+             (? s64-result?) #f (? s64-operand? a) (? s64-operand? b))
+            (let ((op (match op
+                        ('add 'sadd) ('sub 'ssub) ('mul 'smul))))
+              (specialize-binop cps k src op a b
+                                (unbox-s64 a) (unbox-s64 b) (box-s64 result))))
+
+           (('sub/immediate
+             (? f64-result?) param a)
+            (specialize-unop cps k src 'fadd/immediate (- param) a
+                             (unbox-f64 a) (box-f64 result)))
+
+           (((or 'add/immediate 'mul/immediate)
+             (? f64-result?) param a)
+            (let ((op (match op
+                        ('add/immediate 'fadd/immediate)
+                        ('mul/immediate 'fmul/immediate))))
+              (specialize-unop cps k src op param a
+                               (unbox-f64 a) (box-f64 result))))
+
+           (((or 'add/immediate 'sub/immediate 'mul/immediate)
+             (? u64-result?) (? u64-parameter?) (? u64-operand? a))
+            (let ((op (match op
+                        ('add/immediate 'uadd/immediate)
+                        ('sub/immediate 'usub/immediate)
+                        ('mul/immediate 'umul/immediate))))
+              (specialize-unop cps k src op param a
+                               (unbox-u64 a) (box-u64 result))))
+
+           (((or 'add/immediate 'sub/immediate 'mul/immediate)
+             (? s64-result?) (? s64-parameter?) (? s64-operand? a))
+            (let ((op (match op
+                        ('add/immediate 'sadd/immediate)
+                        ('sub/immediate 'ssub/immediate)
+                        ('mul/immediate 'smul/immediate))))
+              (specialize-unop cps k src op param a
+                               (unbox-s64 a) (box-s64 result))))
+
+           (((or 'lsh 'rsh)
+             (? u64-result?) #f (? u64-operand? a) (? u6-operand? b))
+            (let ((op (match op ('lsh 'ulsh) ('rsh 'ursh))))
+              (define (pass-u64 cps k src b)
+                (with-cps cps
+                  (build-term ($continue k src ($values (b))))))
+              (specialize-binop cps k src op a b
+                                (unbox-u64 a) pass-u64 (box-u64 result))))
+
+           (((or 'lsh 'rsh)
+             (? s64-result?) #f (? s64-operand? a) (? u6-operand? b))
+            (let ((op (match op ('lsh 'slsh) ('rsh 'srsh))))
+              (define (pass-u64 cps k src b)
+                (with-cps cps
+                  (build-term ($continue k src ($values (b))))))
+              (specialize-binop cps k src op a b
+                                (unbox-s64 a) pass-u64 (box-s64 result))))
+
+           (((or 'lsh/immediate 'rsh/immediate)
+             (? u64-result?) (? u6-parameter?) (? u64-operand? a))
+            (let ((op (match op
+                        ('lsh/immediate 'ulsh/immediate)
+                        ('rsh/immediate 'ursh/immediate))))
+              (specialize-unop cps k src op param a
+                               (unbox-u64 a) (box-u64 result))))
+
+           (((or 'lsh/immediate 'rsh/immediate)
+             (? s64-result?) (? u6-parameter?) (? s64-operand? a))
+            (let ((op (match op
+                        ('lsh/immediate 'slsh/immediate)
+                        ('rsh/immediate 'srsh/immediate))))
+              (specialize-unop cps k src op param a
+                               (unbox-s64 a) (box-s64 result))))
+
+           (_ (with-cps cps #f))))
+        (_ (with-cps cps #f))))
+
+    (define (specialize-branch cps kf kt src op param args)
+      (match (cons op args)
+        (('<= a b)
+         (cond
+          ((f64-operands? a b)
+           (specialize-comparison cps kf kt src 'f64-<= a b
+                                  (unbox-f64 a) (unbox-f64 b)))
+          ((and (exact-integer-operand? a) (exact-integer-operand? b))
+           ;; If NaN is impossible, reduce (<= a b) to (not (< b a)) and
+           ;; try again.
+           (specialize-branch cps kt kf src '< param (list b a)))
+          (else
+           (with-cps cps #f))))
+        (((or '< '=) a b)
+         (cond
+          ((f64-operands? a b)
+           (let ((op (match op ('= 'f64-=) ('< 'f64-<))))
+             (specialize-comparison cps kf kt src op a b
+                                    (unbox-f64 a) (unbox-f64 b))))
+          ((and (s64-operand? a) (s64-operand? b))
            (cond
-            ((u64-result? result)
-             ;; Given that we know the result can be unboxed to a u64,
-             ;; any out-of-range bits won't affect the result and so we
-             ;; can unconditionally project the operands onto u64.
+            ((constant-arg a)
+             => (lambda (a)
+                  (let ((op (match op ('= 's64-imm-=) ('< 'imm-s64-<))))
+                    (specialize-comparison/immediate cps kf kt src op b a
+                                                     (unbox-s64 b)))))
+            ((constant-arg b)
+             => (lambda (b)
+                  (let ((op (match op ('= 's64-imm-=) ('< 's64-imm-<))))
+                    (specialize-comparison/immediate cps kf kt src op a b
+                                                     (unbox-s64 a)))))
+            (else
+             (let ((op (match op ('= 's64-=) ('< 's64-<))))
+               (specialize-comparison cps kf kt src op a b
+                                      (unbox-s64 a) (unbox-s64 b))))))
+          ((and (u64-operand? a) (u64-operand? b))
+           (cond
+            ((constant-arg a)
+             => (lambda (a)
+                  (let ((op (match op ('= 'u64-imm-=) ('< 'imm-u64-<))))
+                    (specialize-comparison/immediate cps kf kt src op b a
+                                                     (unbox-u64 b)))))
+            ((constant-arg b)
+             => (lambda (b)
+                  (let ((op (match op ('= 'u64-imm-=) ('< 'u64-imm-<))))
+                    (specialize-comparison/immediate cps kf kt src op a b
+                                                     (unbox-u64 a)))))
+            (else
+             (let ((op (match op ('= 'u64-=) ('< 'u64-<))))
+               (specialize-comparison cps kf kt src op a b
+                                      (unbox-u64 a) (unbox-u64 b))))))
+          ((and (exact-integer-operand? a) (exact-integer-operand? b))
+           (cond
+            ((s64-operand? a)
              (cond
-              ((and (eq? op 'logand) (all-u64-bits-set? a))
-               (with-cps cps
-                 (let$ body (truncate-u64 k src b))
-                 (setk label ($kargs names vars ,body))))
-              ((and (eq? op 'logand) (all-u64-bits-set? b))
-               (with-cps cps
-                 (let$ body (truncate-u64 k src a))
-                 (setk label ($kargs names vars ,body))))
+              ((constant-arg a)
+               => (lambda (a)
+                    (let ((imm-op (match op ('= 's64-imm-=) ('< 'imm-s64-<))))
+                      (specialize-comparison/immediate-s64-integer
+                       cps kf kt src imm-op a b
+                       (lambda (kf kt src a)
+                         (build-term ($branch kf kt src op #f (a b))))))))
               (else
-               (with-cps cps
-                 (let$ body (specialize-u64-binop k src op a b
-                                                  #:unbox-a
-                                                  'scm->u64/truncate
-                                                  #:unbox-b
-                                                  'scm->u64/truncate))
-                 (setk label ($kargs names vars ,body))))))
-            (else cps))
-           types sigbits))))
-      (($ $kargs names vars
-          ($ $continue k src
-             ($ $branch kt ($ $primcall (and op (or '< '<= '= '>= '>)) (a b)))))
-       (values
-        (cond
-         ((f64-operands? a b)
-          (with-cps cps
-            (let$ body (specialize-f64-comparison k kt src op a b))
-            (setk label ($kargs names vars ,body))))
-         ((u64-operand? a)
-          (let ((specialize (if (u64-operand? b)
-                                specialize-u64-comparison
-                                specialize-u64-scm-comparison)))
-            (with-cps cps
-              (let$ body (specialize k kt src op a b))
-              (setk label ($kargs names vars ,body)))))
-         ((u64-operand? b)
-          (let ((op (match op
-                      ('< '>) ('<= '>=) ('= '=) ('>= '<=) ('> '<))))
-            (with-cps cps
-              (let$ body (specialize-u64-scm-comparison k kt src op b a))
-              (setk label ($kargs names vars ,body)))))
-         (else cps))
-        types
-        sigbits))
+               (specialize-comparison/s64-integer cps kf kt src op a b
+                                                  (unbox-s64 a)
+                                                  (rebox-s64 a)))))
+            ((s64-operand? b)
+             (cond
+              ((constant-arg b)
+               => (lambda (b)
+                    (let ((imm-op (match op ('= 's64-imm-=) ('< 's64-imm-<))))
+                      (specialize-comparison/immediate-s64-integer
+                       cps kf kt src imm-op b a
+                       (lambda (kf kt src b)
+                         (build-term ($branch kf kt src op #f (a b))))))))
+              (else
+               (specialize-comparison/integer-s64 cps kf kt src op a b
+                                                  (unbox-s64 b)
+                                                  (rebox-s64 b)))))
+            (else (with-cps cps #f))))
+          (else (with-cps cps #f))))
+        (_ (with-cps cps #f))))
+
+    (match cont
+      (($ $kfun)
+       (let* ((types (infer-types cps label))
+              (sigbits (compute-significant-bits cps types label)))
+         (values cps types sigbits)))
+
+      (($ $kargs names vars ($ $continue k src ($ $primcall op param args)))
+       (call-with-values
+           (lambda () (specialize-primcall cps k src op param args))
+         (lambda (cps term)
+           (values (if term
+                       (with-cps cps
+                         (setk label ($kargs names vars ,term)))
+                       cps)
+                   types sigbits))))
+
+      (($ $kargs names vars ($ $branch kf kt src op param args))
+       (call-with-values
+           (lambda () (specialize-branch cps kf kt src op param args))
+         (lambda (cps term)
+           (values (if term
+                       (with-cps cps
+                         (setk label ($kargs names vars ,term)))
+                       cps)
+                   types sigbits))))
+
       (_ (values cps types sigbits))))
 
   (values (intmap-fold visit-cont cps cps #f #f)))
@@ -444,7 +673,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
    (lambda (label defs)
      (match (intmap-ref conts label)
        (($ $kfun src meta self tail clause)
-        (intmap-add defs self label))
+        (if self (intmap-add defs self label) defs))
        (($ $kargs names vars)
         (fold1 (lambda (var defs)
                  (intmap-add defs var label))
@@ -510,7 +739,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
        (match (intmap-ref cps label)
          (($ $kargs _ _ ($ $continue k _ exp))
           (match exp
-            (($ $primcall (? (lambda (op) (memq op unbox-ops))) (var))
+            (($ $primcall (? (lambda (op) (memq op unbox-ops))) #f (var))
              (intset-add unbox-uses var))
             (($ $values vars)
              (match (intmap-ref cps k)
@@ -539,7 +768,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
   ;; Can the result of EXP definitely be unboxed as an f64?
   (define (exp-result-f64? exp)
     (match exp
-      ((or ($ $primcall 'f64->scm (_))
+      ((or ($ $primcall 'f64->scm #f (_))
            ($ $const (and (? number?) (? inexact?) (? real?))))
        #t)
       (_ #f)))
@@ -550,16 +779,59 @@ BITS indicating the significant bits needed for a variable.  BITS may be
 (define (compute-specializable-u64-vars cps body preds defs)
   ;; Can the result of EXP definitely be unboxed as a u64?
   (define (exp-result-u64? exp)
+    (define (u64? n)
+      (and (number? n) (exact-integer? n)
+           (<= 0 n #xffffffffffffffff)))
     (match exp
-      ((or ($ $primcall 'u64->scm (_))
-           ($ $const (and (? number?) (? exact-integer?)
-                          (? (lambda (n) (<= 0 n #xffffffffffffffff))))))
+      ((or ($ $primcall 'u64->scm #f (_))
+           ($ $primcall 'u64->scm/unlikely #f (_))
+           ($ $primcall 'load-const/unlikely (? u64?) ())
+           ($ $const (? u64?)))
        #t)
       (_ #f)))
 
   (compute-specializable-vars cps body preds defs exp-result-u64?
                               '(scm->u64 'scm->u64/truncate)))
 
+;; Compute vars whose definitions are all exact integers in the fixnum
+;; range and whose uses include an untag operation.
+(define (compute-specializable-fixnum-vars cps body preds defs)
+  ;; Is the result of EXP definitely a fixnum?
+  (define (exp-result-fixnum? exp)
+    (define (fixnum? n)
+      (and (number? n) (exact-integer? n)
+           (<= (target-most-negative-fixnum)
+               n
+               (target-most-positive-fixnum))))
+    (match exp
+      ((or ($ $primcall 'tag-fixnum #f (_))
+           ($ $primcall 'tag-fixnum/unlikely #f (_))
+           ($ $const (? fixnum?))
+           ($ $primcall 'load-const/unlikely (? fixnum?) ()))
+       #t)
+      (_ #f)))
+
+  (compute-specializable-vars cps body preds defs exp-result-fixnum?
+                              '(untag-fixnum)))
+
+;; Compute vars whose definitions are all exact integers in the s64
+;; range and whose uses include an untag operation.
+(define (compute-specializable-s64-vars cps body preds defs)
+  ;; Is the result of EXP definitely a fixnum?
+  (define (exp-result-fixnum? exp)
+    (define (s64? n)
+      (and (number? n) (exact-integer? n)
+           (<= (ash -1 63) n (1- (ash 1 63)))))
+    (match exp
+      ((or ($ $primcall 's64->scm #f (_))
+           ($ $const (? s64?))
+           ($ $primcall 'load-const/unlikely (? s64?) ()))
+       #t)
+      (_ #f)))
+
+  (compute-specializable-vars cps body preds defs exp-result-fixnum?
+                              '(scm->s64)))
+
 (define (compute-phi-vars cps preds)
   (intmap-fold (lambda (label preds phis)
                  (match preds
@@ -578,18 +850,22 @@ BITS indicating the significant bits needed for a variable.  BITS may be
 ;; whose definitions are always f64-valued or u64-valued, and which have
 ;; at least one use that is an unbox operation.
 (define (compute-specializable-phis cps body preds defs)
-  (let ((f64-vars (compute-specializable-f64-vars cps body preds defs))
-        (u64-vars (compute-specializable-u64-vars cps body preds defs))
-        (phi-vars (compute-phi-vars cps preds)))
-    (unless (eq? empty-intset (intset-intersect f64-vars u64-vars))
-      (error "expected f64 and u64 vars to be disjoint sets"))
-    (intset-fold (lambda (var out) (intmap-add out var 'u64))
-                 (intset-intersect u64-vars phi-vars)
-                 (intset-fold (lambda (var out) (intmap-add out var 'f64))
-                              (intset-intersect f64-vars phi-vars)
-                              empty-intmap))))
-
-;; Each definition of an f64/u64 variable should unbox that variable.
+  (let ((phi-vars (compute-phi-vars cps preds)))
+    (fold1 (lambda (in out)
+             (match in
+               ((kind vars)
+                (intset-fold
+                 (lambda (var out)
+                   (intmap-add out var kind (lambda (old new) old)))
+                 (intset-intersect phi-vars vars)
+                 out))))
+           `((f64 ,(compute-specializable-f64-vars cps body preds defs))
+             (fx ,(compute-specializable-fixnum-vars cps body preds defs))
+             (s64 ,(compute-specializable-s64-vars cps body preds defs))
+             (u64 ,(compute-specializable-u64-vars cps body preds defs)))
+           empty-intmap)))
+
+;; Each definition of a f64/u64 variable should unbox that variable.
 ;; The cont that binds the variable should re-box it under its original
 ;; name, and rely on CSE to remove the boxing as appropriate.
 (define (apply-specialization cps kfun body preds defs phis)
@@ -603,10 +879,14 @@ BITS indicating the significant bits needed for a variable.  BITS may be
   (define (unbox-op var)
     (match (intmap-ref phis var)
       ('f64 'scm->f64)
+      ('fx 'untag-fixnum)
+      ('s64 'scm->s64)
       ('u64 'scm->u64)))
   (define (box-op var)
     (match (intmap-ref phis var)
       ('f64 'f64->scm)
+      ('fx 'tag-fixnum)
+      ('s64 's64->scm)
       ('u64 'u64->scm)))
   (define (unbox-operands)
     (define (unbox-arg cps arg def-var have-arg)
@@ -616,7 +896,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
             (let$ body (have-arg unboxed))
             (letk kunboxed ($kargs ('unboxed) (unboxed) ,body))
             (build-term
-              ($continue kunboxed #f ($primcall (unbox-op def-var) (arg)))))
+              ($continue kunboxed #f ($primcall (unbox-op def-var) #f (arg)))))
           (have-arg cps arg)))
     (define (unbox-args cps args def-vars have-args)
       (match args
@@ -655,7 +935,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
                      (letv boxed)
                      (letk kunbox ($kargs ('boxed) (boxed)
                                     ($continue k src
-                                      ($primcall (unbox-op def) (boxed)))))
+                                      ($primcall (unbox-op def) #f (boxed)))))
                      (setk label ($kargs names vars
                                    ($continue kunbox src ,exp)))))))))))))
      (compute-unbox-labels)
@@ -685,7 +965,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
                       (letk kboxed ($kargs (name) (var) ,term))
                       (build-term
                         ($continue kboxed #f
-                          ($primcall (box-op var) (unboxed)))))
+                          ($primcall (box-op var) #f (unboxed)))))
                     (done cps))))
             (define (box-vars cps names vars done)
               (match vars
diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm
index a52e34456..51c10a2ff 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015, 2017-2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -31,17 +31,72 @@
   #:use-module (language cps intmap)
   #:export (specialize-primcalls))
 
+(define (compute-defining-expressions conts)
+  (define (meet-defining-expressions old new)
+    ;; If there are multiple definitions and they are different, punt
+    ;; and record #f.
+    (if (equal? old new)
+        old
+        #f))
+  (persistent-intmap
+   (intmap-fold (lambda (label cont defs)
+                  (match cont
+                    (($ $kargs _ _ ($ $continue k src exp))
+                     (match (intmap-ref conts k)
+                       (($ $kargs (_) (var))
+                        (intmap-add! defs var exp meet-defining-expressions))
+                       (_ defs)))
+                    (_ defs)))
+                conts
+                empty-intmap)))
+
+(define (compute-constant-values conts)
+  (let ((defs (compute-defining-expressions conts)))
+    (persistent-intmap
+     (intmap-fold
+      (lambda (var exp out)
+        (match exp
+          (($ $primcall (or 'load-f64 'load-u64 'load-s64) val ())
+           (intmap-add! out var val))
+          ;; Punch through type conversions to allow uadd to specialize
+          ;; to uadd/immediate.
+          (($ $primcall 'scm->f64 #f (val))
+           (let ((f64 (intmap-ref out val (lambda (_) #f))))
+             (if (and f64 (number? f64) (inexact? f64) (real? f64))
+                 (intmap-add! out var f64)
+                 out)))
+          (($ $primcall (or 'scm->u64 'scm->u64/truncate) #f (val))
+           (let ((u64 (intmap-ref out val (lambda (_) #f))))
+             (if (and u64 (number? u64) (exact-integer? u64)
+                      (<= 0 u64 #xffffFFFFffffFFFF))
+                 (intmap-add! out var u64)
+                 out)))
+          (($ $primcall 'scm->s64 #f (val))
+           (let ((s64 (intmap-ref out val (lambda (_) #f))))
+             (if (and s64 (number? s64) (exact-integer? s64)
+                      (<= (- #x8000000000000000) s64 #x7fffFFFFffffFFFF))
+                 (intmap-add! out var s64)
+                 out)))
+          (_ out)))
+      defs
+      (intmap-fold (lambda (var exp out)
+                     (match exp
+                       (($ $const val)
+                        (intmap-add! out var val))
+                       (_ out)))
+                   defs
+                   empty-intmap)))))
+
 (define (specialize-primcalls conts)
   (let ((constants (compute-constant-values conts)))
-    (define (u6? var)
+    (define (uint? var)
       (let ((val (intmap-ref constants var (lambda (_) #f))))
-        (and (exact-integer? val) (<= 0 val 63))))
-    (define (u8? var)
-      (let ((val (intmap-ref constants var (lambda (_) #f))))
-        (and (exact-integer? val) (<= 0 val 255))))
+        (and (exact-integer? val) (<= 0 val))))
     (define (u64? var)
       (let ((val (intmap-ref constants var (lambda (_) #f))))
         (and (exact-integer? val) (<= 0 val #xffffFFFFffffFFFF))))
+    (define (num? var)
+      (number? (intmap-ref constants var (lambda (_) #f))))
     (define (s64? var)
       (let ((val (intmap-ref constants var (lambda (_) #f))))
         (and (exact-integer? val)
@@ -49,39 +104,58 @@
     (define (f64? var)
       (let ((val (intmap-ref constants var (lambda (_) #f))))
         (and (number? val) (inexact? val) (real? val))))
-    (define (specialize-primcall name args)
+    (define (specialize-primcall name param args)
       (define (rename name)
-        (build-exp ($primcall name args)))
-      (match (cons name args)
-        (('make-vector (? u8? n) init) (rename 'make-vector/immediate))
-        (('vector-ref v (? u8? n)) (rename 'vector-ref/immediate))
-        (('vector-set! v (? u8? n) x) (rename 'vector-set!/immediate))
-        (('allocate-struct v (? u8? n)) (rename 'allocate-struct/immediate))
-        (('struct-ref s (? u8? n)) (rename 'struct-ref/immediate))
-        (('struct-set! s (? u8? n) x) (rename 'struct-set!/immediate))
-        (('add x (? u8? y)) (build-exp ($primcall 'add/immediate (x y))))
-        (('add (? u8? x) y) (build-exp ($primcall 'add/immediate (y x))))
-        (('sub x (? u8? y)) (build-exp ($primcall 'sub/immediate (x y))))
-        (('uadd x (? u8? y)) (build-exp ($primcall 'uadd/immediate (x y))))
-        (('uadd (? u8? x) y) (build-exp ($primcall 'uadd/immediate (y x))))
-        (('usub x (? u8? y)) (build-exp ($primcall 'usub/immediate (x y))))
-        (('umul x (? u8? y)) (build-exp ($primcall 'umul/immediate (x y))))
-        (('umul (? u8? x) y) (build-exp ($primcall 'umul/immediate (y x))))
-        (('ursh x (? u6? y)) (build-exp ($primcall 'ursh/immediate (x y))))
-        (('ulsh x (? u6? y)) (build-exp ($primcall 'ulsh/immediate (x y))))
-        (('scm->f64 (? f64?)) (rename 'load-f64))
-        (('scm->u64 (? u64?)) (rename 'load-u64))
-        (('scm->u64/truncate (? u64?)) (rename 'load-u64))
-        (('scm->s64 (? s64?)) (rename 'load-s64))
-        (_ #f)))
+        (build-exp ($primcall name param args)))
+      (define-syntax compute-constant
+        (syntax-rules ()
+          ((_ (c exp) body)
+           (let* ((c (intmap-ref constants c)) (c exp)) body))
+          ((_ c body) (compute-constant (c c) body))))
+      (define-syntax-rule (specialize-case (pat (op c (arg ...))) ...)
+        (match (cons name args)
+          (pat
+           (let* ((param* (intmap-ref constants c))
+                  (param (if param (cons param param*) param*)))
+             (build-exp ($primcall 'op param (arg ...)))))
+          ...
+          (_ #f)))
+      (specialize-case
+        (('allocate-words (? uint? n)) (allocate-words/immediate n ()))
+        (('scm-ref o (? uint? i)) (scm-ref/immediate i (o)))
+        (('scm-set! o (? uint? i) x) (scm-set!/immediate i (o x)))
+        ;; Assume (tail-)pointer-ref/immediate can always be emitted directly.
+        (('word-ref o (? uint? i)) (word-ref/immediate i (o)))
+        (('word-set! o (? uint? i) x) (word-set!/immediate i (o x)))
+        (('add x (? num? y)) (add/immediate y (x)))
+        (('add (? num? y) x) (add/immediate y (x)))
+        (('sub x (? num? y)) (sub/immediate y (x)))
+        (('uadd x (? uint? y)) (uadd/immediate y (x)))
+        (('uadd (? uint? y) x) (uadd/immediate y (x)))
+        (('usub x (? uint? y)) (usub/immediate y (x)))
+        (('umul x (? uint? y)) (umul/immediate y (x)))
+        (('umul (? uint? y) x) (umul/immediate y (x)))
+        (('scm->f64 (? f64? var)) (load-f64 var ()))
+        (('scm->u64 (? u64? var)) (load-u64 var ()))
+        (('scm->u64/truncate (? u64? var)) (load-u64 var ()))
+        (('scm->s64 (? s64? var)) (load-s64 var ()))
+        (('untag-fixnum (? s64? var)) (load-s64 var ()))
+        (('untag-char (? u64? var)) (load-u64 var ()))
+        ;; FIXME: add support for tagging immediate chars
+        ;; (('tag-char (? u64? var)) (load-const var ()))
+        ))
     (intmap-map
      (lambda (label cont)
        (match cont
-         (($ $kargs names vars ($ $continue k src ($ $primcall name args)))
-          (let ((exp* (specialize-primcall name args)))
+         (($ $kargs names vars ($ $continue k src ($ $primcall name param args)))
+          (let ((exp* (specialize-primcall name param args)))
             (if exp*
                 (build-cont
                   ($kargs names vars ($continue k src ,exp*)))
                 cont)))
          (_ cont)))
      conts)))
+
+;;; Local Variables:
+;;; eval: (put 'specialize-case 'scheme-indent-function 0)
+;;; End:
diff --git a/module/language/cps/split-rec.scm b/module/language/cps/split-rec.scm
index 2551ac643..ee5f2f2e4 100644
--- a/module/language/cps/split-rec.scm
+++ b/module/language/cps/split-rec.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -70,32 +70,34 @@ references."
             (intset-fold
              (lambda (label defs uses)
                (match (intmap-ref conts label)
-                 (($ $kargs names vars ($ $continue k src exp))
+                 (($ $kargs names vars term)
                   (values
                    (add-defs vars defs)
-                   (match exp
-                     ((or ($ $const) ($ $prim)) uses)
-                     (($ $fun kfun)
-                      (intset-union (persistent-intset uses)
-                                    (intmap-ref free kfun)))
-                     (($ $rec names vars (($ $fun kfun) ...))
-                      (fold (lambda (kfun uses)
-                              (intset-union (persistent-intset uses)
-                                            (intmap-ref free kfun)))
-                            uses kfun))
-                     (($ $values args)
+                   (match term
+                     (($ $continue k src exp)
+                      (match exp
+                        ((or ($ $const) ($ $prim)) uses)
+                        (($ $fun kfun)
+                         (intset-union (persistent-intset uses)
+                                       (intmap-ref free kfun)))
+                        (($ $rec names vars (($ $fun kfun) ...))
+                         (fold (lambda (kfun uses)
+                                 (intset-union (persistent-intset uses)
+                                               (intmap-ref free kfun)))
+                               uses kfun))
+                        (($ $values args)
+                         (add-uses args uses))
+                        (($ $call proc args)
+                         (add-use proc (add-uses args uses)))
+                        (($ $primcall name param args)
+                         (add-uses args uses))))
+                     (($ $branch kf kt src op param args)
                       (add-uses args uses))
-                     (($ $call proc args)
-                      (add-use proc (add-uses args uses)))
-                     (($ $branch kt ($ $values (arg)))
-                      (add-use arg uses))
-                     (($ $branch kt ($ $primcall name args))
-                      (add-uses args uses))
-                     (($ $primcall name args)
-                      (add-uses args uses))
-                     (($ $prompt escape? tag handler)
-                      (add-use tag uses)))))
-                 (($ $kfun src meta self)
+                     (($ $prompt k kh src escape? tag)
+                      (add-use tag uses))
+                     (($ $throw src op param args)
+                      (add-uses args uses)))))
+                 (($ $kfun src meta (and self (not #f)))
                   (values (add-def self defs) uses))
                  (_ (values defs uses))))
              body empty-intset empty-intset))
diff --git a/module/language/cps/type-checks.scm b/module/language/cps/type-checks.scm
index 864371d28..029acdfcd 100644
--- a/module/language/cps/type-checks.scm
+++ b/module/language/cps/type-checks.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -39,8 +39,8 @@
   "Elide &type-check effects from EFFECTS for the function starting at
 KFUN where we can prove that no assertion will be raised at run-time."
   (let ((types (infer-types conts kfun)))
-    (define (visit-primcall effects fx label name args)
-      (if (primcall-types-check? types label name args)
+    (define (visit-primcall effects fx label name param args)
+      (if (primcall-types-check? types label name param args)
           (intmap-replace! effects label (logand fx (lognot &type-check)))
           effects))
     (persistent-intmap
@@ -50,14 +50,12 @@ KFUN where we can prove that no assertion will be raised at run-time."
                        ((causes-all-effects? fx) effects)
                        ((causes-effect? fx &type-check)
                         (match (intmap-ref conts label)
-                          (($ $kargs _ _ exp)
-                           (match exp
-                             (($ $continue k src ($ $primcall name args))
-                              (visit-primcall effects fx label name args))
-                             (($ $continue k src
-                                 ($ $branch _ ($primcall name args)))
-                              (visit-primcall effects fx label name args))
-                             (_ effects)))
+                          (($ $kargs names vars
+                              ($ $continue k src ($ $primcall name param args)))
+                           (visit-primcall effects fx label name param args))
+                          (($ $kargs names vars
+                              ($ $branch kf kt src name param args))
+                           (visit-primcall effects fx label name param args))
                           (_ effects)))
                        (else effects))))
                   types
diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index 163ef659d..405806626 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -1,5 +1,5 @@
 ;;; Abstract constant folding on CPS
-;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -41,44 +41,92 @@
 ;; Branch folders.
 
 (define &scalar-types
-  (logior &exact-integer &flonum &char &unspecified &false &true &nil &null))
+  (logior &fixnum &bignum &flonum &char &special-immediate))
 
 (define *branch-folders* (make-hash-table))
 
-(define-syntax-rule (define-branch-folder name f)
-  (hashq-set! *branch-folders* 'name f))
+(define-syntax-rule (define-branch-folder op f)
+  (hashq-set! *branch-folders* 'op f))
 
 (define-syntax-rule (define-branch-folder-alias to from)
   (hashq-set! *branch-folders* 'to (hashq-ref *branch-folders* 'from)))
 
-(define-syntax-rule (define-unary-branch-folder (name arg min max) body ...)
-  (define-branch-folder name (lambda (arg min max) body ...)))
+(define-syntax-rule (define-unary-branch-folder* (op param arg min max)
+                      body ...)
+  (define-branch-folder op (lambda (param arg min max) body ...)))
+
+(define-syntax-rule (define-unary-branch-folder (op arg min max) body ...)
+  (define-unary-branch-folder* (op param arg min max) body ...))
 
-(define-syntax-rule (define-binary-branch-folder (name arg0 min0 max0
+(define-syntax-rule (define-binary-branch-folder (op arg0 min0 max0
                                                        arg1 min1 max1)
                       body ...)
-  (define-branch-folder name (lambda (arg0 min0 max0 arg1 min1 max1) body ...)))
+  (define-branch-folder op (lambda (param arg0 min0 max0 arg1 min1 max1) body ...)))
+
+(define-syntax-rule (define-special-immediate-predicate-folder op imin imax)
+  (define-unary-branch-folder (op type min max)
+    (let ((type* (logand type &special-immediate)))
+      (cond
+       ((zero? (logand type &special-immediate)) (values #t #f))
+       ((eqv? type &special-immediate)
+        (cond
+         ((or (< imax min) (< max imin)) (values #t #f))
+         ((<= imin min max imax) (values #t #t))
+         (else (values #f #f))))
+       (else (values #f #f))))))
 
-(define-syntax-rule (define-unary-type-predicate-folder name &type)
-  (define-unary-branch-folder (name type min max)
+(define-special-immediate-predicate-folder eq-nil? &nil &nil)
+(define-special-immediate-predicate-folder eq-eol? &null &null)
+(define-special-immediate-predicate-folder eq-false? &false &false)
+(define-special-immediate-predicate-folder eq-true? &true &true)
+(define-special-immediate-predicate-folder unspecified? &unspecified &unspecified)
+(define-special-immediate-predicate-folder undefined? &undefined &undefined)
+(define-special-immediate-predicate-folder eof-object? &eof &eof)
+(define-special-immediate-predicate-folder null? &null &nil)
+(define-special-immediate-predicate-folder false? &nil &false)
+(define-special-immediate-predicate-folder nil? &null &false) ;; &nil in middle
+
+(define-syntax-rule (define-unary-type-predicate-folder op &type)
+  (define-unary-branch-folder (op type min max)
     (let ((type* (logand type &type)))
       (cond
        ((zero? type*) (values #t #f))
        ((eqv? type type*) (values #t #t))
        (else (values #f #f))))))
 
+(define-unary-branch-folder (heap-object? type min max)
+  (define &immediate-types (logior &fixnum &char &special-immediate))
+  (cond
+   ((zero? (logand type &immediate-types)) (values #t #t))
+   ((type<=? type &immediate-types) (values #t #f))
+   (else (values #f #f))))
+
+(define-unary-branch-folder (heap-number? type min max)
+  (define &types (logior &bignum &flonum &fraction &complex))
+  (cond
+   ((zero? (logand type &types)) (values #t #f))
+   ((type<=? type &types) (values #t #t))
+   (else (values #f #f))))
+
 ;; All the cases that are in compile-bytecode.
+(define-unary-type-predicate-folder fixnum? &fixnum)
+(define-unary-type-predicate-folder bignum? &bignum)
 (define-unary-type-predicate-folder pair? &pair)
-(define-unary-type-predicate-folder null? (logior &nil &null))
-(define-unary-type-predicate-folder nil? (logior &false &nil &null))
 (define-unary-type-predicate-folder symbol? &symbol)
 (define-unary-type-predicate-folder variable? &box)
-(define-unary-type-predicate-folder vector? &vector)
+(define-unary-type-predicate-folder mutable-vector? &mutable-vector)
+(define-unary-type-predicate-folder immutable-vector? &immutable-vector)
 (define-unary-type-predicate-folder struct? &struct)
 (define-unary-type-predicate-folder string? &string)
 (define-unary-type-predicate-folder number? &number)
 (define-unary-type-predicate-folder char? &char)
 
+(define-unary-branch-folder (vector? type min max)
+  (cond
+   ((zero? (logand type &vector)) (values #t #f))
+   ((type<=? type &vector) (values #t #t))
+   (else (values #f #f))))
+
 (define-binary-branch-folder (eq? type0 min0 max0 type1 min1 max1)
   (cond
    ((or (zero? (logand type0 type1)) (< max0 min1) (< max1 min0))
@@ -90,13 +138,10 @@
     (values #t #t))
    (else
     (values #f #f))))
-(define-branch-folder-alias eqv? eq?)
+(define-branch-folder-alias heap-numbers-equal? eq?)
 
-(define (compare-ranges type0 min0 max0 type1 min1 max1)
-  ;; Since &real, &u64, and &f64 are disjoint, we can compare once
-  ;; against their mask instead of doing three "or" comparisons.
-  (and (zero? (logand (logior type0 type1) (lognot (logior &real &f64 &u64))))
-       (cond ((< max0 min1) '<)
+(define (compare-exact-ranges min0 max0 min1 max1)
+  (and (cond ((< max0 min1) '<)
              ((> min0 max1) '>)
              ((= min0 max0 min1 max1) '=)
              ((<= max0 min1) '<=)
@@ -104,12 +149,18 @@
              (else #f))))
 
 (define-binary-branch-folder (< type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
+  (if (type<=? (logior type0 type1) &exact-number)
+      (case (compare-exact-ranges min0 max0 min1 max1)
+        ((<) (values #t #t))
+        ((= >= >) (values #t #f))
+        (else (values #f #f)))
+      (values #f #f)))
+(define-binary-branch-folder (u64-< type0 min0 max0 type1 min1 max1)
+  (case (compare-exact-ranges min0 max0 min1 max1)
     ((<) (values #t #t))
     ((= >= >) (values #t #f))
     (else (values #f #f))))
-(define-branch-folder-alias u64-< <)
-(define-branch-folder-alias u64-<-scm <)
+(define-branch-folder-alias s64-< u64-<)
 ;; We currently cannot define branch folders for floating point
 ;; comparison ops like the commented one below because we can't prove
 ;; there are no nans involved.
@@ -117,50 +168,116 @@
 ;; (define-branch-folder-alias f64-< <)
 
 (define-binary-branch-folder (<= type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
-    ((< <= =) (values #t #t))
-    ((>) (values #t #f))
-    (else (values #f #f))))
-(define-branch-folder-alias u64-<= <=)
-(define-branch-folder-alias u64-<=-scm <=)
+  (if (type<=? (logior type0 type1) &exact-number)
+      (case (compare-exact-ranges min0 max0 min1 max1)
+        ((< <= =) (values #t #t))
+        ((>) (values #t #f))
+        (else (values #f #f)))
+      (values #f #f)))
+
+(define-unary-branch-folder* (u64-imm-= c type min max)
+  (cond
+   ((= c min max) (values #t #t))
+   ((<= min c max) (values #f #f))
+   (else (values #t #f))))
+(define-branch-folder-alias s64-imm-= u64-imm-=)
+
+(define-unary-branch-folder* (u64-imm-< c type min max)
+  (cond
+   ((< max c) (values #t #t))
+   ((>= min c) (values #t #f))
+   (else (values #f #f))))
+(define-branch-folder-alias s64-imm-< u64-imm-<)
+
+(define-unary-branch-folder* (imm-u64-< c type min max)
+  (cond
+   ((< c min) (values #t #t))
+   ((>= c max) (values #t #f))
+   (else (values #f #f))))
+(define-branch-folder-alias imm-s64-< imm-u64-<)
 
 (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
+  (cond
+   ((not (type<=? (logior type0 type1) &exact-number))
+    (values #f #f))
+   ((zero? (logand type0 type1))
+    ;; If both values are exact but of different types, they are not
+    ;; equal.
+    (values #t #f))
+   (else
+    (case (compare-exact-ranges min0 max0 min1 max1)
+      ((=) (values #t #t))
+      ((< >) (values #t #f))
+      (else (values #f #f))))))
+(define-binary-branch-folder (u64-= type0 min0 max0 type1 min1 max1)
+  (case (compare-exact-ranges min0 max0 min1 max1)
     ((=) (values #t #t))
     ((< >) (values #t #f))
     (else (values #f #f))))
-(define-branch-folder-alias u64-= =)
-(define-branch-folder-alias u64-=-scm =)
+(define-branch-folder-alias s64-= u64-=)
 
-(define-binary-branch-folder (>= type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
-    ((> >= =) (values #t #t))
-    ((<) (values #t #f))
-    (else (values #f #f))))
-(define-branch-folder-alias u64->= >=)
-(define-branch-folder-alias u64->=-scm >=)
 
-(define-binary-branch-folder (> type0 min0 max0 type1 min1 max1)
-  (case (compare-ranges type0 min0 max0 type1 min1 max1)
-    ((>) (values #t #t))
-    ((= <= <) (values #t #f))
-    (else (values #f #f))))
-(define-branch-folder-alias u64-> >)
-(define-branch-folder-alias u64->-scm >)
-
-(define-binary-branch-folder (logtest type0 min0 max0 type1 min1 max1)
-  (define (logand-min a b)
-    (if (< a b 0)
-        (min a b)
-        0))
-  (define (logand-max a b)
-    (if (< a b 0)
-        0
-        (max a b)))
-  (if (and (= min0 max0) (= min1 max1) (eqv? type0 type1 &exact-integer))
-      (values #t (logtest min0 min1))
-      (values #f #f)))
+
+
+;; Convert e.g. rsh to rsh/immediate.
+
+(define *primcall-macro-reducers* (make-hash-table))
+
+(define-syntax-rule (define-primcall-macro-reducer op f)
+  (hashq-set! *primcall-macro-reducers* 'op f))
+
+(define-syntax-rule (define-unary-primcall-macro-reducer (op cps k src
+                                                             arg type min max)
+                      body ...)
+  (define-primcall-macro-reducer op
+    (lambda (cps k src param arg type min max)
+      body ...)))
+
+(define-syntax-rule (define-binary-primcall-macro-reducer
+                      (op cps k src
+                          arg0 type0 min0 max0
+                          arg1 type1 min1 max1)
+                      body ...)
+  (define-primcall-macro-reducer op
+    (lambda (cps k src param arg0 type0 min0 max0 arg1 type1 min1 max1)
+      body ...)))
+
+(define-binary-primcall-macro-reducer (mul cps k src
+                                           arg0 type0 min0 max0
+                                           arg1 type1 min1 max1)
+  (cond
+   ((and (type<=? type0 &exact-integer) (= min0 max0))
+    (with-cps cps
+      (build-term
+        ($continue k src ($primcall 'mul/immediate min0 (arg1))))))
+   ((and (type<=? type1 &exact-integer) (= min1 max1))
+    (with-cps cps
+      (build-term
+        ($continue k src ($primcall 'mul/immediate min1 (arg0))))))
+   (else
+    (with-cps cps #f))))
 
+(define-binary-primcall-macro-reducer (lsh cps k src
+                                           arg0 type0 min0 max0
+                                           arg1 type1 min1 max1)
+  (cond
+   ((= min1 max1)
+    (with-cps cps
+      (build-term
+        ($continue k src ($primcall 'lsh/immediate min1 (arg0))))))
+   (else
+    (with-cps cps #f))))
+
+(define-binary-primcall-macro-reducer (rsh cps k src
+                                           arg0 type0 min0 max0
+                                           arg1 type1 min1 max1)
+  (cond
+   ((= min1 max1)
+    (with-cps cps
+      (build-term
+        ($continue k src ($primcall 'rsh/immediate min1 (arg0))))))
+   (else
+    (with-cps cps #f))))
 
 
 
@@ -168,134 +285,142 @@
 
 (define *primcall-reducers* (make-hash-table))
 
-(define-syntax-rule (define-primcall-reducer name f)
-  (hashq-set! *primcall-reducers* 'name f))
+(define-syntax-rule (define-primcall-reducer op f)
+  (hashq-set! *primcall-reducers* 'op f))
 
-(define-syntax-rule (define-unary-primcall-reducer (name cps k src
+(define-syntax-rule (define-unary-primcall-reducer (op cps k src param
                                                     arg type min max)
                       body ...)
-  (define-primcall-reducer name
-    (lambda (cps k src arg type min max)
+  (define-primcall-reducer op
+    (lambda (cps k src param arg type min max)
       body ...)))
 
-(define-syntax-rule (define-binary-primcall-reducer (name cps k src
+(define-syntax-rule (define-binary-primcall-reducer (op cps k src param
                                                      arg0 type0 min0 max0
                                                      arg1 type1 min1 max1)
                       body ...)
-  (define-primcall-reducer name
-    (lambda (cps k src arg0 type0 min0 max0 arg1 type1 min1 max1)
+  (define-primcall-reducer op
+    (lambda (cps k src param arg0 type0 min0 max0 arg1 type1 min1 max1)
       body ...)))
 
-(define-binary-primcall-reducer (mul cps k src
-                                     arg0 type0 min0 max0
-                                     arg1 type1 min1 max1)
-  (define (fail) (with-cps cps #f))
-  (define (negate arg)
+(define-unary-primcall-reducer (mul/immediate cps k src constant
+                                              arg type min max)
+  (cond
+   ((not (type<=? type &number))
+    (with-cps cps #f))
+   ((eqv? constant -1)
+    ;; (* arg -1) -> (- 0 arg)
     (with-cps cps
       ($ (with-cps-constants ((zero 0))
            (build-term
-             ($continue k src ($primcall 'sub (zero arg))))))))
-  (define (zero)
+             ($continue k src ($primcall 'sub #f (zero arg))))))))
+   ((and (eqv? constant 0) (type<=? type &exact-number))
+    ;; (* arg 0) -> 0 if arg is exact
     (with-cps cps
       (build-term ($continue k src ($const 0)))))
-  (define (identity arg)
+   ((eqv? constant 1)
+    ;; (* arg 1) -> arg
     (with-cps cps
       (build-term ($continue k src ($values (arg))))))
-  (define (double arg)
+   ((eqv? constant 2)
+    ;; (* arg 2) -> (+ arg arg)
     (with-cps cps
-      (build-term ($continue k src ($primcall 'add (arg arg))))))
-  (define (power-of-two constant arg)
+      (build-term ($continue k src ($primcall 'add #f (arg arg))))))
+   ((and (type<=? type &exact-integer)
+         (positive? constant)
+         (zero? (logand constant (1- constant))))
+    ;; (* arg power-of-2) -> (lsh arg (log2 power-of-2))
     (let ((n (let lp ((bits 0) (constant constant))
                (if (= constant 1) bits (lp (1+ bits) (ash constant -1))))))
       (with-cps cps
-        ($ (with-cps-constants ((bits n))
-             (build-term ($continue k src ($primcall 'ash (arg bits)))))))))
-  (define (mul/constant constant constant-type arg arg-type)
-    (cond
-     ((not (or (= constant-type &exact-integer) (= constant-type arg-type)))
-      (fail))
-     ((eqv? constant -1)
-      ;; (* arg -1) -> (- 0 arg)
-      (negate arg))
-     ((eqv? constant 0)
-      ;; (* arg 0) -> 0 if arg is not a flonum or complex
-      (and (= constant-type &exact-integer)
-           (zero? (logand arg-type
-                          (lognot (logior &flonum &complex))))
-           (zero)))
-     ((eqv? constant 1)
-      ;; (* arg 1) -> arg
-      (identity arg))
-     ((eqv? constant 2)
-      ;; (* arg 2) -> (+ arg arg)
-      (double arg))
-     ((and (= constant-type arg-type &exact-integer)
-           (positive? constant)
-           (zero? (logand constant (1- constant))))
-      ;; (* arg power-of-2) -> (ash arg (log2 power-of-2
-      (power-of-two constant arg))
-     (else
-      (fail))))
-  (cond
-   ((logtest (logior type0 type1) (lognot &number)) (fail))
-   ((= min0 max0) (mul/constant min0 type0 arg1 type1))
-   ((= min1 max1) (mul/constant min1 type1 arg0 type0))
-   (else (fail))))
+        (build-term ($continue k src ($primcall 'lsh/immediate n (arg)))))))
+   (else
+    (with-cps cps #f))))
 
-(define-binary-primcall-reducer (logbit? cps k src
+(define-binary-primcall-reducer (logbit? cps k src param
                                          arg0 type0 min0 max0
                                          arg1 type1 min1 max1)
-  (define (convert-to-logtest cps kbool)
-    (define (compute-mask cps kmask src)
-      (if (eq? min0 max0)
-          (with-cps cps
-            (build-term
-              ($continue kmask src ($const (ash 1 min0)))))
-          (with-cps cps
-            ($ (with-cps-constants ((one 1))
-                 (build-term
-                   ($continue kmask src ($primcall 'ash (one arg0)))))))))
+  (define (compute-mask cps kmask src)
+    (if (eq? min0 max0)
+        (with-cps cps
+          (build-term
+            ($continue kmask src ($const (ash 1 min0)))))
+        (with-cps cps
+          ($ (with-cps-constants ((one 1))
+               (letv n)
+               (letk kn ($kargs ('n) (n)
+                          ($continue kmask src
+                            ($primcall 'lsh #f (one n)))))
+               (build-term
+                 ($continue kn src ($primcall 'untag-fixnum #f (arg0)))))))))
+  (cond
+   ((and (type<=? type0 &exact-integer)
+         (<= 0 min0 (target-most-positive-fixnum))
+         (<= 0 max0 (target-most-positive-fixnum)))
     (with-cps cps
-      (letv mask)
-      (letk kt ($kargs () ()
-                 ($continue kbool src ($const #t))))
-      (letk kf ($kargs () ()
-                 ($continue kbool src ($const #f))))
+      (letv mask res u64)
+      (letk kt ($kargs () () ($continue k src ($const #t))))
+      (letk kf ($kargs () () ($continue k src ($const #f))))
+      (letk ku64 ($kargs (#f) (u64)
+                   ($branch kt kf src 's64-imm-= 0 (u64))))
+      (letk kand ($kargs (#f) (res)
+                   ($continue ku64 src ($primcall 'untag-fixnum #f (res)))))
       (letk kmask ($kargs (#f) (mask)
-                    ($continue kf src
-                      ($branch kt ($primcall 'logtest (mask arg1))))))
+                    ($continue kand src
+                      ($primcall 'logand #f (mask arg1)))))
       ($ (compute-mask kmask src))))
-  ;; Hairiness because we are converting from a primcall with unknown
-  ;; arity to a branching primcall.
-  (let ((positive-fixnum-bits (- (* (target-word-size) 8) 3)))
-    (if (and (= type0 &exact-integer)
-             (<= 0 min0 positive-fixnum-bits)
-             (<= 0 max0 positive-fixnum-bits))
-        (match (intmap-ref cps k)
-          (($ $kreceive arity kargs)
-           (match arity
-             (($ $arity (_) () (not #f) () #f)
-              (with-cps cps
-                (letv bool)
-                (let$ body (with-cps-constants ((nil '()))
-                             (build-term
-                               ($continue kargs src ($values (bool nil))))))
-                (letk kbool ($kargs (#f) (bool) ,body))
-                ($ (convert-to-logtest kbool))))
-             (_
-              (with-cps cps
-                (letv bool)
-                (letk kbool ($kargs (#f) (bool)
-                              ($continue k src ($primcall 'values (bool)))))
-                ($ (convert-to-logtest kbool))))))
-          (($ $ktail)
-           (with-cps cps
-             (letv bool)
-             (letk kbool ($kargs (#f) (bool)
-                           ($continue k src ($values (bool)))))
-             ($ (convert-to-logtest kbool)))))
-        (with-cps cps #f))))
+   (else
+    (with-cps cps #f))))
 
+(define-unary-primcall-reducer (u64->scm cps k src constant arg type min max)
+  (cond
+   ((<= max (target-most-positive-fixnum))
+    (with-cps cps
+      (letv s64)
+      (letk ks64 ($kargs ('s64) (s64)
+                   ($continue k src
+                     ($primcall 'tag-fixnum #f (s64)))))
+      (build-term
+        ($continue ks64 src
+          ($primcall 'u64->s64 #f (arg))))))
+   (else
+    (with-cps cps #f))))
+
+(define-unary-primcall-reducer (s64->scm cps k src constant arg type min max)
+  (cond
+   ((<= (target-most-negative-fixnum) min max (target-most-positive-fixnum))
+    (with-cps cps
+      (build-term
+        ($continue k src
+          ($primcall 'tag-fixnum #f (arg))))))
+   (else
+    (with-cps cps #f))))
+
+(define-unary-primcall-reducer (scm->s64 cps k src constant arg type min max)
+  (cond
+   ((and (type<=? type &exact-integer)
+         (<= (target-most-negative-fixnum) min max (target-most-positive-fixnum)))
+    (with-cps cps
+      (build-term
+        ($continue k src
+          ($primcall 'untag-fixnum #f (arg))))))
+   (else
+    (with-cps cps #f))))
+
+(define-unary-primcall-reducer (scm->u64 cps k src constant arg type min max)
+  (cond
+   ((and (type<=? type &exact-integer)
+         (<= 0 min max (target-most-positive-fixnum)))
+    (with-cps cps
+      (letv s64)
+      (letk ks64 ($kargs ('s64) (s64)
+                   ($continue k src
+                     ($primcall 's64->u64 #f (s64)))))
+      (build-term
+        ($continue ks64 src
+          ($primcall 'untag-fixnum #f (arg))))))
+   (else
+    (with-cps cps #f))))
 
 
 
@@ -304,17 +429,23 @@
 (define (local-type-fold start end cps)
   (define (scalar-value type val)
     (cond
-     ((eqv? type &exact-integer) val)
+     ((eqv? type &fixnum) val)
+     ((eqv? type &bignum) val)
      ((eqv? type &flonum) (exact->inexact val))
      ((eqv? type &char) (integer->char val))
-     ((eqv? type &unspecified) *unspecified*)
-     ((eqv? type &false) #f)
-     ((eqv? type &true) #t)
-     ((eqv? type &nil) #nil)
-     ((eqv? type &null) '())
+     ((eqv? type &special-immediate)
+      (cond
+       ((eqv? val &null) '())
+       ((eqv? val &nil) #nil)
+       ((eqv? val &false) #f)
+       ((eqv? val &true) #t)
+       ((eqv? val &unspecified) *unspecified*)
+       ;; FIXME: &undefined here
+       ((eqv? val &eof) the-eof-object)
+       (else (error "unhandled immediate" val))))
      (else (error "unhandled type" type val))))
   (let ((types (infer-types cps start)))
-    (define (fold-primcall cps label names vars k src name args def)
+    (define (fold-primcall cps label names vars k src op param args def)
       (call-with-values (lambda () (lookup-post-type types label def 0))
         (lambda (type min max)
           (and (not (zero? type))
@@ -322,7 +453,7 @@
                (zero? (logand type (lognot &scalar-types)))
                (eqv? min max)
                (let ((val (scalar-value type min)))
-                 ;; (pk 'folded src name args val)
+                 ;; (pk 'folded src op args val)
                  (with-cps cps
                    (letv v*)
                    (letk k* ($kargs (#f) (v*)
@@ -331,109 +462,103 @@
                    ;; possible.
                    (setk label
                          ($kargs names vars
-                           ($continue k* src ($primcall name args))))))))))
-    (define (reduce-primcall cps label names vars k src name args)
-      (and=>
-       (hashq-ref *primcall-reducers* name)
-       (lambda (reducer)
-         (match args
-           ((arg0)
-            (call-with-values (lambda () (lookup-pre-type types label arg0))
-              (lambda (type0 min0 max0)
-                (call-with-values (lambda ()
-                                    (reducer cps k src arg0 type0 min0 max0))
-                  (lambda (cps term)
-                    (and term
-                         (with-cps cps
-                           (setk label ($kargs names vars ,term)))))))))
-           ((arg0 arg1)
-            (call-with-values (lambda () (lookup-pre-type types label arg0))
-              (lambda (type0 min0 max0)
-                (call-with-values (lambda () (lookup-pre-type types label arg1))
-                  (lambda (type1 min1 max1)
-                    (call-with-values (lambda ()
-                                        (reducer cps k src arg0 type0 min0 max0
-                                                 arg1 type1 min1 max1))
-                      (lambda (cps term)
-                        (and term
-                             (with-cps cps
-                               (setk label ($kargs names vars ,term)))))))))))
-           (_ #f)))))
-    (define (fold-unary-branch cps label names vars kf kt src name arg)
+                           ($continue k* src ($primcall op param args))))))))))
+    (define (transform-primcall f cps label names vars k src op param args)
+      (and f
+           (match args
+             ((arg0)
+              (call-with-values (lambda () (lookup-pre-type types label arg0))
+                (lambda (type0 min0 max0)
+                  (call-with-values (lambda ()
+                                      (f cps k src param arg0 type0 min0 max0))
+                    (lambda (cps term)
+                      (and term
+                           (with-cps cps
+                             (setk label ($kargs names vars ,term)))))))))
+             ((arg0 arg1)
+              (call-with-values (lambda () (lookup-pre-type types label arg0))
+                (lambda (type0 min0 max0)
+                  (call-with-values (lambda () (lookup-pre-type types label arg1))
+                    (lambda (type1 min1 max1)
+                      (call-with-values (lambda ()
+                                          (f cps k src param arg0 type0 min0 max0
+                                             arg1 type1 min1 max1))
+                        (lambda (cps term)
+                          (and term
+                               (with-cps cps
+                                 (setk label ($kargs names vars ,term)))))))))))
+             (_ #f))))
+    (define (reduce-primcall cps label names vars k src op param args)
+      (cond
+       ((transform-primcall (hashq-ref *primcall-macro-reducers* op)
+                            cps label names vars k src op param args)
+        => (lambda (cps)
+             (match (intmap-ref cps label)
+               (($ $kargs names vars
+                   ($ $continue k src ($ $primcall op param args)))
+                (reduce-primcall cps label names vars k src op param args)))))
+       ((transform-primcall (hashq-ref *primcall-reducers* op)
+                            cps label names vars k src op param args))
+       (else cps)))
+    (define (fold-unary-branch cps label names vars kf kt src op param arg)
       (and=>
-       (hashq-ref *branch-folders* name)
+       (hashq-ref *branch-folders* op)
        (lambda (folder)
          (call-with-values (lambda () (lookup-pre-type types label arg))
            (lambda (type min max)
-             (call-with-values (lambda () (folder type min max))
+             (call-with-values (lambda () (folder param type min max))
                (lambda (f? v)
-                 ;; (when f? (pk 'folded-unary-branch label name arg v))
+                 ;; (when f? (pk 'folded-unary-branch label op arg v))
                  (and f?
                       (with-cps cps
                         (setk label
                               ($kargs names vars
                                 ($continue (if v kt kf) src
                                   ($values ())))))))))))))
-    (define (fold-binary-branch cps label names vars kf kt src name arg0 arg1)
+    (define (fold-binary-branch cps label names vars kf kt src op param arg0 arg1)
       (and=>
-       (hashq-ref *branch-folders* name)
+       (hashq-ref *branch-folders* op)
        (lambda (folder)
          (call-with-values (lambda () (lookup-pre-type types label arg0))
            (lambda (type0 min0 max0)
              (call-with-values (lambda () (lookup-pre-type types label arg1))
                (lambda (type1 min1 max1)
                  (call-with-values (lambda ()
-                                     (folder type0 min0 max0 type1 min1 max1))
+                                     (folder param type0 min0 max0 type1 min1 max1))
                    (lambda (f? v)
-                     ;; (when f? (pk 'folded-binary-branch label name arg0 arg1 v))
+                     ;; (when f? (pk 'folded-binary-branch label op arg0 arg1 v))
                      (and f?
                           (with-cps cps
                             (setk label
                                   ($kargs names vars
                                     ($continue (if v kt kf) src
                                       ($values ())))))))))))))))
-    (define (visit-expression cps label names vars k src exp)
-      (match exp
-        (($ $primcall name args)
-         ;; We might be able to fold primcalls that define a value.
-         (match (intmap-ref cps k)
-           (($ $kargs (_) (def))
-            (or (fold-primcall cps label names vars k src name args def)
-                (reduce-primcall cps label names vars k src name args)
-                cps))
-           (_
-            (or (reduce-primcall cps label names vars k src name args)
-                cps))))
-        (($ $branch kt ($ $primcall name args))
-         ;; We might be able to fold primcalls that branch.
-         (match args
-           ((x)
-            (or (fold-unary-branch cps label names vars k kt src name x)
-                cps))
-           ((x y)
-            (or (fold-binary-branch cps label names vars k kt src name x y)
-                cps))))
-        (($ $branch kt ($ $values (arg)))
-         ;; We might be able to fold branches on values.
-         (call-with-values (lambda () (lookup-pre-type types label arg))
-           (lambda (type min max)
-             (cond
-              ((zero? (logand type (logior &false &nil)))
-               (with-cps cps
-                 (setk label
-                       ($kargs names vars ($continue kt src ($values ()))))))
-              ((zero? (logand type (lognot (logior &false &nil))))
-               (with-cps cps
-                 (setk label
-                       ($kargs names vars ($continue k src ($values ()))))))
-              (else cps)))))
-        (_ cps)))
+    (define (visit-primcall cps label names vars k src op param args)
+      ;; We might be able to fold primcalls that define a value.
+      (match (intmap-ref cps k)
+        (($ $kargs (_) (def))
+         (or (fold-primcall cps label names vars k src op param args def)
+             (reduce-primcall cps label names vars k src op param args)))
+        (_
+         (reduce-primcall cps label names vars k src op param args))))
+    (define (visit-branch cps label names vars kf kt src op param args)
+      ;; We might be able to fold primcalls that branch.
+      (match args
+        ((x)
+         (or (fold-unary-branch cps label names vars kf kt src op param x)
+             cps))
+        ((x y)
+         (or (fold-binary-branch cps label names vars kf kt src op param x y)
+             cps))))
     (let lp ((label start) (cps cps))
       (if (<= label end)
           (lp (1+ label)
               (match (intmap-ref cps label)
-                (($ $kargs names vars ($ $continue k src exp))
-                 (visit-expression cps label names vars k src exp))
+                (($ $kargs names vars ($ $continue k src
+                                         ($ $primcall op param args)))
+                 (visit-primcall cps label names vars k src op param args))
+                (($ $kargs names vars ($ $branch kf kt src op param args))
+                 (visit-branch cps label names vars kf kt src op param args))
                 (_ cps)))
           cps))))
 
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 61de971fe..bcf22d391 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1,5 +1,5 @@
 ;;; Type analysis on CPS
-;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -85,28 +85,24 @@
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-11)
   #:use-module ((system syntax internal) #:select (syntax?))
+  #:use-module (system base target)
   #:export (;; Specific types.
-            &exact-integer
+            &fixnum
+            &bignum
             &flonum
             &complex
             &fraction
 
             &char
-            &unspecified
-            &unbound
-            &false
-            &true
-            &nil
-            &null
+            &special-immediate
             &symbol
             &keyword
-
             &procedure
-
             &pointer
             &fluid
             &pair
-            &vector
+            &immutable-vector
+            &mutable-vector
             &box
             &struct
             &string
@@ -114,15 +110,23 @@
             &bitvector
             &array
             &syntax
+            &other-heap-object
+
+            ;; Special immediate values.
+            &null &nil &false &true &unspecified &undefined &eof
 
             ;; Union types.
-            &number &real
+            &exact-integer &exact-number &real &number &vector
 
             ;; Untagged types.
             &f64
             &u64
             &s64
 
+            ;; Helper.
+            type<=?
+
+            ;; Interface for type inference.
             infer-types
             lookup-pre-type
             lookup-post-type
@@ -143,27 +147,23 @@
 
 ;; More precise types have fewer bits.
 (define-flags &all-types &type-bits
-  &exact-integer
+  &fixnum
+  &bignum
   &flonum
   &complex
   &fraction
 
   &char
-  &unspecified
-  &unbound
-  &false
-  &true
-  &nil
-  &null
+  &special-immediate
+
   &symbol
   &keyword
-
   &procedure
-
   &pointer
   &fluid
   &pair
-  &vector
+  &immutable-vector
+  &mutable-vector
   &box
   &struct
   &string
@@ -171,6 +171,7 @@
   &bitvector
   &array
   &syntax
+  &other-heap-object
 
   &f64
   &u64
@@ -178,10 +179,30 @@
 
 (define-syntax &no-type (identifier-syntax 0))
 
-(define-syntax &number
-  (identifier-syntax (logior &exact-integer &flonum &complex &fraction)))
+;; Special immediate values.  Note that the values for the first 4 of
+;; these are important; see uses below.
+(define-syntax &null        (identifier-syntax 0))
+(define-syntax &nil         (identifier-syntax 1))
+(define-syntax &false       (identifier-syntax 2))
+(define-syntax &true        (identifier-syntax 3))
+(define-syntax &unspecified (identifier-syntax 4))
+(define-syntax &undefined   (identifier-syntax 5))
+(define-syntax &eof         (identifier-syntax 6))
+
+(define-syntax &exact-integer
+  (identifier-syntax (logior &fixnum &bignum)))
+(define-syntax &exact-number
+  (identifier-syntax (logior &fixnum &bignum &fraction)))
 (define-syntax &real
-  (identifier-syntax (logior &exact-integer &flonum &fraction)))
+  (identifier-syntax (logior &fixnum &bignum &flonum &fraction)))
+(define-syntax &number
+  (identifier-syntax (logior &fixnum &bignum &flonum &complex &fraction)))
+
+(define-syntax &vector
+  (identifier-syntax (logior &immutable-vector &mutable-vector)))
+
+(define-syntax-rule (type<=? x type)
+  (zero? (logand x (lognot type))))
 
 ;; Versions of min and max that do not coerce exact numbers to become
 ;; inexact.
@@ -206,21 +227,17 @@
          (var (identifier? #'var)
               (datum->syntax #'var val)))))))
 
-(define-compile-time-value &s64-min (- #x8000000000000000))
-(define-compile-time-value &s64-max    #x7fffFFFFffffFFFF)
-(define-compile-time-value &u64-max    #xffffFFFFffffFFFF)
+(define-compile-time-value &fx32-min (- #x20000000))
+(define-compile-time-value &fx32-max    #x1fffFFFF)
+(define-compile-time-value &fx64-min (- #x2000000000000000))
+(define-compile-time-value &fx64-max    #x1fffFFFFffffFFFF)
+(define-compile-time-value &s64-min  (- #x8000000000000000))
+(define-compile-time-value &s64-max     #x7fffFFFFffffFFFF)
+(define-compile-time-value &u64-max     #xffffFFFFffffFFFF)
 
 (define-syntax &range-min (identifier-syntax &s64-min))
 (define-syntax &range-max (identifier-syntax &u64-max))
 
-;; This is a hack that takes advantage of knowing that
-;; most-positive-fixnum is the size of a word, but with two tag bits and
-;; one sign bit.  We also assume that the current common architectural
-;; restriction of a maximum 48-bit address space means that we won't see
-;; a size_t value above 2^48.
-(define *max-size-t*
-  (min (+ (ash most-positive-fixnum 3) #b111)
-       (1- (ash 1 48))))
 (define *max-codepoint* #x10ffff)
 
 (define-inlinable (make-unclamped-type-entry type min max)
@@ -291,13 +308,17 @@
        (cond
         ((not (< b-min a-min)) a-min)
         ((< 0 b-min) 0)
+        ((< &fx32-min b-min) &fx32-min)
+        ((< &fx64-min b-min) &fx64-min)
         ((< &range-min b-min) &range-min)
         (else -inf.0)))
      (let ((a-max (type-entry-max a))
            (b-max (type-entry-max b)))
        (cond
         ((not (> b-max a-max)) a-max)
-        ((> *max-size-t* b-max) *max-size-t*)
+        ((> &fx32-max b-max) &fx32-max)
+        ((> &fx64-max b-max) &fx64-max)
+        ((> &s64-max b-max) &s64-max)
         ((> &range-max b-max) &range-max)
         (else +inf.0)))))))
 
@@ -326,7 +347,13 @@ minimum, and maximum."
   (cond
    ((number? val)
     (cond
-     ((exact-integer? val) (return &exact-integer val))
+     ((exact-integer? val)
+      (return (if (<= (target-most-negative-fixnum)
+                      val
+                      (target-most-positive-fixnum))
+                  &fixnum
+                  &bignum)
+              val))
      ((eqv? (imag-part val) 0)
       (if (nan? val)
           (make-type-entry &flonum -inf.0 +inf.0)
@@ -335,22 +362,23 @@ minimum, and maximum."
            (if (rational? val) (inexact->exact (floor val)) val)
            (if (rational? val) (inexact->exact (ceiling val)) val))))
      (else (return &complex #f))))
-   ((eq? val '()) (return &null #f))
-   ((eq? val #nil) (return &nil #f))
-   ((eq? val #t) (return &true #f))
-   ((eq? val #f) (return &false #f))
+   ((eq? val '()) (return &special-immediate &null))
+   ((eq? val #nil) (return &special-immediate &nil))
+   ((eq? val #t) (return &special-immediate &true))
+   ((eq? val #f) (return &special-immediate &false))
+   ((eqv? val *unspecified*) (return &special-immediate &unspecified))
    ((char? val) (return &char (char->integer val)))
-   ((eqv? val *unspecified*) (return &unspecified #f))
    ((symbol? val) (return &symbol #f))
    ((keyword? val) (return &keyword #f))
    ((pair? val) (return &pair #f))
-   ((vector? val) (return &vector (vector-length val)))
+   ((vector? val) (return &immutable-vector (vector-length val)))
    ((string? val) (return &string (string-length val)))
    ((bytevector? val) (return &bytevector (bytevector-length val)))
    ((bitvector? val) (return &bitvector (bitvector-length val)))
    ((array? val) (return &array (array-rank val)))
    ((syntax? val) (return &syntax 0))
-   ((not (variable-bound? (make-variable val))) (return &unbound #f))
+   ((not (variable-bound? (make-variable val)))
+    (return &special-immediate &undefined))
 
    (else (error "unhandled constant" val))))
 
@@ -369,6 +397,16 @@ minimum, and maximum."
 (define-type-helper &min)
 (define-type-helper &max)
 
+(define-syntax-rule (define-exact-integer! result min max)
+  (let ((min* min) (max* max))
+    (define! result
+      (if (<= (target-most-negative-fixnum)
+              min* max*
+              (target-most-positive-fixnum))
+          &fixnum
+          &exact-integer)
+      min* max*)))
+
 ;; Accessors to use in type inferrers where you know that the values
 ;; must be in some range for the computation to proceed (not throw an
 ;; error).  Note that these accessors should be used even for &u64 and
@@ -380,19 +418,25 @@ minimum, and maximum."
 (define-syntax-rule (&max/u64 x) (min (&max x) &u64-max))
 (define-syntax-rule (&min/s64 x) (max (&min x) &s64-min))
 (define-syntax-rule (&max/s64 x) (min (&max x) &s64-max))
-(define-syntax-rule (&max/size x) (min (&max x) *max-size-t*))
+(define-syntax-rule (&min/fixnum x) (max (&min x) (target-most-negative-fixnum)))
+(define-syntax-rule (&max/fixnum x) (min (&max x) (target-most-positive-fixnum)))
+(define-syntax-rule (&max/size x) (min (&max x) (target-max-size-t)))
+(define-syntax-rule (&max/scm-size x) (min (&max x) (target-max-size-t/scm)))
 
-(define-syntax-rule (define-type-checker (name arg ...) body ...)
+(define-syntax-rule (define-type-checker/param (name param arg ...) body ...)
   (hashq-set!
    *type-checkers*
    'name
-   (lambda (typeset arg ...)
+   (lambda (typeset param arg ...)
      (syntax-parameterize
          ((&type (syntax-rules () ((_ val) (var-type typeset val))))
           (&min  (syntax-rules () ((_ val) (var-min typeset val))))
           (&max  (syntax-rules () ((_ val) (var-max typeset val)))))
        body ...))))
 
+(define-syntax-rule (define-type-checker (name arg ...) body ...)
+  (define-type-checker/param (name param arg ...) body ...))
+
 (define-syntax-rule (check-type arg type min max)
   ;; If the arg is negative, it is a closure variable.
   (and (>= arg 0)
@@ -400,11 +444,11 @@ minimum, and maximum."
        (<= min (&min arg))
        (<= (&max arg) max)))
 
-(define-syntax-rule (define-type-inferrer* (name succ var ...) body ...)
+(define-syntax-rule (define-type-inferrer* (name param succ var ...) body ...)
   (hashq-set!
    *type-inferrers*
    'name
-   (lambda (in succ var ...)
+   (lambda (in succ param var ...)
      (let ((out in))
        (syntax-parameterize
            ((define!
@@ -424,10 +468,19 @@ minimum, and maximum."
          out)))))
 
 (define-syntax-rule (define-type-inferrer (name arg ...) body ...)
-  (define-type-inferrer* (name succ arg ...) body ...))
+  (define-type-inferrer* (name param succ arg ...) body ...))
+
+(define-syntax-rule (define-type-inferrer/param (name param arg ...) body ...)
+  (define-type-inferrer* (name param succ arg ...) body ...))
 
 (define-syntax-rule (define-predicate-inferrer (name arg ... true?) body ...)
-  (define-type-inferrer* (name succ arg ...)
+  (define-type-inferrer* (name param succ arg ...)
+    (let ((true? (not (zero? succ))))
+      body ...)))
+
+(define-syntax-rule (define-predicate-inferrer/param
+                      (name param arg ... true?) body ...)
+  (define-type-inferrer* (name param succ arg ...)
     (let ((true? (not (zero? succ))))
       body ...)))
 
@@ -517,29 +570,109 @@ minimum, and maximum."
 ;;; Generic effect-free predicates.
 ;;;
 
-(define-predicate-inferrer (eq? a b true?)
-  ;; We can only propagate information down the true leg.
-  (when true?
-    (let ((type (logand (&type a) (&type b)))
-          (min (max (&min a) (&min b)))
-          (max (min (&max a) (&max b))))
-      (restrict! a type min max)
-      (restrict! b type min max))))
-(define-type-inferrer-aliases eq? eqv?)
+(define-syntax-rule (define-special-immediate-predicate-inferrer pred imm)
+  (define-predicate-inferrer (pred val true?)
+    (define (range-subtract lo hi x)
+      (values (if (eqv? lo x) (1+ lo) lo)
+              (if (eqv? hi x) (1- hi) hi)))
+    (cond
+     (true? (restrict! val &special-immediate imm imm))
+     (else
+      (when (eqv? (&type val) &special-immediate)
+        (let-values (((lo hi) (range-subtract (&min val) (&max val) imm)))
+          (restrict! val &special-immediate lo hi)))))))
+
+(define-special-immediate-predicate-inferrer eq-nil? &nil)
+(define-special-immediate-predicate-inferrer eq-eol? &null)
+(define-special-immediate-predicate-inferrer eq-false? &false)
+(define-special-immediate-predicate-inferrer eq-true? &true)
+(define-special-immediate-predicate-inferrer unspecified? &unspecified)
+(define-special-immediate-predicate-inferrer undefined? &undefined)
+(define-special-immediate-predicate-inferrer eof-object? &eof)
+
+;; Various inferrers rely on these having contiguous values starting from 0.
+(eval-when (expand)
+  (unless (< -1 &null &nil &false &true 4)
+    (error "unexpected special immediate values")))
+(define-predicate-inferrer (null? val true?)
+  (cond
+   (true? (restrict! val &special-immediate &null &nil))
+   (else
+    (when (eqv? (&type val) &special-immediate)
+      (restrict! val &special-immediate (1+ &nil) +inf.0)))))
+
+(define-predicate-inferrer (false? val true?)
+  (cond
+   (true? (restrict! val &special-immediate &nil &false))
+   (else
+    (when (and (eqv? (&type val) &special-immediate) (> (&min val) &null))
+      (restrict! val &special-immediate (1+ &false) +inf.0)))))
+
+(define-predicate-inferrer (nil? val true?)
+  (cond
+   (true? (restrict! val &special-immediate &null &false))
+   (else
+    (when (eqv? (&type val) &special-immediate)
+      (restrict! val &special-immediate (1+ &false) +inf.0)))))
+
+(define-predicate-inferrer (heap-object? val true?)
+  (define &immediate-types
+    (logior &fixnum &char &special-immediate))
+  (define &heap-object-types
+    (logand &all-types (lognot &immediate-types)))
+  (restrict! val (if true? &heap-object-types &immediate-types) -inf.0 +inf.0))
+
+(define-predicate-inferrer (heap-number? val true?)
+  (define &heap-number-types
+    (logior &bignum &flonum &complex &fraction))
+  (define &other-types
+    (logand &all-types (lognot &heap-number-types)))
+  (restrict! val (if true? &heap-number-types &other-types) -inf.0 +inf.0))
+
+(define-predicate-inferrer (fixnum? val true?)
+  (cond
+   (true?
+    (restrict! val &fixnum
+               (target-most-negative-fixnum) (target-most-positive-fixnum)))
+   ((type<=? (&type val) &exact-integer)
+    (cond
+     ((<= (&max val) (target-most-positive-fixnum))
+      (restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum))))
+     ((>= (&min val) (target-most-negative-fixnum))
+      (restrict! val &bignum (1+ (target-most-positive-fixnum)) +inf.0))
+     (else
+      (restrict! val &bignum -inf.0 +inf.0))))
+   (else
+    (restrict! val (logand &all-types (lognot &fixnum)) -inf.0 +inf.0))))
+
+(define-predicate-inferrer (bignum? val true?)
+  (cond
+   (true?
+    (cond
+     ((<= (&max val) (target-most-positive-fixnum))
+      (restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum))))
+     ((>= (&min val) (target-most-negative-fixnum))
+      (restrict! val &bignum (1+ (target-most-positive-fixnum)) +inf.0))
+     (else
+      (restrict! val &bignum -inf.0 +inf.0))))
+   ((type<=? (&type val) &exact-integer)
+    (restrict! val &fixnum
+               (target-most-negative-fixnum) (target-most-positive-fixnum)))
+   (else
+    (restrict! val (logand &all-types (lognot &bignum)) -inf.0 +inf.0))))
 
 (define-syntax-rule (define-simple-predicate-inferrer predicate type)
   (define-predicate-inferrer (predicate val true?)
-    (let ((type* (logand (&type val)
-                         (if true?
-                             type
-                             (lognot type)))))
-      (restrict! val type* -inf.0 +inf.0))))
+    (let ((type (if true?
+                    type
+                    (logand (&type val) (lognot type)))))
+      (restrict! val type -inf.0 +inf.0))))
+
 (define-simple-predicate-inferrer pair? &pair)
-(define-simple-predicate-inferrer null? (logior &nil &null))
-(define-simple-predicate-inferrer nil? (logior &false &nil &null))
 (define-simple-predicate-inferrer symbol? &symbol)
 (define-simple-predicate-inferrer variable? &box)
-(define-simple-predicate-inferrer vector? &vector)
+(define-simple-predicate-inferrer immutable-vector? &immutable-vector)
+(define-simple-predicate-inferrer mutable-vector? &mutable-vector)
 (define-simple-predicate-inferrer struct? &struct)
 (define-simple-predicate-inferrer string? &string)
 (define-simple-predicate-inferrer bytevector? &bytevector)
@@ -548,149 +681,150 @@ minimum, and maximum."
 (define-simple-predicate-inferrer number? &number)
 (define-simple-predicate-inferrer char? &char)
 (define-simple-predicate-inferrer procedure? &procedure)
-(define-simple-predicate-inferrer thunk? &procedure)
+(define-simple-predicate-inferrer flonum? &flonum)
+(define-simple-predicate-inferrer compnum? &complex)
+(define-simple-predicate-inferrer fracnum? &fraction)
 
-
-
-;;;
-;;; Fluids.  Note that we can't track bound-ness of fluids, as pop-fluid
-;;; can change boundness.
-;;;
-
-(define-simple-types
-  ((fluid-ref (&fluid 1)) &all-types)
-  ((fluid-set! (&fluid 0 1) &all-types))
-  ((push-fluid (&fluid 0 1) &all-types))
-  ((pop-fluid))
-  ((push-dynamic-state &all-types))
-  ((pop-dynamic-state)))
+(define-predicate-inferrer (vector? val true?)
+  (define &not-vector (logand &all-types (lognot &vector)))
+  (restrict! val (if true? &vector &not-vector) -inf.0 +inf.0))
 
+(define-predicate-inferrer (eq? a b true?)
+  ;; We can only propagate information down the true leg.
+  (when true?
+    (let ((type (logand (&type a) (&type b)))
+          (min (max (&min a) (&min b)))
+          (max (min (&max a) (&max b))))
+      (restrict! a type min max)
+      (restrict! b type min max))))
+(define-type-inferrer-aliases eq? heap-numbers-equal?)
 
 
 
-;;;
-;;; Threads.  We don't currently track threads as an object type.
-;;;
+(define-type-inferrer/param (load-const/unlikely param result)
+  (let ((ent (constant-type param)))
+    (define! result (type-entry-type ent)
+      (type-entry-min ent) (type-entry-max ent))))
 
-(define-simple-types
-  ((current-thread) &all-types))
+(define-type-inferrer (u64->s64 u64 s64)
+  (if (<= (&max u64) &s64-max)
+      (define! s64 &s64 (&min u64) (&max u64))
+      (define! s64 &s64 &s64-min &s64-max)))
 
+(define-type-inferrer (s64->u64 s64 u64)
+  (if (<= 0 (&min s64))
+      (define! u64 &u64 (&min s64) (&max s64))
+      (define! u64 &u64 0 &u64-max)))
 
 
 
 ;;;
-;;; Prompts.  (Nothing to do.)
+;;; Memory.
 ;;;
 
+(define (annotation->type ann)
+  (match ann
+    ('pair &pair)
+    ('vector &vector)
+    ('string &string)
+    ('stringbuf &string)
+    ('bytevector &bytevector)
+    ('box &box)
+    ('closure &procedure)
+    ('struct &struct)
+    ('atomic-box &all-types)))
+
+(define-type-inferrer/param (allocate-words param size result)
+  (define! result (annotation->type param) (&min/0 size) (&max/scm-size size)))
+
+(define-type-inferrer/param (allocate-words/immediate param result)
+  (match param
+    ((annotation . size)
+     (define! result (annotation->type annotation) size size))))
+
+(define-type-inferrer/param (scm-ref param obj idx result)
+  (restrict! obj (annotation->type param)
+             (1+ (&min/0 idx)) (target-max-size-t/scm))
+  (define! result &all-types -inf.0 +inf.0))
 
-
+(define-type-inferrer/param (scm-ref/immediate param obj result)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0)
+     (define! result &all-types -inf.0 +inf.0))))
 
-;;;
-;;; Pairs.
-;;;
+(define-type-inferrer/param (scm-ref/tag param obj result)
+  (restrict! obj (annotation->type param) -inf.0 +inf.0)
+  (define! result &all-types -inf.0 +inf.0))
+(define-type-inferrer/param (scm-set!/tag param obj val)
+  (restrict! obj (annotation->type param) -inf.0 +inf.0))
 
-(define-simple-types
-  ((cons &all-types &all-types) &pair)
-  ((car &pair) &all-types)
-  ((set-car! &pair &all-types))
-  ((cdr &pair) &all-types)
-  ((set-cdr! &pair &all-types)))
+(define-type-inferrer/param (scm-set! param obj idx val)
+  (restrict! obj (annotation->type param) (1+ (&min/0 idx)) +inf.0))
 
+(define-type-inferrer/param (scm-set!/immediate param obj val)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0))))
 
-
+(define-type-inferrer/param (word-ref param obj idx result)
+  (restrict! obj (annotation->type param)
+             (1+ (&min/0 idx)) (target-max-size-t/scm))
+  (define! result &u64 0 &u64-max))
 
-;;;
-;;; Variables.
-;;;
+(define-type-inferrer/param (word-ref/immediate param obj result)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0)
+     (define! result &u64 0 &u64-max))))
 
-(define-simple-types
-  ((box &all-types) (&box 1))
-  ((box-ref (&box 1)) &all-types))
+(define-type-inferrer/param (word-set! param obj idx word)
+  (restrict! obj (annotation->type param) (1+ (&min/0 idx)) +inf.0))
+
+(define-type-inferrer/param (word-set!/immediate param obj word)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0))))
+
+(define-type-inferrer/param (pointer-ref/immediate param obj result)
+  (define! result &other-heap-object -inf.0 +inf.0))
+(define-type-inferrer/param (tail-pointer-ref/immediate param obj result)
+  (define! result &other-heap-object -inf.0 +inf.0))
 
-(define-simple-type-checker (box-set! (&box 0 1) &all-types))
-(define-type-inferrer (box-set! box val)
-  (restrict! box &box 1 1))
+(define-type-inferrer/param (assume-u64 param val result)
+  (match param
+    ((lo . hi)
+     (define! result &u64 (max lo (&min val)) (min hi (&max val))))))
+(define-type-inferrer/param (assume-s64 param val result)
+  (match param
+    ((lo . hi)
+     (define! result &s64 (max lo (&min val)) (min hi (&max val))))))
 
 
 
 
 ;;;
-;;; Vectors.
+;;; Fluids.  Note that we can't track bound-ness of fluids, as pop-fluid
+;;; can change boundness.
 ;;;
 
-;; This max-vector-len computation is a hack.
-(define *max-vector-len* (ash most-positive-fixnum -5))
-(define-syntax-rule (&max/vector x) (min (&max x) *max-vector-len*))
-
-(define-simple-type-checker (make-vector (&u64 0 *max-vector-len*)
-                                         &all-types))
-(define-type-inferrer (make-vector size init result)
-  (restrict! size &u64 0 *max-vector-len*)
-  (define! result &vector (&min/0 size) (&max/vector size)))
-
-(define-type-checker (vector-ref v idx)
-  (and (check-type v &vector 0 *max-vector-len*)
-       (check-type idx &u64 0 (1- (&min v)))))
-(define-type-inferrer (vector-ref v idx result)
-  (restrict! v &vector (1+ (&min/0 idx)) *max-vector-len*)
-  (restrict! idx &u64 0 (1- (&max/vector v)))
-  (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker (vector-set! v idx val)
-  (and (check-type v &vector 0 *max-vector-len*)
-       (check-type idx &u64 0 (1- (&min v)))))
-(define-type-inferrer (vector-set! v idx val)
-  (restrict! v &vector (1+ (&min/0 idx)) *max-vector-len*)
-  (restrict! idx &u64 0 (1- (&max/vector v))))
-
-(define-type-aliases make-vector make-vector/immediate)
-(define-type-aliases vector-ref vector-ref/immediate)
-(define-type-aliases vector-set! vector-set!/immediate)
-
-(define-simple-type-checker (vector-length &vector))
-(define-type-inferrer (vector-length v result)
-  (restrict! v &vector 0 *max-vector-len*)
-  (define! result &u64 (&min/0 v) (&max/vector v)))
+(define-simple-types
+  ((fluid-ref (&fluid 1)) &all-types)
+  ((fluid-set! (&fluid 0 1) &all-types))
+  ((push-fluid (&fluid 0 1) &all-types))
+  ((pop-fluid))
+  ((push-dynamic-state &all-types))
+  ((pop-dynamic-state)))
 
 
 
 
 ;;;
-;;; Structs.
+;;; Threads.  We don't currently track threads as an object type.
 ;;;
 
-;; No type-checker for allocate-struct, as we can't currently check that
-;; vt is actually a vtable.
-(define-type-inferrer (allocate-struct vt size result)
-  (restrict! vt &struct vtable-offset-user *max-size-t*)
-  (restrict! size &u64 0 *max-size-t*)
-  (define! result &struct (&min/0 size) (&max/size size)))
-
-(define-type-checker (struct-ref s idx)
-  (and (check-type s &struct 0 *max-size-t*)
-       (check-type idx &u64 0 *max-size-t*)
-       ;; FIXME: is the field readable?
-       (< (&max idx) (&min s))))
-(define-type-inferrer (struct-ref s idx result)
-  (restrict! s &struct (1+ (&min/0 idx)) *max-size-t*)
-  (restrict! idx &u64 0 (1- (&max/size s)))
-  (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker (struct-set! s idx val)
-  (and (check-type s &struct 0 *max-size-t*)
-       (check-type idx &u64 0 *max-size-t*)
-       ;; FIXME: is the field writable?
-       (< (&max idx) (&min s))))
-(define-type-inferrer (struct-set! s idx val)
-  (restrict! s &struct (1+ (&min/0 idx)) *max-size-t*)
-  (restrict! idx &u64 0 (1- (&max/size s))))
-
-(define-type-aliases allocate-struct allocate-struct/immediate)
-(define-type-aliases struct-ref struct-ref/immediate)
-(define-type-aliases struct-set! struct-set!/immediate)
-
-(define-simple-type (struct-vtable (&struct 0 *max-size-t*))
-  (&struct vtable-offset-user *max-size-t*))
+(define-simple-types
+  ((current-thread) &all-types))
 
 
 
@@ -699,33 +833,9 @@ minimum, and maximum."
 ;;; Strings.
 ;;;
 
-(define-type-checker (string-ref s idx)
-  (and (check-type s &string 0 *max-size-t*)
-       (check-type idx &u64 0 *max-size-t*)
-       (< (&max idx) (&min s))))
-(define-type-inferrer (string-ref s idx result)
-  (restrict! s &string (1+ (&min/0 idx)) *max-size-t*)
-  (restrict! idx &u64 0 (1- (&max/size s)))
-  (define! result &char 0 *max-codepoint*))
-
-(define-type-checker (string-set! s idx val)
-  (and (check-type s &string 0 *max-size-t*)
-       (check-type idx &u64 0 *max-size-t*)
-       (check-type val &char 0 *max-codepoint*)
-       (< (&max idx) (&min s))))
-(define-type-inferrer (string-set! s idx val)
-  (restrict! s &string (1+ (&min/0 idx)) *max-size-t*)
-  (restrict! idx &u64 0 (1- (&max/size s)))
-  (restrict! val &char 0 *max-codepoint*))
-
-(define-simple-type-checker (string-length &string))
-(define-type-inferrer (string-length s result)
-  (restrict! s &string 0 *max-size-t*)
-  (define! result &u64 (&min/0 s) (&max/size s)))
-
-(define-simple-type (number->string &number) (&string 0 *max-size-t*))
-(define-simple-type (string->number (&string 0 *max-size-t*))
-  ((logior &number &false) -inf.0 +inf.0))
+(define-simple-type (number->string &number) (&string 0 (target-max-size-t)))
+(define-simple-type (string->number (&string 0 (target-max-size-t)))
+  ((logior &number &special-immediate) -inf.0 +inf.0))
 
 
 
@@ -739,7 +849,8 @@ minimum, and maximum."
 (define-type-inferrer (scm->f64 scm result)
   (restrict! scm &real -inf.0 +inf.0)
   (define! result &f64 (&min scm) (&max scm)))
-(define-type-aliases scm->f64 load-f64)
+(define-type-inferrer/param (load-f64 param result)
+  (define! result &f64 param param))
 
 (define-type-checker (f64->scm f64)
   #t)
@@ -751,7 +862,8 @@ minimum, and maximum."
 (define-type-inferrer (scm->u64 scm result)
   (restrict! scm &exact-integer 0 &u64-max)
   (define! result &u64 (&min/0 scm) (&max/u64 scm)))
-(define-type-aliases scm->u64 load-u64)
+(define-type-inferrer/param (load-u64 param result)
+  (define! result &u64 param param))
 
 (define-type-checker (scm->u64/truncate scm)
   (check-type scm &exact-integer &range-min &range-max))
@@ -762,68 +874,47 @@ minimum, and maximum."
 (define-type-checker (u64->scm u64)
   #t)
 (define-type-inferrer (u64->scm u64 result)
-  (define! result &exact-integer (&min/0 u64) (&max/u64 u64)))
+  (define-exact-integer! result (&min/0 u64) (&max/u64 u64)))
+(define-type-aliases u64->scm u64->scm/unlikely)
 
 (define-type-checker (scm->s64 scm)
   (check-type scm &exact-integer &s64-min &s64-max))
 (define-type-inferrer (scm->s64 scm result)
   (restrict! scm &exact-integer &s64-min &s64-max)
   (define! result &s64 (&min/s64 scm) (&max/s64 scm)))
-(define-type-aliases scm->s64 load-s64)
+(define-type-aliases s64->scm s64->scm/unlikely)
+(define-type-inferrer/param (load-s64 param result)
+  (define! result &s64 param param))
 
-(define-type-checker (s64->scm s64)
-  #t)
-(define-type-inferrer (s64->scm s64 result)
-  (define! result &exact-integer (&min/s64 s64) (&max/s64 s64)))
+(define-type-inferrer (untag-fixnum scm result)
+  (define! result &s64 (&min/fixnum scm) (&max/fixnum scm)))
+
+(define-type-inferrer (tag-fixnum s64 result)
+  (define! result &fixnum (&min/fixnum s64) (&max/fixnum s64)))
+(define-type-aliases tag-fixnum tag-fixnum/unlikely)
 
 
 
 
 ;;;
-;;; Bytevectors.
+;;; Pointers
 ;;;
 
-(define-simple-type-checker (bv-length &bytevector))
-(define-type-inferrer (bv-length bv result)
-  (restrict! bv &bytevector 0 *max-size-t*)
-  (define! result &u64 (&min/0 bv) (&max/size bv)))
+(define-syntax-rule (define-pointer-ref-inferrer ref type lo hi)
+  (define-type-inferrer (ref obj bv idx result)
+    (define! result type lo hi)))
+(define-pointer-ref-inferrer u8-ref  &u64 0 #xff)
+(define-pointer-ref-inferrer u16-ref &u64 0 #xffff)
+(define-pointer-ref-inferrer u32-ref &u64 0 #xffffffff)
+(define-pointer-ref-inferrer u64-ref &u64 0 &u64-max)
 
-(define-syntax-rule (define-bytevector-accessors ref set type size lo hi)
-  (begin
-    (define-type-checker (ref bv idx)
-      (and (check-type bv &bytevector 0 *max-size-t*)
-           (check-type idx &u64 0 *max-size-t*)
-           (< (&max idx) (- (&min bv) size))))
-    (define-type-inferrer (ref bv idx result)
-      (restrict! bv &bytevector (+ (&min/0 idx) size) *max-size-t*)
-      (restrict! idx &u64 0 (- (&max/size bv) size))
-      (define! result type lo hi))
-    (define-type-checker (set bv idx val)
-      (and (check-type bv &bytevector 0 *max-size-t*)
-           (check-type idx &u64 0 *max-size-t*)
-           (check-type val type lo hi)
-           (< (&max idx) (- (&min bv) size))))
-    (define-type-inferrer (set! bv idx val)
-      (restrict! bv &bytevector (+ (&min/0 idx) size) *max-size-t*)
-      (restrict! idx &u64 0 (- (&max/size bv) size))
-      (restrict! val type lo hi))))
-
-(define-bytevector-accessors bv-u8-ref bv-u8-set! &u64 1 0 #xff)
-(define-bytevector-accessors bv-s8-ref bv-s8-set! &s64 1 (- #x80) #x7f)
-
-(define-bytevector-accessors bv-u16-ref bv-u16-set! &u64 2 0 #xffff)
-(define-bytevector-accessors bv-s16-ref bv-s16-set! &s64 2 (- #x8000) #x7fff)
-
-(define-bytevector-accessors bv-u32-ref bv-u32-set! &u64 4 0 #xffffffff)
-(define-bytevector-accessors bv-s32-ref bv-s32-set! &s64 4
-  (- #x80000000) #x7fffffff)
-
-(define-bytevector-accessors bv-u64-ref bv-u64-set! &u64 8 0 &u64-max)
-(define-bytevector-accessors bv-s64-ref bv-s64-set! &s64 8 &s64-min &s64-max)
-
-(define-bytevector-accessors bv-f32-ref bv-f32-set! &f64 4 -inf.0 +inf.0)
-(define-bytevector-accessors bv-f64-ref bv-f64-set! &f64 8 -inf.0 +inf.0)
+(define-pointer-ref-inferrer s8-ref  &s64 (- #x80) #x7f)
+(define-pointer-ref-inferrer s16-ref &s64 (- #x8000) #x7fff)
+(define-pointer-ref-inferrer s32-ref &s64 (- #x80000000) #x7fffffff)
+(define-pointer-ref-inferrer s64-ref &s64 &s64-min &s64-max)
 
+(define-pointer-ref-inferrer f32-ref &f64 -inf.0 +inf.0)
+(define-pointer-ref-inferrer f64-ref &f64 -inf.0 +inf.0)
 
 
 
@@ -831,145 +922,112 @@ minimum, and maximum."
 ;;; Numbers.
 ;;;
 
-;; First, branching primitives with no results.
-(define-simple-type-checker (= &number &number))
-(define-predicate-inferrer (= a b true?)
-  (when (and true?
-             (zero? (logand (logior (&type a) (&type b)) (lognot &number))))
+(define-syntax-rule (infer-= a b true?)
+  (when true?
     (let ((min (max (&min a) (&min b)))
           (max (min (&max a) (&max b))))
-      (restrict! a &number min max)
-      (restrict! b &number min max))))
-
-(define (restricted-comparison-ranges op type0 min0 max0 type1 min1 max1)
-  (define (infer-integer-ranges)
-    (match op
-      ('< (values min0 (min max0 (1- max1)) (max (1+ min0) min1) max1))
-      ('<= (values min0 (min max0 max1) (max min0 min1) max1))
-      ('>= (values (max min0 min1) max0 min1 (min max0 max1)))
-      ('> (values (max min0 (1+ min1)) max0 min1 (min (1- max0) max1)))))
-  (define (infer-real-ranges)
-    (match op
-      ((or '< '<=) (values min0 (min max0 max1) (max min0 min1) max1))
-      ((or '> '>=) (values (max min0 min1) max0 min1 (min max0 max1)))))
-  (if (= (logior type0 type1) &exact-integer)
-      (infer-integer-ranges)
-      (infer-real-ranges)))
-
-(define-syntax-rule (true-comparison-restrictions op a b a-type b-type)
-  (call-with-values
-      (lambda ()
-        (restricted-comparison-ranges op
-                                      (&type a) (&min a) (&max a)
-                                      (&type b) (&min b) (&max b)))
-    (lambda (min0 max0 min1 max1)
-      (restrict! a a-type min0 max0)
-      (restrict! b b-type min1 max1))))
-
-(define-syntax-rule (define-comparison-inferrer (op inverse))
-  (define-predicate-inferrer (op a b true?)
-    (when (zero? (logand (logior (&type a) (&type b)) (lognot &number)))
-      (true-comparison-restrictions (if true? 'op 'inverse) a b &real &real))))
-
-(define-simple-type-checker (< &real &real))
-(define-comparison-inferrer (< >=))
+      (restrict! a &all-types min max)
+      (restrict! b &all-types min max))))
 
-(define-simple-type-checker (<= &real &real))
-(define-comparison-inferrer (<= >))
+(define-syntax-rule (infer-integer-< a b true?)
+  (let ((min0 (&min a)) (max0 (&max a))
+        (min1 (&min b)) (max1 (&max b)))
+    (cond
+     (true?
+      (restrict! a &all-types min0 (min max0 (1- max1)))
+      (restrict! b &all-types (max (1+ min0) min1) max1))
+     (else
+      (restrict! a &all-types (max min0 min1) max0)
+      (restrict! b &all-types min1 (min max0 max1))))))
 
-(define-simple-type-checker (>= &real &real))
-(define-comparison-inferrer (>= <))
+(define-simple-type-checker (= &number &number))
+(define-predicate-inferrer (= a b true?)
+  (let ((types (logior (&type a) (&type b))))
+    (when (type<=? types &number)
+      ;; OK if e.g. A is a NaN; in that case the range will be
+      ;; -inf/+inf.
+      (infer-= a b true?))))
 
-(define-simple-type-checker (> &real &real))
-(define-comparison-inferrer (> <=))
+(define-simple-type-checker (< &real &real))
+(define-predicate-inferrer (< a b true?)
+  (let ((types (logior (&type a) (&type b))))
+    (cond
+     ((type<=? types &exact-integer)
+      (cond
+       ((and (eqv? (&type a) &bignum) (eqv? (&type b) &fixnum))
+        (if true?
+            (restrict! a &bignum -inf.0 (1- (target-most-negative-fixnum)))
+            (restrict! a &bignum (1+ (target-most-positive-fixnum)) +inf.0)))
+       ((and (eqv? (&type a) &fixnum) (eqv? (&type b) &bignum))
+        (if true?
+            (restrict! b &bignum (1+ (target-most-positive-fixnum)) +inf.0)
+            (restrict! b &bignum -inf.0 (1- (target-most-negative-fixnum)))))
+       (else
+        (infer-integer-< a b true?))))
+     ;; Can't include &flonum because of NaN.  Perhaps we should model
+     ;; NaN with a separate type bit.
+     ((type<=? types &exact-number)
+      (let ((min0 (&min a)) (max0 (&max a))
+            (min1 (&min b)) (max1 (&max b)))
+        (cond
+         (true?
+          (restrict! a &exact-number min0 (min max0 max1))
+          (restrict! b &exact-number (max min0 min1) max1))
+         (else
+          (restrict! a &exact-number (max min0 min1) max0)
+          (restrict! b &exact-number min1 (min max0 max1)))))))))
+
+(define (infer-<= types succ param a b)
+  ;; Infer "(<= a b)" as "(not (< b a))", knowing that we only make
+  ;; inferences when NaN is impossible.
+  ((hashq-ref *type-inferrers* '<) types (match succ (0 1) (1 0)) param b a))
+(hashq-set! *type-inferrers* '<= infer-<=)
 
-(define-simple-type-checker (u64-= &u64 &u64))
 (define-predicate-inferrer (u64-= a b true?)
+  (infer-= a b true?))
+(define-predicate-inferrer (u64-< a b true?)
+  (infer-integer-< a b true?))
+
+(define-predicate-inferrer (s64-= a b true?)
+  (infer-= a b true?))
+(define-predicate-inferrer (s64-< a b true?)
+  (infer-integer-< a b true?))
+
+(define-predicate-inferrer/param (u64-imm-= b a true?)
   (when true?
-    (let ((min (max (&min/0 a) (&min/0 b)))
-          (max (min (&max/u64 a) (&max/u64 b))))
-      (restrict! a &u64 min max)
-      (restrict! b &u64 min max))))
-
-(define-simple-type-checker (u64-=-scm &u64 &real))
-(define-predicate-inferrer (u64-=-scm a b true?)
-  (when (and true? (zero? (logand (&type b) (lognot &real))))
-    (let ((min (max (&min/0 a) (&min/0 b)))
-          (max (min (&max/u64 a) (&max/u64 b))))
-      (restrict! a &u64 min max)
-      (restrict! b &real min max))))
-
-(define-simple-type-checker (u64-<-scm &u64 &real))
-(define-predicate-inferrer (u64-<-scm a b true?)
-  (when (and true? (zero? (logand (&type b) (lognot &real))))
-    (true-comparison-restrictions '< a b &u64 &real)))
-
-(define-simple-type-checker (u64-<=-scm &u64 &real))
-(define-predicate-inferrer (u64-<=-scm a b true?)
-  (when (and true? (zero? (logand (&type b) (lognot &real))))
-    (true-comparison-restrictions '<= a b &u64 &real)))
-
-(define-simple-type-checker (u64->=-scm &u64 &real))
-(define-predicate-inferrer (u64->=-scm a b true?)
-  (when (and true? (zero? (logand (&type b) (lognot &real))))
-    (true-comparison-restrictions '>= a b &u64 &real)))
-
-(define-simple-type-checker (u64->-scm &u64 &real))
-(define-predicate-inferrer (u64->-scm a b true?)
-  (when (and true? (zero? (logand (&type b) (lognot &real))))
-    (true-comparison-restrictions '> a b &u64 &real)))
-
-(define (infer-u64-comparison-ranges op min0 max0 min1 max1)
-  (match op
-    ('< (values min0 (min max0 (1- max1)) (max (1+ min0) min1) max1))
-    ('<= (values min0 (min max0 max1) (max min0 min1) max1))
-    ('>= (values (max min0 min1) max0 min1 (min max0 max1)))
-    ('> (values (max min0 (1+ min1)) max0 min1 (min (1- max0) max1)))))
-(define-syntax-rule (define-u64-comparison-inferrer (u64-op op inverse))
-  (define-predicate-inferrer (u64-op a b true?)
-    (call-with-values
-        (lambda ()
-          (infer-u64-comparison-ranges (if true? 'op 'inverse)
-                                       (&min/0 a) (&max/u64 a)
-                                       (&min/0 b) (&max/u64 b)))
-      (lambda (min0 max0 min1 max1)
-        (restrict! a &u64 min0 max0)
-        (restrict! b &u64 min1 max1)))))
-
-(define-simple-type-checker (u64-< &u64 &u64))
-(define-u64-comparison-inferrer (u64-< < >=))
-
-(define-simple-type-checker (u64-<= &u64 &u64))
-(define-u64-comparison-inferrer (u64-<= <= >))
-
-(define-simple-type-checker (u64->= &u64 &u64))
-(define-u64-comparison-inferrer (u64-<= >= <))
-
-(define-simple-type-checker (u64-> &u64 &u64))
-(define-u64-comparison-inferrer (u64-> > <=))
+    (restrict! a &u64 (max (&min a) b) (min (&max a) b))))
+(define-predicate-inferrer/param (u64-imm-< b a true?)
+  (if true?
+      (restrict! a &u64 (&min a) (min (&max a) (1- b)))
+      (restrict! a &u64 (max (&min a) b) (&max a))))
+(define-predicate-inferrer/param (imm-u64-< b a true?)
+  (if true?
+      (restrict! a &u64 (max (&min a) (1+ b)) (&max a))
+      (restrict! a &u64 (&min a) (min (&max a) b))))
+
+(define-predicate-inferrer/param (s64-imm-= b a true?)
+  (when true?
+    (restrict! a &s64 (max (&min a) b) (min (&max a) b))))
+(define-predicate-inferrer/param (s64-imm-< b a true?)
+  (if true?
+      (restrict! a &s64 (&min a) (min (&max a) (1- b)))
+      (restrict! a &s64 (max (&min a) b) (&max a))))
+(define-predicate-inferrer/param (imm-s64-< b a true?)
+  (if true?
+      (restrict! a &s64 (max (&min a) (1+ b)) (&max a))
+      (restrict! a &s64 (&min a) (min (&max a) b))))
 
-;; Arithmetic.
-(define-syntax-rule (define-unary-result! a result min max)
-  (let ((min* min)
-        (max* max)
-        (type (logand (&type a) &number)))
-    (cond
-     ((not (= type (&type a)))
-      ;; Not a number.  Punt and do nothing.
-      (define! result &all-types -inf.0 +inf.0))
-     ;; Complex numbers don't have a range.
-     ((eqv? type &complex)
-      (define! result &complex -inf.0 +inf.0))
-     (else
-      (define! result type min* max*)))))
 
-(define-syntax-rule (define-binary-result! a b result closed? min max)
-  (let ((min* min)
-        (max* max)
-        (a-type (logand (&type a) &number))
-        (b-type (logand (&type b) &number)))
+;; Unfortunately, we can't define f64 comparison inferrers because of
+;; not-a-number values.
+
+;; Arithmetic.
+(define-syntax-rule (define-binary-result! a-type$ b-type$ result closed?
+                      min$ max$)
+  (let* ((min min$) (max max$) (a-type a-type$) (b-type b-type$)
+         (type (logior a-type b-type)))
     (cond
-     ((or (not (= a-type (&type a))) (not (= b-type (&type b))))
+     ((not (type<=? type &number))
       ;; One input not a number.  Perhaps we end up dispatching to
       ;; GOOPS.
       (define! result &all-types -inf.0 +inf.0))
@@ -979,33 +1037,47 @@ minimum, and maximum."
      ((or (eqv? a-type &flonum) (eqv? b-type &flonum))
       ;; If one argument is a flonum, the result will be flonum or
       ;; possibly complex.
-      (let ((result-type (logand (logior a-type b-type)
-                                 (logior &complex &flonum))))
-        (define! result result-type min* max*)))
+      (let ((result-type (logand type (logior &complex &flonum))))
+        (define! result result-type min max)))
      ;; Exact integers are closed under some operations.
-     ((and closed? (eqv? a-type &exact-integer) (eqv? b-type &exact-integer))
-      (define! result &exact-integer min* max*))
+     ((and closed? (type<=? type &exact-integer))
+      (define-exact-integer! result min max))
      (else
-      (let* ((type (logior a-type b-type))
-             ;; Fractions may become integers.
+      (let* (;; Fractions may become integers.
              (type (if (zero? (logand type &fraction))
                        type
                        (logior type &exact-integer)))
              ;; Integers may become fractions under division.
-             (type (if (or closed?
-                           (zero? (logand type (logior &exact-integer))))
+             (type (if (or closed? (zero? (logand type &exact-integer)))
                        type
-                       (logior type &fraction))))
-        (define! result type min* max*))))))
+                       (logior type &fraction)))
+             ;; Fixnums and bignums may become each other, depending on
+             ;; the range.
+             (type (cond
+                    ((zero? (logand type &exact-integer))
+                     type)
+                    ((<= (target-most-negative-fixnum)
+                         min max
+                         (target-most-positive-fixnum))
+                     (logand type (lognot &bignum)))
+                    ((or (< max (target-most-negative-fixnum))
+                         (> min (target-most-positive-fixnum)))
+                     (logand type (lognot &fixnum)))
+                    (else
+                     (logior type &fixnum &bignum)))))
+        (define! result type min max))))))
 
 (define-simple-type-checker (add &number &number))
-(define-type-aliases add add/immediate)
-(define-type-checker (fadd a b) #t)
-(define-type-checker (uadd a b) #t)
+(define-simple-type-checker (add/immediate &number))
 (define-type-inferrer (add a b result)
-  (define-binary-result! a b result #t
+  (define-binary-result! (&type a) (&type b) result #t
                          (+ (&min a) (&min b))
                          (+ (&max a) (&max b))))
+(define-type-inferrer/param (add/immediate param a result)
+  (let ((b-type (type-entry-type (constant-type param))))
+    (define-binary-result! (&type a) b-type result #t
+      (+ (&min a) param)
+      (+ (&max a) param))))
 (define-type-inferrer (fadd a b result)
   (define! result &f64
     (+ (&min a) (&min b))
@@ -1016,16 +1088,40 @@ minimum, and maximum."
     (if (<= max &u64-max)
         (define! result &u64 (+ (&min/0 a) (&min/0 b)) max)
         (define! result &u64 0 &u64-max))))
-(define-type-aliases uadd uadd/immediate)
+(define-type-inferrer (sadd a b result)
+  ;; Handle wraparound.
+  (let ((min (+ (&min/s64 a) (&min/s64 b)))
+        (max (+ (&max/s64 a) (&max/s64 b))))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
+(define-type-inferrer/param (uadd/immediate param a result)
+  ;; Handle wraparound.
+  (let ((max (+ (&max/u64 a) param)))
+    (if (<= max &u64-max)
+        (define! result &u64 (+ (&min/0 a) param) max)
+        (define! result &u64 0 &u64-max))))
+(define-type-inferrer/param (sadd/immediate param a result)
+  ;; Handle wraparound.
+  (let ((min (+ (&min/s64 a) param))
+        (max (+ (&max/s64 a) param)))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
 
 (define-simple-type-checker (sub &number &number))
-(define-type-aliases sub sub/immediate)
+(define-simple-type-checker (sub/immediate &number))
 (define-type-checker (fsub a b) #t)
 (define-type-checker (usub a b) #t)
 (define-type-inferrer (sub a b result)
-  (define-binary-result! a b result #t
+  (define-binary-result! (&type a) (&type b) result #t
                          (- (&min a) (&max b))
                          (- (&max a) (&min b))))
+(define-type-inferrer/param (sub/immediate param a result)
+  (let ((b-type (type-entry-type (constant-type param))))
+    (define-binary-result! (&type a) b-type result #t
+      (- (&min a) param)
+      (- (&max a) param))))
 (define-type-inferrer (fsub a b result)
   (define! result &f64
     (- (&min a) (&max b))
@@ -1036,11 +1132,14 @@ minimum, and maximum."
     (if (< min 0)
         (define! result &u64 0 &u64-max)
         (define! result &u64 min (- (&max/u64 a) (&min/0 b))))))
-(define-type-aliases usub usub/immediate)
+(define-type-inferrer/param (usub/immediate param a result)
+  ;; Handle wraparound.
+  (let ((min (- (&min/0 a) param)))
+    (if (< min 0)
+        (define! result &u64 0 &u64-max)
+        (define! result &u64 min (- (&max/u64 a) param)))))
 
 (define-simple-type-checker (mul &number &number))
-(define-type-checker (fmul a b) #t)
-(define-type-checker (umul a b) #t)
 (define (mul-result-range same? nan-impossible? min-a max-a min-b max-b)
   (define (nan* a b)
     (if (and (or (and (inf? a) (zero? b))
@@ -1073,7 +1172,7 @@ minimum, and maximum."
                         (mul-result-range (eqv? a b) nan-impossible?
                                           min-a max-a min-b max-b))
       (lambda (min max)
-        (define-binary-result! a b result #t min max)))))
+        (define-binary-result! (&type a) (&type b) result #t min max)))))
 (define-type-inferrer (fmul a b result)
   (let ((min-a (&min a)) (max-a (&max a))
         (min-b (&min b)) (max-b (&max b))
@@ -1089,7 +1188,32 @@ minimum, and maximum."
     (if (<= max &u64-max)
         (define! result &u64 (* (&min/0 a) (&min/0 b)) max)
         (define! result &u64 0 &u64-max))))
-(define-type-aliases umul umul/immediate)
+(define-type-inferrer (smul a b result)
+  (call-with-values (lambda ()
+                      (mul-result-range (eqv? a b) #t
+                                        (&min/s64 a) (&max/s64 a)
+                                        (&min/s64 b) (&max/s64 b)))
+    (lambda (min max)
+      ;; Handle wraparound.
+      (if (<= &s64-min min max &s64-max)
+          (define! result &s64 min max)
+          (define! result &s64 &s64-min &s64-max)))))
+(define-type-inferrer/param (umul/immediate param a result)
+  ;; Handle wraparound.
+  (let ((max (* (&max/u64 a) param)))
+    (if (<= max &u64-max)
+        (define! result &u64 (* (&min/0 a) param) max)
+        (define! result &u64 0 &u64-max))))
+(define-type-inferrer/param (smul/immediate param a result)
+  (call-with-values (lambda ()
+                      (mul-result-range #f #t
+                                        (&min/s64 a) (&max/s64 a)
+                                        param param))
+    (lambda (min max)
+      ;; Handle wraparound.
+      (if (<= &s64-min min max &s64-max)
+          (define! result &s64 min max)
+          (define! result &s64 &s64-min &s64-max)))))
 
 (define-type-checker (div a b)
   (and (check-type a &number -inf.0 +inf.0)
@@ -1123,7 +1247,7 @@ minimum, and maximum."
     (call-with-values (lambda ()
                         (div-result-range min-a max-a min-b max-b))
       (lambda (min max)
-        (define-binary-result! a b result #f min max)))))
+        (define-binary-result! (&type a) (&type b) result #f min max)))))
 (define-type-inferrer (fdiv a b result)
   (let ((min-a (&min a)) (max-a (&max a))
         (min-b (&min b)) (max-b (&max b)))
@@ -1151,11 +1275,11 @@ minimum, and maximum."
   (let ((max-abs-rem (1- (max (abs (&min b)) (abs (&max b))))))
     (cond
      ((< (&min a) 0)
-      (if (< 0 (&max a))
-          (define! result &exact-integer (- max-abs-rem) max-abs-rem)
-          (define! result &exact-integer (- max-abs-rem) 0)))
+      (define-exact-integer! result
+        (- max-abs-rem)
+        (if (< 0 (&max a)) max-abs-rem 0)))
      (else
-      (define! result &exact-integer 0 max-abs-rem)))))
+      (define-exact-integer! result 0 max-abs-rem)))))
 
 (define-type-checker-aliases quo mod)
 (define-type-inferrer (mod a b result)
@@ -1165,53 +1289,31 @@ minimum, and maximum."
   (let ((max-abs-mod (1- (max (abs (&min b)) (abs (&max b))))))
     (cond
      ((< (&min b) 0)
-      (if (< 0 (&max b))
-          (define! result &exact-integer (- max-abs-mod) max-abs-mod)
-          (define! result &exact-integer (- max-abs-mod) 0)))
+      (define-exact-integer! result
+        (- max-abs-mod)
+        (if (< 0 (&max b)) max-abs-mod 0)))
      (else
-      (define! result &exact-integer 0 max-abs-mod)))))
+      (define-exact-integer! result 0 max-abs-mod)))))
 
 ;; Predicates.
-(define-syntax-rule (define-number-kind-predicate-inferrer name type)
-  (define-type-inferrer (name val result)
-    (cond
-     ((zero? (logand (&type val) type))
-      (define! result &false 0 0))
-     ((zero? (logand (&type val) (lognot type)))
-      (define! result &true 0 0))
-     (else
-      (define! result (logior &true &false) 0 0)))))
-(define-number-kind-predicate-inferrer complex? &number)
-(define-number-kind-predicate-inferrer real? &real)
-(define-number-kind-predicate-inferrer rational?
-  (logior &exact-integer &fraction))
-(define-number-kind-predicate-inferrer integer?
-  (logior &exact-integer &flonum))
-(define-number-kind-predicate-inferrer exact-integer?
-  &exact-integer)
+(define-syntax-rule (define-type-predicate-result val result type)
+  (cond
+   ((zero? (logand (&type val) type))
+    (define! result &special-immediate &false &false))
+   ((zero? (logand (&type val) (lognot type)))
+    (define! result &special-immediate &true &true))
+   (else
+    (define! result &special-immediate &false &true))))
 
 (define-simple-type-checker (exact? &number))
 (define-type-inferrer (exact? val result)
   (restrict! val &number -inf.0 +inf.0)
-  (cond
-   ((zero? (logand (&type val) (logior &exact-integer &fraction)))
-    (define! result &false 0 0))
-   ((zero? (logand (&type val) (lognot (logior &exact-integer &fraction))))
-    (define! result &true 0 0))
-   (else
-    (define! result (logior &true &false) 0 0))))
+  (define-type-predicate-result val result &exact-number))
 
 (define-simple-type-checker (inexact? &number))
 (define-type-inferrer (inexact? val result)
   (restrict! val &number -inf.0 +inf.0)
-  (cond
-   ((zero? (logand (&type val) (logior &flonum &complex)))
-    (define! result &false 0 0))
-   ((zero? (logand (&type val) (logand &number
-                                       (lognot (logior &flonum &complex)))))
-    (define! result &true 0 0))
-   (else
-    (define! result (logior &true &false) 0 0))))
+  (define-type-predicate-result val result (logior &flonum &complex)))
 
 (define-simple-type-checker (inf? &real))
 (define-type-inferrer (inf? val result)
@@ -1219,60 +1321,116 @@ minimum, and maximum."
   (cond
    ((or (zero? (logand (&type val) (logior &flonum &complex)))
         (and (not (inf? (&min val))) (not (inf? (&max val)))))
-    (define! result &false 0 0))
+    (define! result &special-immediate &false &false))
    (else
-    (define! result (logior &true &false) 0 0))))
+    (define! result &special-immediate &false &true))))
 
 (define-type-aliases inf? nan?)
 
 (define-simple-type (even? &exact-integer)
-  ((logior &true &false) 0 0))
+  (&special-immediate &false &true))
 (define-type-aliases even? odd?)
 
 ;; Bit operations.
-(define-simple-type-checker (ash &exact-integer &exact-integer))
-(define-type-inferrer (ash val count result)
+(define-simple-type-checker (lsh &exact-integer &u64))
+(define-simple-type-checker (rsh &exact-integer &u64))
+(define (compute-ash-range min-val max-val min-shift max-shift)
   (define (ash* val count)
     ;; As we only precisely represent a 64-bit range, don't bother inferring
     ;; shifts that might exceed that range.
     (cond
      ((inf? val) val) ; Preserves sign.
-     ((< -64 count 64) (ash val count))
+     ((< count 64) (ash val (max count 0)))
      ((zero? val) 0)
      ((positive? val) +inf.0)
      (else -inf.0)))
+  (let ((-- (ash* min-val min-shift))
+        (-+ (ash* min-val max-shift))
+        (++ (ash* max-val max-shift))
+        (+- (ash* max-val min-shift)))
+    (values (min -- -+ ++ +-) (max -- -+ ++ +-))))
+(define-type-inferrer (lsh val count result)
+  (restrict! val &exact-integer -inf.0 +inf.0)
+  (let-values (((min max) (compute-ash-range (&min val)
+                                             (&max val)
+                                             (&min/0 count)
+                                             (&max/u64 count))))
+    (define-exact-integer! result min max)))
+(define-type-inferrer/param (lsh/immediate count val result)
+  (restrict! val &exact-integer -inf.0 +inf.0)
+  (let-values (((min max) (compute-ash-range (&min val)
+                                             (&max val)
+                                             count count)))
+    (define-exact-integer! result min max)))
+(define-type-inferrer (rsh val count result)
   (restrict! val &exact-integer -inf.0 +inf.0)
-  (restrict! count &exact-integer -inf.0 +inf.0)
-  (let ((-- (ash* (&min val) (&min count)))
-        (-+ (ash* (&min val) (&max count)))
-        (++ (ash* (&max val) (&max count)))
-        (+- (ash* (&max val) (&min count))))
-    (define! result &exact-integer
-             (min -- -+ ++ +-)
-             (max -- -+ ++ +-))))
-
-(define-simple-type-checker (ursh &u64 &u64))
+  (let-values (((min max) (compute-ash-range (&min val)
+                                             (&max val)
+                                             (- (&min/0 count))
+                                             (- (&max/u64 count)))))
+    (define-exact-integer! result min max)))
+(define-type-inferrer/param (rsh/immediate count val result)
+  (restrict! val &exact-integer -inf.0 +inf.0)
+  (let-values (((min max) (compute-ash-range (&min val)
+                                             (&max val)
+                                             (- count) (- count))))
+    (define-exact-integer! result min max)))
+
 (define-type-inferrer (ursh a b result)
-  (restrict! a &u64 0 &u64-max)
-  (restrict! b &u64 0 &u64-max)
   (define! result &u64
-    (ash (&min/0 a) (- (&max/u64 b)))
-    (ash (&max/u64 a) (- (&min/0 b)))))
-(define-type-aliases ursh ursh/immediate)
+    (ash (&min/0 a) (- (min 63 (&max/u64 b))))
+    (ash (&max/u64 a) (- (min 63 (&min/0 b))))))
+(define-type-inferrer/param (ursh/immediate param a result)
+  (define! result &u64
+    (ash (&min/0 a) (- param))
+    (ash (&max/u64 a) (- param))))
+
+(define-type-inferrer (srsh a b result)
+  (let-values (((min max) (compute-ash-range (&min/s64 a)
+                                             (&max/s64 a)
+                                             (- (min 63 (&min/0 b)))
+                                             (- (min 63 (&max/u64 b))))))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
+(define-type-inferrer/param (srsh/immediate count val result)
+  (let-values (((min max) (compute-ash-range (&min/s64 val)
+                                             (&max/s64 val)
+                                             (- count) (- count))))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
 
-(define-simple-type-checker (ulsh &u64 &u64))
 (define-type-inferrer (ulsh a b result)
-  (restrict! a &u64 0 &u64-max)
-  (restrict! b &u64 0 &u64-max)
-  (if (and (< (&max/u64 b) 64)
-           (<= (ash (&max/u64 a) (&max/u64 b)) &u64-max))
+  (if (<= (ash (&max/u64 a) (&max/u64 b)) &u64-max)
       ;; No overflow; we can be precise.
       (define! result &u64
         (ash (&min/0 a) (&min/0 b))
         (ash (&max/u64 a) (&max/u64 b)))
       ;; Otherwise assume the whole range.
       (define! result &u64 0 &u64-max)))
-(define-type-aliases ulsh ulsh/immediate)
+(define-type-inferrer/param (ulsh/immediate param a result)
+  (if (<= (ash (&max/u64 a) param) &u64-max)
+      ;; No overflow; we can be precise.
+      (define! result &u64
+        (ash (&min/0 a) param)
+        (ash (&max/u64 a) param))
+      ;; Otherwise assume the whole range.
+      (define! result &u64 0 &u64-max)))
+
+(define-type-inferrer (slsh a b result)
+  (let-values (((min max) (compute-ash-range (&min a) (&max a)
+                                             (min 63 (&min/0 b))
+                                             (min 63 (&max/u64 b)))))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
+(define-type-inferrer/param (slsh/immediate param a result)
+  (let-values (((min max) (compute-ash-range (&min a) (&max a)
+                                             param param)))
+    (if (<= &s64-min min max &s64-max)
+        (define! result &s64 min max)
+        (define! result &s64 &s64-min &s64-max))))
 
 (define-inlinable (non-negative? n)
   "Return true if N is non-negative, otherwise return false."
@@ -1346,9 +1504,8 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
   (call-with-values (lambda ()
                       (logand-bounds (&min a) (&max a) (&min b) (&max b)))
     (lambda (min max)
-      (define! result &exact-integer min max))))
+      (define-exact-integer! result min max))))
 
-(define-simple-type-checker (ulogand &u64 &u64))
 (define-type-inferrer (ulogand a b result)
   (restrict! a &u64 0 &u64-max)
   (restrict! b &u64 0 &u64-max)
@@ -1370,9 +1527,8 @@ i.e. (logand A (lognot B)), where (A0 <= A <= A1) and (B0 <= B <= B1)."
   (call-with-values (lambda ()
                       (logsub-bounds (&min a) (&max a) (&min b) (&max b)))
     (lambda (min max)
-      (define! result &exact-integer min max))))
+      (define-exact-integer! result min max))))
 
-(define-simple-type-checker (ulogsub &u64 &u64))
 (define-type-inferrer (ulogsub a b result)
   (restrict! a &u64 0 &u64-max)
   (restrict! b &u64 0 &u64-max)
@@ -1418,9 +1574,8 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
   (call-with-values (lambda ()
                       (logior-bounds (&min a) (&max a) (&min b) (&max b)))
     (lambda (min max)
-      (define! result &exact-integer min max))))
+      (define-exact-integer! result min max))))
 
-(define-simple-type-checker (ulogior &u64 &u64))
 (define-type-inferrer (ulogior a b result)
   (restrict! a &u64 0 &u64-max)
   (restrict! b &u64 0 &u64-max)
@@ -1478,7 +1633,6 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
     (lambda (min max)
       (define! result &exact-integer min max))))
 
-(define-simple-type-checker (ulogxor &u64 &u64))
 (define-type-inferrer (ulogxor a b result)
   (restrict! a &u64 0 &u64-max)
   (restrict! b &u64 0 &u64-max)
@@ -1487,14 +1641,15 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
 (define-simple-type-checker (lognot &exact-integer))
 (define-type-inferrer (lognot a result)
   (restrict! a &exact-integer -inf.0 +inf.0)
-  (define! result &exact-integer
-           (lognot* (&max a))
-           (lognot* (&min a))))
+  (define-exact-integer! result
+    (lognot* (&max a))
+    (lognot* (&min a))))
 
 (define-simple-type-checker (logtest &exact-integer &exact-integer))
-(define-predicate-inferrer (logtest a b true?)
+(define-type-inferrer (logtest a b result)
   (restrict! a &exact-integer -inf.0 +inf.0)
-  (restrict! b &exact-integer -inf.0 +inf.0))
+  (restrict! b &exact-integer -inf.0 +inf.0)
+  (define! result &special-immediate &false &true))
 
 (define-simple-type-checker (logbit? (&exact-integer 0 +inf.0) &exact-integer))
 (define-type-inferrer (logbit? a b result)
@@ -1504,9 +1659,9 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
         (b-max (&max b)))
     (if (and (eqv? a-min a-max) (>= a-min 0) (not (inf? a-min))
              (eqv? b-min b-max) (>= b-min 0) (not (inf? b-min)))
-        (let ((type (if (logbit? a-min b-min) &true &false)))
-          (define! result type 0 0))
-        (define! result (logior &true &false) 0 0))))
+        (let ((bool (if (logbit? a-min b-min) &true &false)))
+          (define! result &special-immediate bool bool))
+        (define! result &special-immediate &false &true))))
 
 ;; Flonums.
 (define-simple-type-checker (sqrt &number))
@@ -1530,17 +1685,25 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
 (define-type-inferrer (abs x result)
   (let ((type (&type x)))
     (cond
-     ((eqv? type (logand type &number))
-      (restrict! x &real -inf.0 +inf.0)
-      (define! result (logand type &real)
-        (min (abs (&min x)) (abs (&max x)))
-        (max (abs (&min x)) (abs (&max x)))))
+     ((type<=? type &exact-integer)
+      (if (< (&min x) 0)
+          (define-exact-integer! result 0 (max (abs (&min x)) (abs (&max x))))
+          (define! result type (&min x) (&max x))))
      (else
-      (define! result (logior (logand (&type x) (lognot &number))
-                              (logand (&type x) &real))
-        (&min/0 x)
-        (max (abs (&min x)) (abs (&max x))))))))
-
+      (when (type<=? type &number)
+        (restrict! x &real -inf.0 +inf.0))
+      (let* ((min (if (< (&min x) 0) 0 (&min x)))
+             (max (max (abs (&min x)) (abs (&max x))))
+             (type (cond
+                    ((not (logtest type &exact-integer)) type)
+                    ((< (target-most-positive-fixnum) min)
+                     (logior &bignum (logand type (lognot &fixnum))))
+                    ((<= max (target-most-positive-fixnum))
+                     (logior &fixnum (logand type (lognot &bignum))))
+                    (else (logior type &fixnum &bignum)))))
+        (define! result (logior (logand type (lognot &number))
+                                (logand type &real))
+          min max))))))
 
 
 
@@ -1548,15 +1711,10 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
 ;;; Characters.
 ;;;
 
-(define-simple-type-checker (integer->char (&u64 0 *max-codepoint*)))
-(define-type-inferrer (integer->char i result)
-  (restrict! i &u64 0 *max-codepoint*)
-  (define! result &char (&min/0 i) (min (&max i) *max-codepoint*)))
-
-(define-simple-type-checker (char->integer &char))
-(define-type-inferrer (char->integer c result)
-  (restrict! c &char 0 *max-codepoint*)
-  (define! result &u64 (&min/0 c) (min (&max c) *max-codepoint*)))
+(define-type-inferrer (untag-char c result)
+  (define! result &s64 0 (min (&max c) *max-codepoint*)))
+(define-type-inferrer (tag-char u64 result)
+  (define! result &char 0 (min (&max u64) *max-codepoint*)))
 
 
 
@@ -1567,10 +1725,9 @@ where (A0 <= A <= A1) and (B0 <= B <= B1)."
 
 (define (successor-count cont)
   (match cont
-    (($ $kargs _ _ ($ $continue k src exp))
-     (match exp
-       ((or ($ $branch) ($ $prompt)) 2)
-       (_ 1)))
+    (($ $kargs _ _ ($ $throw)) 0)
+    (($ $kargs _ _ ($ $continue)) 1)
+    (($ $kargs _ _ (or ($ $branch) ($ $prompt))) 2)
     (($ $kfun src meta self tail clause) (if clause 1 0))
     (($ $kclause arity body alt) (if alt 2 1))
     (($ $kreceive) 1)
@@ -1644,13 +1801,13 @@ maximum, where type is a bitset as a fixnum."
       ((var . vars)
        (adjoin-vars (adjoin-var types var entry) vars entry))))
 
-  (define (infer-primcall types succ name args result)
+  (define (infer-primcall types succ name param args result)
     (cond
      ((hashq-ref *type-inferrers* name)
       => (lambda (inferrer)
            ;; FIXME: remove the apply?
            ;; (pk 'primcall name args result)
-           (apply inferrer types succ
+           (apply inferrer types succ param
                   (if result
                       (append args (list result))
                       args))))
@@ -1707,31 +1864,11 @@ maximum, where type is a bitset as a fixnum."
         (values (append changed0 changed1) typev)))
     ;; Each of these branches must propagate to its successors.
     (match exp
-      (($ $branch kt ($ $values (arg)))
-       ;; The "normal" continuation is the #f branch.
-       (let ((kf-types (restrict-var types arg
-                                     (make-type-entry (logior &false &nil)
-                                                      0
-                                                      0)))
-             (kt-types (restrict-var types arg
-                                     (make-type-entry
-                                      (logand &all-types 
-                                              (lognot (logior &false &nil)))
-                                      -inf.0 +inf.0))))
-         (propagate2 k kf-types kt kt-types)))
-      (($ $branch kt ($ $primcall name args))
-       ;; The "normal" continuation is the #f branch.
-       (let ((kf-types (infer-primcall types 0 name args #f))
-             (kt-types (infer-primcall types 1 name args #f)))
-         (propagate2 k kf-types kt kt-types)))
-      (($ $prompt escape? tag handler)
-       ;; The "normal" continuation enters the prompt.
-       (propagate2 k types handler types))
-      (($ $primcall name args)
+      (($ $primcall name param args)
        (propagate1 k
                    (match (intmap-ref conts k)
                      (($ $kargs _ defs)
-                      (infer-primcall types 0 name args
+                      (infer-primcall types 0 name param args
                                       (match defs ((var) var) (() #f))))
                      (_
                       ;; (pk 'warning-no-restrictions name)
@@ -1760,7 +1897,7 @@ maximum, where type is a bitset as a fixnum."
           (let ((entry (match exp
                          (($ $const val)
                           (constant-type val))
-                         ((or ($ $prim) ($ $fun) ($ $closure))
+                         ((or ($ $prim) ($ $fun) ($ $const-fun) ($ $code))
                           ;; Could be more precise here.
                           (make-type-entry &procedure -inf.0 +inf.0)))))
             (propagate1 k (adjoin-var types var entry))))))))
@@ -1783,13 +1920,24 @@ maximum, where type is a bitset as a fixnum."
       (match (intmap-ref conts label)
         (($ $kargs names vars ($ $continue k src exp))
          (visit-exp label typev k types exp))
+        (($ $kargs names vars ($ $branch kf kt src op param args))
+         ;; The "normal" continuation is the #f branch.
+         (propagate2 kf (infer-primcall types 0 op param args #f)
+                     kt (infer-primcall types 1 op param args #f)))
+        (($ $kargs names vars ($ $prompt k kh src escape? tag))
+         ;; The "normal" continuation enters the prompt.
+         (propagate2 k types kh types))
+        (($ $kargs names vars ($ $throw))
+         (propagate0))
         (($ $kreceive arity k)
          (match (intmap-ref conts k)
            (($ $kargs names vars)
             (propagate1 k (adjoin-vars types vars all-types-entry)))))
         (($ $kfun src meta self tail clause)
          (if clause
-             (propagate1 clause (adjoin-var types self all-types-entry))
+             (propagate1 clause (if self
+                                    (adjoin-var types self all-types-entry)
+                                    types))
              (propagate0)))
         (($ $kclause arity kbody kalt)
          (match (intmap-ref conts kbody)
@@ -1818,9 +1966,9 @@ maximum, where type is a bitset as a fixnum."
             (type-entry-min tentry)
             (type-entry-max tentry))))
 
-(define (primcall-types-check? types label name args)
+(define (primcall-types-check? types label name param args)
   (match (hashq-ref *type-checkers* name)
     (#f #f)
     (checker
      (let ((entry (intmap-ref types label)))
-       (apply checker (vector-ref entry 0) args)))))
+       (apply checker (vector-ref entry 0) param args)))))
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index 3fce00a99..9359f0cb7 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -46,7 +46,6 @@
             fixpoint
 
             ;; Flow analysis.
-            compute-constant-values
             compute-function-body
             compute-reachable-functions
             compute-successors
@@ -93,7 +92,7 @@
                          (match cont
                            (($ $kargs names syms body)
                             (apply max max-var syms))
-                           (($ $kfun src meta self)
+                           (($ $kfun src meta (and self (not #f)))
                             (max max-var self))
                            (_ max-var)))
                        conts
@@ -180,62 +179,6 @@ disjoint, an error will be signalled."
                (values x0* x1*)
                (lp x0* x1*))))))))
 
-(define (compute-defining-expressions conts)
-  (define (meet-defining-expressions old new)
-    ;; If there are multiple definitions and they are different, punt
-    ;; and record #f.
-    (if (equal? old new)
-        old
-        #f))
-  (persistent-intmap
-   (intmap-fold (lambda (label cont defs)
-                  (match cont
-                    (($ $kargs _ _ ($ $continue k src exp))
-                     (match (intmap-ref conts k)
-                       (($ $kargs (_) (var))
-                        (intmap-add! defs var exp meet-defining-expressions))
-                       (_ defs)))
-                    (_ defs)))
-                conts
-                empty-intmap)))
-
-(define (compute-constant-values conts)
-  (let ((defs (compute-defining-expressions conts)))
-    (persistent-intmap
-     (intmap-fold
-      (lambda (var exp out)
-        (match exp
-          (($ $primcall (or 'load-f64 'load-u64 'load-s64) (val))
-           (intmap-add! out var (intmap-ref out val)))
-          ;; Punch through type conversions to allow uadd to specialize
-          ;; to uadd/immediate.
-          (($ $primcall 'scm->f64 (val))
-           (let ((f64 (intmap-ref out val (lambda (_) #f))))
-             (if (and f64 (number? f64) (inexact? f64) (real? f64))
-                 (intmap-add! out var f64)
-                 out)))
-          (($ $primcall (or 'scm->u64 'scm->u64/truncate) (val))
-           (let ((u64 (intmap-ref out val (lambda (_) #f))))
-             (if (and u64 (number? u64) (exact-integer? u64)
-                      (<= 0 u64 #xffffFFFFffffFFFF))
-                 (intmap-add! out var u64)
-                 out)))
-          (($ $primcall 'scm->s64 (val))
-           (let ((s64 (intmap-ref out val (lambda (_) #f))))
-             (if (and s64 (number? s64) (exact-integer? s64)
-                      (<= (- #x8000000000000000) s64 #x7fffFFFFffffFFFF))
-                 (intmap-add! out var s64)
-                 out)))
-          (_ out)))
-      defs
-      (intmap-fold (lambda (var exp out)
-                     (match exp
-                       (($ $const val)
-                        (intmap-add! out var val))
-                       (_ out)))
-                   defs
-                   empty-intmap)))))
-
 (define (compute-function-body conts kfun)
   (persistent-intset
    (let visit-cont ((label kfun) (labels empty-intset))
@@ -255,13 +198,16 @@ disjoint, an error will be signalled."
             (if kalt
                 (visit-cont kalt (visit-cont kbody labels))
                 (visit-cont kbody labels)))
-           (($ $kargs names syms ($ $continue k src exp))
-            (visit-cont k (match exp
-                            (($ $branch k)
-                             (visit-cont k labels))
-                            (($ $prompt escape? tag k)
-                             (visit-cont k labels))
-                            (_ labels)))))))))))
+           (($ $kargs names syms term)
+            (match term
+              (($ $continue k)
+               (visit-cont k labels))
+              (($ $branch kf kt)
+               (visit-cont kf (visit-cont kt labels)))
+              (($ $prompt k kh)
+               (visit-cont k (visit-cont kh labels)))
+              (($ $throw)
+               labels))))))))))
 
 (define* (compute-reachable-functions conts #:optional (kfun 0))
   "Compute a mapping LABEL->LABEL..., where each key is a reachable
@@ -279,7 +225,8 @@ intset."
           (match exp
             (($ $fun label) (return1 label))
             (($ $rec _ _ (($ $fun labels) ...)) (return labels))
-            (($ $closure label nfree) (return1 label))
+            (($ $const-fun label) (return1 label))
+            (($ $code label) (return1 label))
             (($ $callk label) (return1 label))
             (_ (return0))))
          (_ (return0))))
@@ -314,11 +261,12 @@ intset."
       (if (intmap-ref succs label (lambda (_) #f))
           succs
           (match (intmap-ref conts label)
-            (($ $kargs names vars ($ $continue k src exp))
-             (match exp
-               (($ $branch kt) (propagate2 k kt))
-               (($ $prompt escape? tag handler) (propagate2 k handler))
-               (_ (propagate1 k))))
+            (($ $kargs names vars term)
+             (match term
+               (($ $continue k) (propagate1 k))
+               (($ $branch kf kt) (propagate2 kf kt))
+               (($ $prompt k kh) (propagate2 k kh))
+               (($ $throw) (propagate0))))
             (($ $kreceive arity k)
              (propagate1 k))
             (($ $kfun src meta self tail clause)
@@ -348,12 +296,12 @@ intset."
        preds)
       (($ $kclause arity kbody kalt)
        (add-pred kbody (if kalt (add-pred kalt preds) preds)))
-      (($ $kargs names syms ($ $continue k src exp))
-       (add-pred k
-                 (match exp
-                   (($ $branch k) (add-pred k preds))
-                   (($ $prompt _ _ k) (add-pred k preds))
-                   (_ preds))))))
+      (($ $kargs names syms term)
+       (match term
+         (($ $continue k)   (add-pred k preds))
+         (($ $branch kf kt) (add-pred kf (add-pred kt preds)))
+         (($ $prompt k kh)  (add-pred k (add-pred kh preds)))
+         (($ $throw)        preds)))))
   (persistent-intmap
    (intset-fold add-preds labels
                 (intset->intmap (lambda (label) '()) labels))))
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 1a9eb72e3..cacde9ec5 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -1,5 +1,5 @@
 ;;; Diagnostic checker for CPS
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -27,7 +27,6 @@
   #:use-module (language cps utils)
   #:use-module (language cps intmap)
   #:use-module (language cps intset)
-  #:use-module (language cps primitives)
   #:use-module (srfi srfi-11)
   #:export (verify))
 
@@ -63,9 +62,9 @@
   (intmap-fold
    (lambda (label cont seen)
      (match (intmap-ref conts label)
-       (($ $kargs names vars ($ $continue k src exp))
+       (($ $kargs names vars term)
         (fold1 adjoin-def vars seen))
-       (($ $kfun src meta self tail clause)
+       (($ $kfun src meta (and self (not #f)) tail clause)
         (adjoin-def self seen))
        (_ seen))
      )
@@ -100,16 +99,21 @@ definitions that are available at LABEL."
           (values (append changed0 changed1) defs)))
 
       (match (intmap-ref conts label)
-        (($ $kargs names vars ($ $continue k src exp))
+        (($ $kargs names vars term)
          (let ((out (fold1 adjoin-def vars in)))
-           (match exp
-             (($ $branch kt) (propagate2 k kt out))
-             (($ $prompt escape? tag handler) (propagate2 k handler out))
-             (_ (propagate1 k out)))))
+           (match term
+             (($ $continue k)
+              (propagate1 k out))
+             (($ $branch kf kt)
+              (propagate2 kf kt out))
+             (($ $prompt k kh)
+              (propagate2 k kh out))
+             (($ $throw)
+              (propagate0 out)))))
         (($ $kreceive arity k)
          (propagate1 k in))
         (($ $kfun src meta self tail clause)
-         (let ((out (adjoin-def self in)))
+         (let ((out (if self (adjoin-def self in) in)))
            (if clause
                (propagate1 clause out)
                (propagate0 out))))
@@ -139,10 +143,11 @@ definitions that are available at LABEL."
             (visit-fun kfun empty-intset (intset-add first-order kfun))))
       (match exp
         ((or ($ $const) ($ $prim)) first-order)
-        ;; todo: $closure
         (($ $fun kfun)
          (visit-fun kfun bound first-order))
-        (($ $closure kfun)
+        (($ $const-fun kfun)
+         (visit-first-order kfun))
+        (($ $code kfun)
          (visit-first-order kfun))
         (($ $rec names vars (($ $fun kfuns) ...))
          (let ((bound (fold1 adjoin-def vars bound)))
@@ -157,27 +162,64 @@ definitions that are available at LABEL."
          (for-each check-use args)
          first-order)
         (($ $callk kfun proc args)
-         (check-use proc)
+         (when proc (check-use proc))
          (for-each check-use args)
          (visit-first-order kfun))
-        (($ $branch kt ($ $values (arg)))
-         (check-use arg)
-         first-order)
-        (($ $branch kt ($ $primcall name args))
+        (($ $primcall name param args)
          (for-each check-use args)
-         first-order)
-        (($ $primcall name args)
+         first-order)))
+    (define (visit-term term bound first-order)
+      (define (check-use var)
+        (unless (intset-ref bound var)
+          (error "unbound var" var)))
+      (define (visit-first-order kfun)
+        (if (intset-ref first-order kfun)
+            first-order
+            (visit-fun kfun empty-intset (intset-add first-order kfun))))
+      (match term
+        (($ $continue k src exp)
+         (match exp
+           ((or ($ $const) ($ $prim)) first-order)
+           (($ $fun kfun)
+            (visit-fun kfun bound first-order))
+           (($ $const-fun kfun)
+            (visit-first-order kfun))
+           (($ $code kfun)
+            (visit-first-order kfun))
+           (($ $rec names vars (($ $fun kfuns) ...))
+            (let ((bound (fold1 adjoin-def vars bound)))
+              (fold1 (lambda (kfun first-order)
+                       (visit-fun kfun bound first-order))
+                     kfuns first-order)))
+           (($ $values args)
+            (for-each check-use args)
+            first-order)
+           (($ $call proc args)
+            (check-use proc)
+            (for-each check-use args)
+            first-order)
+           (($ $callk kfun proc args)
+            (when proc (check-use proc))
+            (for-each check-use args)
+            (visit-first-order kfun))
+           (($ $primcall name param args)
+            (for-each check-use args)
+            first-order)))
+        (($ $branch kf kt src name param args)
          (for-each check-use args)
          first-order)
-        (($ $prompt escape? tag handler)
+        (($ $prompt k kh src escape? tag)
          (check-use tag)
+         first-order)
+        (($ $throw src op param args)
+         (for-each check-use args)
          first-order)))
     (intmap-fold
      (lambda (label bound first-order)
        (let ((bound (intset-union free bound)))
          (match (intmap-ref conts label)
-           (($ $kargs names vars ($ $continue k src exp))
-            (visit-exp exp (fold1 adjoin-def vars bound) first-order))
+           (($ $kargs names vars term)
+            (visit-term term (fold1 adjoin-def vars bound) first-order))
            (_ first-order))))
      (compute-available-definitions conts kfun)
      first-order)))
@@ -222,7 +264,7 @@ definitions that are available at LABEL."
         ((or ($ $kreceive) ($ $ktail)) #t)
         (_ (error "expected $kreceive or $ktail continuation" cont))))
     (match exp
-      ((or ($ $const) ($ $prim) ($ $closure) ($ $fun))
+      ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $fun))
        (assert-unary))
       (($ $rec names vars funs)
        (unless (= (length names) (length vars) (length funs))
@@ -240,39 +282,42 @@ definitions that are available at LABEL."
        (assert-kreceive-or-ktail))
       (($ $callk k proc args)
        (assert-kreceive-or-ktail))
-      (($ $branch kt exp)
-       (assert-nullary)
+      (($ $primcall name param args)
+       (match cont
+         (($ $kargs) #t)
+         (($ $kreceive)
+          (match exp
+            (($ $primcall 'call-thunk/no-inline #f (thunk)) #t)
+            (_ (cont (error "bad continuation" exp cont)))))))))
+  (define (check-term term)
+    (match term
+      (($ $continue k src exp)
+       (check-arity exp (intmap-ref conts k)))
+      (($ $branch kf kt src op param args)
+       (match (intmap-ref conts kf)
+         (($ $kargs () ()) #t)
+         (cont (error "bad kf" cont)))
        (match (intmap-ref conts kt)
          (($ $kargs () ()) #t)
          (cont (error "bad kt" cont))))
-      (($ $primcall name args)
-       (match cont
-         (($ $kargs names)
-          (match (prim-arity name)
-            ((out . in)
-             (unless (= in (length args))
-               (error "bad arity to primcall" name args in))
-             (unless (= out (length names))
-               (error "bad return arity from primcall" name names out)))))
-         (($ $kreceive)
-          (when (false-if-exception (prim-arity name))
-            (error "primitive should continue to $kargs, not $kreceive" name)))
-         (($ $ktail)
-          (error "primitive should continue to $kargs, not $ktail" name))))
-      (($ $prompt escape? tag handler)
-       (assert-nullary)
-       (match (intmap-ref conts handler)
+      (($ $prompt k kh src escape? tag)
+       (match (intmap-ref conts k)
+         (($ $kargs () ()) #t)
+         (cont (error "bad prompt body" cont)))
+       (match (intmap-ref conts kh)
          (($ $kreceive) #t)
-         (cont (error "bad handler" cont))))))
+         (cont (error "bad prompt handler" cont))))
+      (($ $throw)
+       #t)))
   (let ((reachable (compute-reachable-labels conts kfun)))
     (intmap-for-each
      (lambda (label cont)
        (when (intset-ref reachable label)
          (match cont
-           (($ $kargs names vars ($ $continue k src exp))
+           (($ $kargs names vars term)
             (unless (= (length names) (length vars))
               (error "broken $kargs" label names vars))
-            (check-arity exp (intmap-ref conts k)))
+            (check-term term))
            (_ #t))))
      conts)))
 
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 5fb0ce05f..5cb4710f2 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 2009-2014, 2017 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009-2014, 2017-2018 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -86,7 +86,7 @@
                    (let lp ((n 0) (fields fields)
                             (out (cons*
                                   #`(define (#,ctor #,@sfields)
-                                      (make-struct/no-tail #,type #,@sfields))
+                                      (make-struct/simple #,type #,@sfields))
                                   #`(define (#,pred x)
                                       (and (struct? x)
                                            (eq? (struct-vtable x) #,type)))
@@ -139,9 +139,12 @@
 
 ;; A helper.
 (define (list->seq loc exps)
-  (if (null? (cdr exps))
-      (car exps)
-      (make-seq loc (car exps) (list->seq #f (cdr exps)))))
+  (match exps
+    ((exp . exps)
+     (let lp ((head exp) (tail exps))
+       (match tail
+         (() head)
+         ((exp . tail) (lp (make-seq loc head exp) tail)))))))
 
 
 
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 62bf7933e..6c8884add 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -54,16 +54,1325 @@
   #:use-module ((srfi srfi-1) #:select (fold filter-map))
   #:use-module (srfi srfi-26)
   #:use-module ((system foreign) #:select (make-pointer pointer->scm))
+  #:use-module (system base target)
+  #:use-module (system base types internal)
   #:use-module (language cps)
   #:use-module (language cps utils)
   #:use-module (language cps with-cps)
-  #:use-module (language cps primitives)
+  #:use-module (language tree-il cps-primitives)
   #:use-module (language tree-il analyze)
   #:use-module (language tree-il optimize)
   #:use-module (language tree-il)
   #:use-module (language cps intmap)
   #:export (compile-cps))
 
+(define (convert-primcall/default cps k src op param . args)
+  (with-cps cps
+    (build-term
+      ($continue k src ($primcall op param args)))))
+
+(define *primcall-converters* (make-hash-table))
+(define-syntax-rule (define-primcall-converter name proc)
+  (hashq-set! *primcall-converters* 'name proc))
+
+(define (convert-primcall* cps k src op param args)
+  (let ((proc (hashq-ref *primcall-converters* op convert-primcall/default)))
+    (apply proc cps k src op param args)))
+
+(define (convert-primcall cps k src op param . args)
+  (convert-primcall* cps k src op param args))
+
+(define (ensure-vector cps src op pred v have-length)
+  (define msg
+    (match pred
+      ('vector?
+       "Wrong type argument in position 1 (expecting vector): ~S")
+      ('mutable-vector?
+       "Wrong type argument in position 1 (expecting mutable vector): ~S")))
+  (define not-vector (vector 'wrong-type-arg (symbol->string op) msg))
+  (with-cps cps
+    (letv w0 slen ulen rlen)
+    (letk knot-vector
+          ($kargs () () ($throw src 'throw/value+data not-vector (v))))
+    (let$ body (have-length slen))
+    (letk k ($kargs ('slen) (slen) ,body))
+    (letk kcast
+          ($kargs ('rlen) (rlen)
+            ($continue k src ($primcall 'u64->s64 #f (rlen)))))
+    (letk kassume
+          ($kargs ('ulen) (ulen)
+            ($continue kcast src
+              ($primcall 'assume-u64 `(0 . ,(target-max-vector-length)) (ulen)))))
+    (letk krsh
+          ($kargs ('w0) (w0)
+            ($continue kassume src ($primcall 'ursh/immediate 8 (w0)))))
+    (letk kv
+          ($kargs () ()
+            ($continue krsh src
+              ($primcall 'word-ref/immediate '(vector . 0) (v)))))
+    (letk kheap-object
+          ($kargs () ()
+            ($branch knot-vector kv src pred #f (v))))
+    (build-term
+      ($branch knot-vector kheap-object src 'heap-object? #f (v)))))
+
+(define (untag-fixnum-index-in-range cps src op idx slen have-index-in-range)
+  ;; Precondition: SLEN is a non-negative S64 that is representable as a
+  ;; fixnum.
+  (define not-fixnum
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 2 (expecting small integer): ~S"))
+  (define out-of-range
+    (vector 'out-of-range
+            (symbol->string op)
+            "Argument 2 out of range: ~S"))
+  (with-cps cps
+    (letv sidx)
+    (letk knot-fixnum
+          ($kargs () () ($throw src 'throw/value+data not-fixnum (idx))))
+    (letk kout-of-range
+          ($kargs () () ($throw src 'throw/value+data out-of-range (idx))))
+    (let$ body (have-index-in-range sidx))
+    (letk k ($kargs () () ,body))
+    (letk kboundlen
+          ($kargs () ()
+            ($branch kout-of-range k src 's64-< #f (sidx slen))))
+    (letk kbound0
+          ($kargs ('sidx) (sidx)
+            ($branch kboundlen kout-of-range src 's64-imm-< 0 (sidx))))
+    (letk kuntag
+          ($kargs () ()
+            ($continue kbound0 src ($primcall 'untag-fixnum #f (idx)))))
+    (build-term ($branch knot-fixnum kuntag src 'fixnum? #f (idx)))))
+
+(define (untag-fixnum-in-imm-range cps src op size min max have-int-in-range)
+  (define not-fixnum
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 2 (expecting small integer): ~S"))
+  (define out-of-range
+    (vector 'out-of-range
+            (symbol->string op)
+            "Argument 2 out of range: ~S"))
+  (with-cps cps
+    (letv ssize)
+    (letk knot-fixnum
+          ($kargs () () ($throw src 'throw/value+data not-fixnum (size))))
+    (letk kout-of-range
+          ($kargs () () ($throw src 'throw/value+data out-of-range (size))))
+    (let$ body (have-int-in-range ssize))
+    (letk k ($kargs () () ,body))
+    (letk kboundlen
+          ($kargs () ()
+            ($branch k kout-of-range src 'imm-s64-< max (ssize))))
+    (letk kbound0
+          ($kargs ('ssize) (ssize)
+            ($branch kboundlen kout-of-range src 's64-imm-< min (ssize))))
+    (letk kuntag
+          ($kargs () ()
+            ($continue kbound0 src ($primcall 'untag-fixnum #f (size)))))
+    (build-term ($branch knot-fixnum kuntag src 'fixnum? #f (size)))))
+
+(define (compute-vector-access-pos cps src sidx have-pos)
+  (with-cps cps
+    (letv spos upos)
+    (let$ body (have-pos upos))
+    (letk kref ($kargs ('pos) (upos) ,body))
+    (letk kcvt ($kargs ('pos) (spos)
+                 ($continue kref src ($primcall 's64->u64 #f (spos)))))
+    (build-term
+      ($continue kcvt src ($primcall 'sadd/immediate 1 (sidx))))))
+
+(define (prepare-vector-access cps src op pred v idx access)
+  (ensure-vector
+   cps src op pred v
+   (lambda (cps slen)
+     (untag-fixnum-index-in-range
+      cps src op idx slen
+      (lambda (cps sidx)
+        (compute-vector-access-pos
+         cps src sidx
+         (lambda (cps pos)
+           (access cps v pos))))))))
+
+(define (prepare-vector-access/immediate cps src op pred v idx access)
+  (unless (and (exact-integer? idx) (<= 0 idx (1- (target-max-vector-length))))
+    (error "precondition failed" idx))
+  (ensure-vector
+   cps src op pred v
+   (lambda (cps slen)
+     (define out-of-range
+       (vector 'out-of-range
+               (symbol->string op)
+               "Argument 2 out of range: ~S"))
+     (with-cps cps
+       (letv tidx)
+       (letk kthrow
+             ($kargs ('tidx) (tidx)
+               ($throw src 'throw/value+data out-of-range (tidx))))
+       (letk kout-of-range
+             ($kargs () ()
+               ($continue kthrow src ($const idx))))
+       (let$ body (access v (1+ idx)))
+       (letk k ($kargs () () ,body))
+       (build-term
+         ($branch kout-of-range k src 'imm-s64-< idx (slen)))))))
+
+(define-primcall-converter vector-length
+  (lambda (cps k src op param v)
+    (ensure-vector
+     cps src op 'vector? v
+     (lambda (cps slen)
+       (with-cps cps
+         (build-term
+           ($continue k src ($primcall 'tag-fixnum #f (slen)))))))))
+
+(define-primcall-converter vector-ref
+  (lambda (cps k src op param v idx)
+    (prepare-vector-access
+     cps src op 'vector? v idx
+     (lambda (cps v upos)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-ref 'vector (v upos)))))))))
+
+(define-primcall-converter vector-ref/immediate
+  (lambda (cps k src op param v)
+    (prepare-vector-access/immediate
+     cps src 'vector-ref 'vector? v param
+     (lambda (cps v pos)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-ref/immediate `(vector . ,pos) (v)))))))))
+
+(define-primcall-converter vector-set!
+  (lambda (cps k src op param v idx val)
+    (prepare-vector-access
+     cps src op 'mutable-vector? v idx
+     (lambda (cps v upos)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-set! 'vector (v upos val)))))))))
+
+(define-primcall-converter vector-set!/immediate
+  (lambda (cps k src op param v val)
+    (prepare-vector-access/immediate
+     cps src 'vector-set! 'mutable-vector? v param
+     (lambda (cps v pos)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-set!/immediate `(vector . ,pos) (v val)))))))))
+
+(define-primcall-converter vector-init!
+  (lambda (cps k src op param v val)
+    (define pos (1+ param))
+    (with-cps cps
+      (build-term
+        ($continue k src
+          ($primcall 'scm-set!/immediate `(vector . ,pos) (v val)))))))
+
+(define (emit-initializations-as-loop cps k src obj annotation start nwords init)
+  (with-cps cps
+    (letv pos)
+    (letk kloop ,#f) ;; Patched later.
+    (letk kback
+          ($kargs () ()
+            ($continue kloop src
+              ($primcall 'uadd/immediate 1 (pos)))))
+    (letk kinit
+          ($kargs () ()
+            ($continue kback src
+              ($primcall 'scm-set! annotation (obj pos init)))))
+    (setk kloop
+          ($kargs ('pos) (pos)
+            ($branch k kinit src 'u64-< #f (pos nwords))))
+    (build-term
+      ($continue kloop src
+        ($primcall 'load-u64 start ())))))
+
+(define-primcall-converter allocate-vector
+  (lambda (cps k src op param)
+    (define size param)
+    (define nwords (1+ size))
+    (unless (and (exact-integer? size) (<= 0 size (target-max-vector-length)))
+      (error "precondition failed" size))
+    (with-cps cps
+      (letv v w0)
+      (letk kdone
+            ($kargs () ()
+              ($continue k src ($values (v)))))
+      (letk ktag1
+            ($kargs ('w0) (w0)
+              ($continue kdone src
+                ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+      (letk ktag0
+            ($kargs ('v) (v)
+              ($continue ktag1 src
+                ($primcall 'load-u64 (+ %tc7-vector (ash size 8)) ()))))
+      (build-term
+        ($continue ktag0 src
+          ($primcall 'allocate-words/immediate `(vector . ,nwords) ()))))))
+
+(define-primcall-converter make-vector
+  (lambda (cps k src op param size init)
+    (untag-fixnum-in-imm-range
+     cps src op size 0 (target-max-vector-length)
+     (lambda (cps ssize)
+       (with-cps cps
+         (letv usize nwords v w0-high w0)
+         (letk kdone
+               ($kargs () ()
+                 ($continue k src ($values (v)))))
+         (let$ init-loop
+               (emit-initializations-as-loop kdone src v 'vector 1 nwords init))
+         (letk kbody ($kargs () () ,init-loop))
+         (letk ktag2
+               ($kargs ('w0) (w0)
+                 ($continue kbody src
+                   ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+         (letk ktag1
+               ($kargs ('w0-high) (w0-high)
+                 ($continue ktag2 src
+                   ($primcall 'uadd/immediate %tc7-vector (w0-high)))))
+         (letk ktag0
+               ($kargs ('v) (v)
+                 ($continue ktag1 src
+                   ($primcall 'ulsh/immediate 8 (usize)))))
+         (letk kalloc
+               ($kargs ('nwords) (nwords)
+                 ($continue ktag0 src
+                   ($primcall 'allocate-words 'vector (nwords)))))
+         (letk kadd1
+               ($kargs ('usize) (usize)
+                 ($continue kalloc src
+                   ;; Header word.
+                   ($primcall 'uadd/immediate 1 (usize)))))
+         (build-term
+           ($continue kadd1 src
+             ;; Header word.
+             ($primcall 's64->u64 #f (ssize)))))))))
+
+(define-primcall-converter make-vector/immediate
+  (lambda (cps k src op param init)
+    (define size param)
+    (define nwords (1+ size))
+    (define (init-fields cps v pos kdone)
+      ;; Inline the initializations, up to vectors of size 32.  Above
+      ;; that it's a bit of a waste, so reify a loop instead.
+      (cond
+       ((<= 32 nwords)
+        (with-cps cps
+          (letv unwords)
+          (let$ init-loop
+                (emit-initializations-as-loop kdone src v 'vector
+                                              pos unwords init))
+          (letk kinit ($kargs ('unwords) (unwords) ,init-loop))
+          (letk kusize ($kargs () ()
+                         ($continue kinit src
+                           ($primcall 'load-u64 nwords ()))))
+          kusize))
+       ((< pos nwords)
+        (with-cps cps
+          (let$ knext (init-fields v (1+ pos) kdone))
+          (letk kinit
+                ($kargs () ()
+                  ($continue knext src
+                    ($primcall 'scm-set!/immediate `(vector . ,pos)
+                               (v init)))))
+          kinit))
+       (else
+        (with-cps cps
+          kdone))))
+    (unless (and (exact-integer? size) (<= 0 size (target-max-vector-length)))
+      (error "precondition failed" size))
+    (with-cps cps
+      (letv v w0)
+      (letk kdone
+            ($kargs () ()
+              ($continue k src ($values (v)))))
+      (let$ kinit (init-fields v 1 kdone))
+      (letk ktag1
+            ($kargs ('w0) (w0)
+              ($continue kinit src
+                ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+      (letk ktag0
+            ($kargs ('v) (v)
+              ($continue ktag1 src
+                ($primcall 'load-u64 (+ %tc7-vector (ash size 8)) ()))))
+      (build-term
+        ($continue ktag0 src
+          ($primcall 'allocate-words/immediate `(vector . ,nwords) ()))))))
+
+(define (ensure-pair cps src op pred x is-pair)
+  (define msg
+    (match pred
+      ('pair?
+       "Wrong type argument in position 1 (expecting pair): ~S")
+      ('mutable-pair?
+       "Wrong type argument in position 1 (expecting mutable pair): ~S")))
+  (define not-pair (vector 'wrong-type-arg (symbol->string op) msg))
+  (with-cps cps
+    (letk knot-pair ($kargs () () ($throw src 'throw/value+data not-pair (x))))
+    (let$ body (is-pair))
+    (letk k ($kargs () () ,body))
+    (letk kheap-object ($kargs () () ($branch knot-pair k src pred #f (x))))
+    (build-term ($branch knot-pair kheap-object src 'heap-object? #f (x)))))
+
+(define-primcall-converter cons
+  (lambda (cps k src op param head tail)
+    (with-cps cps
+      (letv pair)
+      (letk kdone
+            ($kargs () ()
+              ($continue k src ($values (pair)))))
+      (letk ktail
+            ($kargs () ()
+              ($continue kdone src
+                ($primcall 'scm-set!/immediate '(pair . 1) (pair tail)))))
+      (letk khead
+            ($kargs ('pair) (pair)
+              ($continue ktail src
+                ($primcall 'scm-set!/immediate '(pair . 0) (pair head)))))
+      (build-term
+        ($continue khead src
+          ($primcall 'allocate-words/immediate '(pair . 2) ()))))))
+
+(define-primcall-converter car
+  (lambda (cps k src op param pair)
+    (ensure-pair
+     cps src 'car 'pair? pair
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-ref/immediate '(pair . 0) (pair)))))))))
+
+(define-primcall-converter cdr
+  (lambda (cps k src op param pair)
+    (ensure-pair
+     cps src 'cdr 'pair? pair
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-ref/immediate '(pair . 1) (pair)))))))))
+
+(define-primcall-converter set-car!
+  (lambda (cps k src op param pair val)
+    (ensure-pair
+     ;; FIXME: Use mutable-pair? as predicate.
+     cps src 'set-car! 'pair? pair
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-set!/immediate '(pair . 0) (pair val)))))))))
+
+(define-primcall-converter set-cdr!
+  (lambda (cps k src op param pair val)
+    (ensure-pair
+     ;; FIXME: Use mutable-pair? as predicate.
+     cps src 'set-cdr! 'pair? pair
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-set!/immediate '(pair . 1) (pair val)))))))))
+
+(define-primcall-converter box
+  (lambda (cps k src op param val)
+    (with-cps cps
+      (letv obj tag)
+      (letk kdone
+            ($kargs () ()
+              ($continue k src ($values (obj)))))
+      (letk kval
+            ($kargs () ()
+              ($continue kdone src
+                ($primcall 'scm-set!/immediate '(box . 1) (obj val)))))
+      (letk ktag1
+            ($kargs ('tag) (tag)
+              ($continue kval src
+                ($primcall 'word-set!/immediate '(box . 0) (obj tag)))))
+      (letk ktag0
+            ($kargs ('obj) (obj)
+              ($continue ktag1 src
+                ($primcall 'load-u64 %tc7-variable ()))))
+      (build-term
+        ($continue ktag0 src
+          ($primcall 'allocate-words/immediate '(box . 2) ()))))))
+
+(define (ensure-box cps src op x is-box)
+  (define not-box
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 1 (expecting box): ~S"))
+  (with-cps cps
+    (letk knot-box ($kargs () () ($throw src 'throw/value+data not-box (x))))
+    (let$ body (is-box))
+    (letk k ($kargs () () ,body))
+    (letk kheap-object ($kargs () () ($branch knot-box k src 'variable? #f (x))))
+    (build-term ($branch knot-box kheap-object src 'heap-object? #f (x)))))
+
+(define-primcall-converter box-ref
+  (lambda (cps k src op param box)
+    (define unbound
+      #(misc-error "variable-ref" "Unbound variable: ~S"))
+    (ensure-box
+     cps src 'variable-ref box
+     (lambda (cps)
+       (with-cps cps
+         (letv val)
+         (letk kunbound ($kargs () () ($throw src 'throw/value unbound (box))))
+         (letk kbound ($kargs () () ($continue k src ($values (val)))))
+         (letk ktest
+               ($kargs ('val) (val)
+                 ($branch kbound kunbound src 'undefined? #f (val))))
+         (build-term
+           ($continue ktest src
+             ($primcall 'scm-ref/immediate '(box . 1) (box)))))))))
+
+(define-primcall-converter box-set!
+  (lambda (cps k src op param box val)
+    (ensure-box
+     cps src 'variable-set! box
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-set!/immediate '(box . 1) (box val)))))))))
+
+(define (ensure-struct cps src op x have-vtable)
+  (define not-struct
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 1 (expecting struct): ~S"))
+  (with-cps cps
+    (letv vtable)
+    (letk knot-struct
+          ($kargs () () ($throw src 'throw/value+data not-struct (x))))
+    (let$ body (have-vtable vtable))
+    (letk k ($kargs ('vtable) (vtable) ,body))
+    (letk kvtable ($kargs () ()
+                    ($continue k src ($primcall 'scm-ref/tag 'struct (x)))))
+    (letk kheap-object
+          ($kargs () () ($branch knot-struct kvtable src 'struct? #f (x))))
+    (build-term ($branch knot-struct kheap-object src 'heap-object? #f (x)))))
+
+(define-primcall-converter struct-vtable
+  (lambda (cps k src op param struct)
+    (ensure-struct
+     cps src 'struct-vtable struct
+     (lambda (cps vtable)
+       (with-cps cps
+         (build-term
+           ($continue k src ($values (vtable)))))))))
+
+(define (ensure-vtable cps src op vtable is-vtable)
+  (ensure-struct
+   cps src op vtable
+   (lambda (cps vtable-vtable)
+     (define not-vtable
+       (vector 'wrong-type-arg
+               (symbol->string op)
+               "Wrong type argument in position 1 (expecting vtable): ~S"))
+     (define vtable-index-flags 1)    ; FIXME: pull from struct.h
+     (define vtable-offset-flags (1+ vtable-index-flags))
+     (define vtable-validated-mask #b11)
+     (define vtable-validated-value #b11)
+     (with-cps cps
+       (letv flags mask res)
+       (letk knot-vtable
+             ($kargs () () ($throw src 'throw/value+data not-vtable (vtable))))
+       (let$ body (is-vtable))
+       (letk k ($kargs () () ,body))
+       (letk ktest
+             ($kargs ('res) (res)
+               ($branch knot-vtable k src
+                 'u64-imm-= vtable-validated-value (res))))
+       (letk kand
+             ($kargs ('mask) (mask)
+               ($continue ktest src
+                 ($primcall 'ulogand #f (flags mask)))))
+       (letk kflags
+             ($kargs ('flags) (flags)
+               ($continue kand src
+                 ($primcall 'load-u64 vtable-validated-mask ()))))
+       (build-term
+         ($continue kflags src
+           ($primcall 'word-ref/immediate
+                      `(struct . ,vtable-offset-flags) (vtable-vtable))))))))
+
+(define-primcall-converter allocate-struct
+  (lambda (cps k src op nwords vtable)
+    (ensure-vtable
+     cps src 'allocate-struct vtable
+     (lambda (cps)
+       (define vtable-index-size 5) ; FIXME: pull from struct.h
+       (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
+       (define vtable-offset-size (1+ vtable-index-size))
+       (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
+       (define wrong-number
+         (vector 'wrong-number-of-args
+                 (symbol->string op)
+                 "Wrong number of initializers when instantiating ~A"))
+       (define has-unboxed
+         (vector 'wrong-type-arg
+                 (symbol->string op)
+                 "Expected vtable with no unboxed fields: ~A"))
+       (define (check-all-boxed cps kf kt vtable ptr word)
+         (if (< (* word 32) nwords)
+             (with-cps cps
+               (letv idx bits)
+               (let$ checkboxed (check-all-boxed kf kt vtable ptr (1+ word)))
+               (letk kcheckboxed ($kargs () () ,checkboxed))
+               (letk kcheck
+                     ($kargs ('bits) (bits)
+                       ($branch kf kcheckboxed src 'u64-imm-= 0 (bits))))
+               (letk kword
+                     ($kargs ('idx) (idx)
+                       ($continue kcheck src
+                         ($primcall 'u32-ref 'bitmask (vtable ptr idx)))))
+               (build-term
+                 ($continue kword src
+                   ($primcall 'load-u64 word ()))))
+             (with-cps cps
+               (build-term ($continue kt src ($values ()))))))
+       (with-cps cps
+         (letv rfields nfields ptr s)
+         (letk kwna
+               ($kargs () () ($throw src 'throw/value wrong-number (vtable))))
+         (letk kunboxed
+               ($kargs () () ($throw src 'throw/value+data has-unboxed (vtable))))
+         (letk kdone
+               ($kargs () () ($continue k src ($values (s)))))
+         (letk ktag
+               ($kargs ('s) (s)
+                 ($continue kdone src
+                   ($primcall 'scm-set!/tag 'struct (s vtable)))))
+         (letk kalloc
+               ($kargs () ()
+                 ($continue ktag src
+                   ($primcall 'allocate-words/immediate
+                              `(struct . ,(1+ nwords)) ()))))
+         (let$ checkboxed (check-all-boxed kunboxed kalloc vtable ptr 0))
+         (letk kcheckboxed ($kargs ('ptr) (ptr) ,checkboxed))
+         (letk kaccess
+               ($kargs () ()
+                 ($continue kcheckboxed src
+                   ($primcall 'pointer-ref/immediate
+                              `(struct . ,vtable-offset-unboxed-fields)
+                              (vtable)))))
+         (letk knfields
+               ($kargs ('nfields) (nfields)
+                 ($branch kwna kaccess src 'u64-imm-= nwords (nfields))))
+         (letk kassume
+               ($kargs ('rfields) (rfields)
+                 ($continue knfields src
+                   ($primcall 'assume-u64 `(0 . ,(target-max-size-t/scm))
+                              (rfields)))))
+         (build-term
+           ($continue kassume src
+             ($primcall 'word-ref/immediate
+                        `(struct . ,vtable-offset-size) (vtable)))))))))
+
+(define (ensure-struct-index-in-range cps src op vtable idx boxed? in-range)
+  (define vtable-index-size 5)           ; FIXME: pull from struct.h
+  (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
+  (define vtable-offset-size (1+ vtable-index-size))
+  (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
+  (define bad-type
+    (vector
+     'wrong-type-arg
+     (symbol->string op)
+     (if boxed?
+         "Wrong type argument in position 2 (expecting boxed field): ~S"
+         "Wrong type argument in position 2 (expecting unboxed field): ~S")))
+  (define out-of-range
+    (vector 'out-of-range
+            (symbol->string op)
+            "Argument 2 out of range: ~S"))
+  (with-cps cps
+    (letv rfields nfields ptr word bits mask res throwval1 throwval2)
+    (letk kthrow1
+          ($kargs (#f) (throwval1)
+            ($throw src 'throw/value+data out-of-range (throwval1))))
+    (letk kthrow2
+          ($kargs (#f) (throwval2)
+            ($throw src 'throw/value+data bad-type (throwval2))))
+    (letk kbadidx ($kargs () () ($continue kthrow1 src ($const idx))))
+    (letk kbadtype ($kargs () () ($continue kthrow2 src ($const idx))))
+
+    (let$ body (in-range))
+    (letk k ($kargs () () ,body))
+    (letk ktest
+          ($kargs ('res) (res)
+            ($branch (if boxed? kbadtype k) (if boxed? k kbadtype) src
+              'u64-imm-= 0 (res))))
+    (letk kand
+          ($kargs ('mask) (mask)
+            ($continue ktest src
+              ($primcall 'ulogand #f (mask bits)))))
+    (letk kbits
+          ($kargs ('bits) (bits)
+            ($continue kand src
+              ($primcall 'load-u64 (ash 1 (logand idx 31)) ()))))
+    (letk kword
+          ($kargs ('word) (word)
+            ($continue kbits src
+              ($primcall 'u32-ref 'bitmask (vtable ptr word)))))
+    (letk kptr
+          ($kargs ('ptr) (ptr)
+            ($continue kword src
+              ($primcall 'load-u64 (ash idx -5) ()))))
+    (letk kaccess
+          ($kargs () ()
+            ($continue kptr src
+              ($primcall 'pointer-ref/immediate
+                         `(struct . ,vtable-offset-unboxed-fields)
+                         (vtable)))))
+    (letk knfields
+          ($kargs ('nfields) (nfields)
+            ($branch kbadidx kaccess src 'imm-u64-< idx (nfields))))
+    (letk kassume
+          ($kargs ('rfields) (rfields)
+            ($continue knfields src
+              ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (rfields)))))
+    (build-term
+      ($continue kassume src
+        ($primcall 'word-ref/immediate
+                   `(struct . ,vtable-offset-size) (vtable))))))
+
+(define (prepare-struct-scm-access cps src op struct idx boxed? have-pos)
+  (define not-struct
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 1 (expecting struct): ~S"))
+  (ensure-struct
+   cps src op struct
+   (lambda (cps vtable)
+     (ensure-struct-index-in-range
+      cps src op vtable idx boxed?
+      (lambda (cps) (have-pos cps (1+ idx)))))))
+
+(define-primcall-converter struct-ref/immediate
+  (lambda (cps k src op param struct)
+    (prepare-struct-scm-access
+     cps src op struct param #t
+     (lambda (cps pos)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'scm-ref/immediate `(struct . ,pos) (struct)))))))))
+
+(define-primcall-converter struct-set!/immediate
+  (lambda (cps k src op param struct val)
+    (prepare-struct-scm-access
+     cps src op struct param #t
+     (lambda (cps pos)
+       (with-cps cps
+         (letk k* ($kargs () () ($continue k src ($values (val)))))
+         (build-term
+           ($continue k* src
+             ($primcall 'scm-set!/immediate `(struct . ,pos) (struct val)))))))))
+
+(define-primcall-converter struct-init!
+  (lambda (cps k src op param s val)
+    (define pos (1+ param))
+    (with-cps cps
+      (build-term
+        ($continue k src
+          ($primcall 'scm-set!/immediate `(struct . ,pos) (s val)))))))
+
+(define-primcall-converter struct-ref
+  (lambda (cps k src op param struct idx)
+    (with-cps cps
+      (letv prim res)
+      (letk krecv ($kreceive '(res) #f k))
+      (letk kprim ($kargs ('prim) (prim)
+                    ($continue krecv src ($call prim (struct idx)))))
+      (build-term
+        ($continue kprim src ($prim 'struct-ref))))))
+
+(define-primcall-converter struct-set!
+  (lambda (cps k src op param struct idx val)
+    (with-cps cps
+      (letv prim res)
+      ;; struct-set! prim returns the value.
+      (letk krecv ($kreceive '(res) #f k))
+      (letk kprim ($kargs ('prim) (prim)
+                    ($continue krecv src ($call prim (struct idx val)))))
+      (build-term
+        ($continue kprim src ($prim 'struct-set!))))))
+
+(define (untag-bytevector-index cps src op idx ulen width have-uidx)
+  (define not-fixnum
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 2 (expecting small integer): ~S"))
+  (define out-of-range
+    (vector 'out-of-range
+            (symbol->string op)
+            "Argument 2 out of range: ~S"))
+  (with-cps cps
+    (letv sidx uidx maxidx+1)
+    (letk knot-fixnum
+          ($kargs () () ($throw src 'throw/value+data not-fixnum (idx))))
+    (letk kout-of-range
+          ($kargs () () ($throw src 'throw/value+data out-of-range (idx))))
+    (let$ body (have-uidx uidx))
+    (letk k ($kargs () () ,body))
+    (letk ktestidx
+          ($kargs ('maxidx+1) (maxidx+1)
+            ($branch kout-of-range k src 'u64-< #f (uidx maxidx+1))))
+    (letk kdeclen
+          ($kargs () ()
+            ($continue ktestidx src
+              ($primcall 'usub/immediate (1- width) (ulen)))))
+    (letk ktestlen
+          ($kargs ('uidx) (uidx)
+            ($branch kout-of-range kdeclen src 'imm-u64-< (1- width) (ulen))))
+    (letk kcvt
+          ($kargs () ()
+            ($continue ktestlen src ($primcall 's64->u64 #f (sidx)))))
+    (letk kbound0
+          ($kargs ('sidx) (sidx)
+            ($branch kcvt kout-of-range src 's64-imm-< 0 (sidx))))
+    (letk kuntag
+          ($kargs () ()
+            ($continue kbound0 src ($primcall 'untag-fixnum #f (idx)))))
+    (build-term ($branch knot-fixnum kuntag src 'fixnum? #f (idx)))))
+
+(define (ensure-bytevector cps k src op pred x)
+  (define msg
+    (match pred
+      ('bytevector?
+       "Wrong type argument in position 1 (expecting bytevector): ~S")
+      ('mutable-bytevector?
+       "Wrong type argument in position 1 (expecting mutable bytevector): ~S")))
+  (define bad-type (vector 'wrong-type-arg (symbol->string op) msg))
+  (with-cps cps
+    (letk kf ($kargs () () ($throw src 'throw/value+data bad-type (x))))
+    (letk kheap-object ($kargs () () ($branch kf k src pred #f (x))))
+    (build-term ($branch kf kheap-object src 'heap-object? #f (x)))))
+
+(define (prepare-bytevector-access cps src op pred bv idx width
+                                   have-ptr-and-uidx)
+  (with-cps cps
+    (letv ulen rlen)
+    (let$ access
+          (untag-bytevector-index
+           src op idx rlen width
+           (lambda (cps uidx)
+             (with-cps cps
+               (letv ptr)
+               (let$ body (have-ptr-and-uidx ptr uidx))
+               (letk k ($kargs ('ptr) (ptr) ,body))
+               (build-term
+                 ($continue k src
+                   ($primcall 'pointer-ref/immediate '(bytevector . 2)
+                              (bv))))))))
+    (letk k ($kargs ('rlen) (rlen) ,access))
+    (letk kassume
+          ($kargs ('ulen) (ulen)
+            ($continue k src
+              ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
+    (letk klen
+          ($kargs () ()
+            ($continue kassume src
+              ($primcall 'word-ref/immediate '(bytevector . 1) (bv)))))
+    ($ (ensure-bytevector klen src op pred bv))))
+
+(define (bytevector-ref-converter scheme-name ptr-op width kind)
+  (define tag
+    (match kind
+      ('unsigned
+       (if (< (ash 1 (* width 8)) (target-most-positive-fixnum))
+           (lambda (cps k src val)
+             (with-cps cps
+               (letv s)
+               (letk kcvt
+                     ($kargs ('s) (s)
+                       ($continue k src ($primcall 'tag-fixnum #f (s)))))
+               (build-term
+                 ($continue kcvt src ($primcall 'u64->s64 #f (val))))))
+           (lambda (cps k src val)
+             (with-cps cps
+               (build-term
+                 ($continue k src ($primcall 'u64->scm #f (val))))))))
+      ('signed
+       (if (< (ash 1 (* width 8)) (target-most-positive-fixnum))
+           (lambda (cps k src val)
+             (with-cps cps
+               (build-term
+                 ($continue k src ($primcall 'tag-fixnum #f (val))))))
+           (lambda (cps k src val)
+             (with-cps cps
+               (build-term
+                 ($continue k src ($primcall 's64->scm #f (val))))))))
+      ('float
+       (lambda (cps k src val)
+         (with-cps cps
+           (build-term
+             ($continue k src ($primcall 'f64->scm #f (val)))))))))
+  (lambda (cps k src op param bv idx)
+    (prepare-bytevector-access
+     cps src scheme-name 'bytevector? bv idx width
+     (lambda (cps ptr uidx)
+       (with-cps cps
+         (letv val)
+         (let$ body (tag k src  val))
+         (letk ktag ($kargs ('val) (val) ,body))
+         (build-term
+           ($continue ktag src
+             ($primcall ptr-op 'bytevector (bv ptr uidx)))))))))
+
+(define (bytevector-set-converter scheme-name ptr-op width kind)
+  (define out-of-range
+    (vector 'out-of-range
+            (symbol->string scheme-name)
+            "Argument 3 out of range: ~S"))
+  (define (limit-urange cps src val uval hi in-range)
+    (with-cps cps
+      (letk kbad ($kargs () ()
+                   ($throw src 'throw/value+data out-of-range (val))))
+      (let$ body (in-range uval))
+      (letk k ($kargs () () ,body))
+      (build-term
+        ($branch k kbad src 'imm-u64-< hi (uval)))))
+  (define (limit-srange cps src val sval lo hi in-range)
+    (with-cps cps
+      (letk kbad ($kargs () ()
+                   ($throw src 'throw/value+data out-of-range (val))))
+      (let$ body (in-range sval))
+      (letk k ($kargs () () ,body))
+      (letk k' ($kargs () ()
+                 ($branch k kbad src 's64-imm-< lo (sval))))
+      (build-term
+        ($branch k' kbad src 'imm-s64-< hi (sval)))))
+  (define (integer-unboxer lo hi)
+    (cond
+     ((<= hi (target-most-positive-fixnum))
+      (lambda (cps src val have-val)
+        (let ((have-val (if (zero? lo)
+                            (lambda (cps s)
+                              (with-cps cps
+                                (letv u)
+                                (let$ body (have-val u))
+                                (letk k ($kargs ('u) (u) ,body))
+                                (build-term
+                                  ($continue k src
+                                    ($primcall 's64->u64 #f (s))))))
+                            have-val)))
+          (with-cps cps
+            (letv sval)
+            (letk kbad ($kargs () ()
+                         ($throw src 'throw/value+data out-of-range (val))))
+            (let$ body (have-val sval))
+            (letk k ($kargs () () ,body))
+            (letk khi ($kargs () ()
+                       ($branch k kbad src 'imm-s64-< hi (sval))))
+            (letk klo ($kargs ('sval) (sval)
+                       ($branch khi kbad src 's64-imm-< lo (sval))))
+            (letk kuntag
+                  ($kargs () ()
+                    ($continue klo src ($primcall 'untag-fixnum #f (val)))))
+            (build-term
+              ($branch kbad kuntag src 'fixnum? #f (val)))))))
+     ((zero? lo)
+      (lambda (cps src val have-val)
+        (with-cps cps
+          (letv u)
+          (let$ body (limit-urange src val u hi have-val))
+          (letk khi ($kargs ('u) (u) ,body))
+          (build-term
+            ($continue khi src ($primcall 'scm->u64 #f (val)))))))
+     (else
+      (lambda (cps src val have-val)
+        (with-cps cps
+          (letv s)
+          (let$ body (limit-srange src val s lo hi have-val))
+          (letk khi ($kargs ('s) (s) ,body))
+          (build-term
+            ($continue khi src ($primcall 'scm->s64 #f (val)))))))))
+  (define untag
+    (match kind
+      ('unsigned (integer-unboxer 0 (1- (ash 1 (* width 8)))))
+      ('signed   (integer-unboxer (ash -1 (1- (* width 8)))
+                                  (1- (ash 1 (1- (* width 8))))))
+      ('float
+       (lambda (cps src val have-val)
+         (with-cps cps
+           (letv f)
+           (let$ body (have-val f))
+           (letk k ($kargs ('f) (f) ,body))
+           (build-term
+             ($continue k src ($primcall 'scm->f64 #f (val)))))))))
+  (lambda (cps k src op param bv idx val)
+    (prepare-bytevector-access
+     cps src scheme-name 'bytevector? bv idx width
+     (lambda (cps ptr uidx)
+       (untag
+        cps src val
+        (lambda (cps uval)
+          (with-cps cps
+            (build-term
+              ($continue k src
+                ($primcall ptr-op 'bytevector (bv ptr uidx uval)))))))))))
+
+(define-syntax-rule (define-bytevector-ref-converter
+                      cps-name scheme-name op width kind)
+  (define-primcall-converter cps-name
+    (bytevector-ref-converter 'scheme-name 'op width 'kind)))
+(define-syntax-rule (define-bytevector-ref-converters (cvt ...) ...)
+  (begin
+    (define-bytevector-ref-converter cvt ...)
+    ...))
+
+(define-syntax-rule (define-bytevector-set-converter
+                      cps-name scheme-name op width kind)
+  (define-primcall-converter cps-name
+    (bytevector-set-converter 'scheme-name 'op width 'kind)))
+(define-syntax-rule (define-bytevector-set-converters (cvt ...) ...)
+  (begin
+    (define-bytevector-set-converter cvt ...)
+    ...))
+
+(define-primcall-converter bv-length
+  (lambda (cps k src op param bv)
+    (with-cps cps
+      (letv ulen rlen)
+      (letk ktag ($kargs ('rlen) (rlen)
+                   ($continue k src ($primcall 'u64->scm #f (rlen)))))
+      (letk kassume
+          ($kargs ('ulen) (ulen)
+            ($continue ktag src
+              ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
+      (letk klen
+            ($kargs () ()
+              ($continue kassume src
+                ($primcall 'word-ref/immediate '(bytevector . 1) (bv)))))
+      ($ (ensure-bytevector klen src op 'bytevector? bv)))))
+
+(define-bytevector-ref-converters
+  (bv-u8-ref   bytevector-u8-ref                  u8-ref   1 unsigned)
+  (bv-u16-ref  bytevector-u16-native-ref          u16-ref  2 unsigned)
+  (bv-u32-ref  bytevector-u32-native-ref          u32-ref  4 unsigned)
+  (bv-u64-ref  bytevector-u64-native-ref          u64-ref  8 unsigned)
+  (bv-s8-ref   bytevector-s8-ref                  s8-ref   1 signed)
+  (bv-s16-ref  bytevector-s16-native-ref          s16-ref  2 signed)
+  (bv-s32-ref  bytevector-s32-native-ref          s32-ref  4 signed)
+  (bv-s64-ref  bytevector-s64-native-ref          s64-ref  8 signed)
+  (bv-f32-ref  bytevector-ieee-single-native-ref  f32-ref  4 float)
+  (bv-f64-ref  bytevector-ieee-double-native-ref  f64-ref  8 float))
+
+(define-bytevector-set-converters
+  (bv-u8-set!  bytevector-u8-set!                 u8-set!  1 unsigned)
+  (bv-u16-set! bytevector-u16-native-set!         u16-set! 2 unsigned)
+  (bv-u32-set! bytevector-u32-native-set!         u32-set! 4 unsigned)
+  (bv-u64-set! bytevector-u64-native-set!         u64-set! 8 unsigned)
+  (bv-s8-set!  bytevector-s8-set!                 s8-set!  1 signed)
+  (bv-s16-set! bytevector-s16-native-set!         s16-set! 2 signed)
+  (bv-s32-set! bytevector-s32-native-set!         s32-set! 4 signed)
+  (bv-s64-set! bytevector-s64-native-set!         s64-set! 8 signed)
+  (bv-f32-set! bytevector-ieee-single-native-set! f32-set! 4 float)
+  (bv-f64-set! bytevector-ieee-double-native-set! f64-set! 8 float))
+
+(define (ensure-string cps src op x have-length)
+  (define msg "Wrong type argument in position 1 (expecting string): ~S")
+  (define not-string (vector 'wrong-type-arg (symbol->string op) msg))
+  (with-cps cps
+    (letv ulen rlen)
+    (letk knot-string
+          ($kargs () () ($throw src 'throw/value+data not-string (x))))
+    (let$ body (have-length rlen))
+    (letk k ($kargs ('rlen) (rlen) ,body))
+    (letk kassume
+          ($kargs ('ulen) (ulen)
+            ($continue k src
+              ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
+    (letk ks
+          ($kargs () ()
+            ($continue kassume src
+              ($primcall 'word-ref/immediate '(string . 3) (x)))))
+    (letk kheap-object
+          ($kargs () ()
+            ($branch knot-string ks src 'string? #f (x))))
+    (build-term
+      ($branch knot-string kheap-object src 'heap-object? #f (x)))))
+
+(define (ensure-char cps src op x have-char)
+  (define msg "Wrong type argument (expecting char): ~S")
+  (define not-char (vector 'wrong-type-arg (symbol->string op) msg))
+  (with-cps cps
+    (letv uchar)
+    (letk knot-char
+          ($kargs () () ($throw src 'throw/value+data not-char (x))))
+    (let$ body (have-char uchar))
+    (letk k ($kargs ('uchar) (uchar) ,body))
+    (letk kchar
+          ($kargs () () ($continue k src ($primcall 'untag-char #f (x)))))
+    (build-term
+      ($branch knot-char kchar src 'char? #f (x)))))
+
+(define-primcall-converter string-length
+  (lambda (cps k src op param x)
+    (ensure-string
+     cps src op x
+     (lambda (cps ulen)
+       (with-cps cps
+         (build-term
+           ($continue k src ($primcall 'u64->scm #f (ulen)))))))))
+
+(define-primcall-converter string-ref
+  (lambda (cps k src op param s idx)
+    (define out-of-range
+      #(out-of-range string-ref "Argument 2 out of range: ~S"))
+    (define stringbuf-f-wide #x400)
+    (ensure-string
+     cps src op s
+     (lambda (cps ulen)
+       (with-cps cps
+         (letv uidx start upos buf ptr tag mask bits uwpos u32 uchar)
+         (letk kout-of-range
+               ($kargs () ()
+                 ($throw src 'throw/value+data out-of-range (idx))))
+         (letk kchar
+               ($kargs ('uchar) (uchar)
+                 ($continue k src
+                   ($primcall 'tag-char #f (uchar)))))
+         (letk kassume
+               ($kargs ('u32) (u32)
+                 ($continue kchar src
+                   ($primcall 'assume-u64 '(0 . #xffffff) (u32)))))
+         (letk kwideref
+               ($kargs ('uwpos) (uwpos)
+                 ($continue kassume src
+                   ($primcall 'u32-ref 'stringbuf (buf ptr uwpos)))))
+         (letk kwide
+               ($kargs () ()
+                 ($continue kwideref src
+                   ($primcall 'ulsh/immediate 2 (upos)))))
+         (letk knarrow
+               ($kargs () ()
+                 ($continue kchar src
+                   ($primcall 'u8-ref 'stringbuf (buf ptr upos)))))
+         (letk kcmp
+               ($kargs ('bits) (bits)
+                 ($branch kwide knarrow src 'u64-imm-= 0 (bits))))
+         (letk kmask
+               ($kargs ('mask) (mask)
+                 ($continue kcmp src
+                   ($primcall 'ulogand #f (tag mask)))))
+         (letk ktag
+               ($kargs ('tag) (tag)
+                 ($continue kmask src
+                   ($primcall 'load-u64 stringbuf-f-wide ()))))
+         (letk kptr
+               ($kargs ('ptr) (ptr)
+                 ($continue ktag src
+                   ($primcall 'word-ref/immediate '(stringbuf . 0) (buf)))))
+         (letk kwidth
+               ($kargs ('buf) (buf)
+                 ($continue kptr src
+                   ($primcall 'tail-pointer-ref/immediate '(stringbuf . 2) (buf)))))
+         (letk kbuf
+               ($kargs ('upos) (upos)
+                 ($continue kwidth src
+                   ($primcall 'scm-ref/immediate '(string . 1) (s)))))
+         (letk kadd
+               ($kargs ('start) (start)
+                 ($continue kbuf src
+                   ($primcall 'uadd #f (start uidx)))))
+         (letk kstart
+               ($kargs () ()
+                 ($continue kadd src
+                   ($primcall 'word-ref/immediate '(string . 2) (s)))))
+         (letk krange
+               ($kargs ('uidx) (uidx)
+                 ($branch kout-of-range kstart src 'u64-< #f (uidx ulen))))
+         (build-term
+           ($continue krange src ($primcall 'scm->u64 #f (idx)))))))))
+
+(define-primcall-converter string-set!
+  (lambda (cps k src op param s idx ch)
+    (define out-of-range
+      #(out-of-range string-ref "Argument 2 out of range: ~S"))
+    (define stringbuf-f-wide #x400)
+    (ensure-string
+     cps src op s
+     (lambda (cps ulen)
+       (ensure-char
+        cps src op ch
+        (lambda (cps uchar)
+          (with-cps cps
+            (letv uidx)
+            (letk kout-of-range
+                  ($kargs () ()
+                    ($throw src 'throw/value+data out-of-range (idx))))
+            (letk kuidx
+                  ($kargs () ()
+                    ($continue k src
+                      ($primcall 'string-set! #f (s uidx uchar)))))
+            (letk krange
+                  ($kargs ('uidx) (uidx)
+                    ($branch kout-of-range kuidx src 'u64-< #f (uidx ulen))))
+            (build-term
+              ($continue krange src ($primcall 'scm->u64 #f (idx)))))))))))
+
+(define-primcall-converter integer->char
+  (lambda (cps k src op param i)
+    (define not-fixnum
+      #(wrong-type-arg
+        "integer->char"
+        "Wrong type argument in position 1 (expecting small integer): ~S"))
+    (define out-of-range
+      #(out-of-range
+        "integer->char"
+        "Argument 1 out of range: ~S"))
+    (define codepoint-surrogate-start #xd800)
+    (define codepoint-surrogate-end #xdfff)
+    (define codepoint-max #x10ffff)
+    (with-cps cps
+      (letv si ui)
+      (letk knot-fixnum
+            ($kargs () () ($throw src 'throw/value+data not-fixnum (i))))
+      (letk kf
+            ($kargs () () ($throw src 'throw/value+data out-of-range (i))))
+      (letk ktag ($kargs ('ui) (ui)
+                   ($continue k src ($primcall 'tag-char #f (ui)))))
+      (letk kt ($kargs () ()
+                 ($continue ktag src ($primcall 's64->u64 #f (si)))))
+      (letk kmax
+            ($kargs () ()
+              ($branch kt kf src 'imm-s64-< codepoint-max (si))))
+      (letk khi
+            ($kargs () ()
+              ($branch kf kmax src 'imm-s64-< codepoint-surrogate-end (si))))
+      (letk klo
+            ($kargs () ()
+              ($branch khi kt src 's64-imm-< codepoint-surrogate-start (si))))
+      (letk kbound0
+            ($kargs ('si) (si)
+              ($branch klo kf src 's64-imm-< 0 (si))))
+      (letk kuntag
+            ($kargs () ()
+              ($continue kbound0 src ($primcall 'untag-fixnum #f (i)))))
+      (build-term ($branch knot-fixnum kuntag src 'fixnum? #f (i))))))
+
+(define-primcall-converter char->integer
+  (lambda (cps k src op param ch)
+    (define not-char
+      #(wrong-type-arg
+        "char->integer"
+        "Wrong type argument in position 1 (expecting char): ~S"))
+    (with-cps cps
+      (letv ui si)
+      (letk knot-char
+            ($kargs () () ($throw src 'throw/value+data not-char (ch))))
+      (letk ktag ($kargs ('si) (si)
+                   ($continue k src ($primcall 'tag-fixnum #f (si)))))
+      (letk kcvt ($kargs ('ui) (ui)
+                   ($continue ktag src ($primcall 'u64->s64 #f (ui)))))
+      (letk kuntag ($kargs () ()
+                     ($continue kcvt src ($primcall 'untag-char #f (ch)))))
+      (build-term
+        ($branch knot-char kuntag src 'char? #f (ch))))))
+
+(define (convert-shift cps k src op param obj idx)
+  (with-cps cps
+    (letv idx')
+    (letk k' ($kargs ('idx) (idx')
+               ($continue k src ($primcall op param (obj idx')))))
+    (build-term ($continue k' src ($primcall 'scm->u64 #f (idx))))))
+
+(define-primcall-converter rsh convert-shift)
+(define-primcall-converter lsh convert-shift)
+
+(define-primcall-converter make-atomic-box
+  (lambda (cps k src op param val)
+    (with-cps cps
+      (letv obj tag)
+      (letk kdone
+            ($kargs () ()
+              ($continue k src ($values (obj)))))
+      (letk kval
+            ($kargs () ()
+              ($continue kdone src
+                ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1) (obj val)))))
+      (letk ktag1
+            ($kargs ('tag) (tag)
+              ($continue kval src
+                ($primcall 'word-set!/immediate '(atomic-box . 0) (obj tag)))))
+      (letk ktag0
+            ($kargs ('obj) (obj)
+              ($continue ktag1 src
+                ($primcall 'load-u64 %tc7-atomic-box ()))))
+      (build-term
+        ($continue ktag0 src
+          ($primcall 'allocate-words/immediate '(atomic-box . 2) ()))))))
+
+(define (ensure-atomic-box cps src op x is-atomic-box)
+  (define bad-type
+    (vector 'wrong-type-arg
+            (symbol->string op)
+            "Wrong type argument in position 1 (expecting atomic box): ~S"))
+  (with-cps cps
+    (letk kbad ($kargs () () ($throw src 'throw/value+data bad-type (x))))
+    (let$ body (is-atomic-box))
+    (letk k ($kargs () () ,body))
+    (letk kheap-object ($kargs () () ($branch kbad k src 'atomic-box? #f (x))))
+    (build-term ($branch kbad kheap-object src 'heap-object? #f (x)))))
+
+(define-primcall-converter atomic-box-ref
+  (lambda (cps k src op param x)
+    (ensure-atomic-box
+     cps src 'atomic-box-ref x
+     (lambda (cps)
+       (with-cps cps
+         (letv val)
+         (build-term
+           ($continue k src
+             ($primcall 'atomic-scm-ref/immediate '(atomic-box . 1) (x)))))))))
+
+(define-primcall-converter atomic-box-set!
+  (lambda (cps k src op param x val)
+    (ensure-atomic-box
+     cps src 'atomic-box-set! x
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1)
+                        (x val)))))))))
+
+(define-primcall-converter atomic-box-swap!
+  (lambda (cps k src op param x val)
+    (ensure-atomic-box
+     cps src 'atomic-box-swap! x
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'atomic-scm-swap!/immediate '(atomic-box . 1)
+                        (x val)))))))))
+
+(define-primcall-converter atomic-box-compare-and-swap!
+  (lambda (cps k src op param x expected desired)
+    (ensure-atomic-box
+     cps src 'atomic-box-compare-and-swap! x
+     (lambda (cps)
+       (with-cps cps
+         (build-term
+           ($continue k src
+             ($primcall 'atomic-scm-compare-and-swap!/immediate '(atomic-box . 1)
+                        (x expected desired)))))))))
+
 ;;; Guile's semantics are that a toplevel lambda captures a reference on
 ;;; the current module, and that all contained lambdas use that module
 ;;; to resolve toplevel variables.  This parameter tracks whether or not
@@ -85,50 +1394,64 @@
     (scope-counter (1+ scope-id))
     scope-id))
 
-(define (toplevel-box cps src name bound? val-proc)
-  (define (lookup cps name bound? k)
-    (match (current-topbox-scope)
-      (#f
-       (with-cps cps
-         (build-term ($continue k src
-                       ($primcall 'resolve (name bound?))))))
-      (scope-id
-       (with-cps cps
-         ($ (with-cps-constants ((scope scope-id))
-              (build-term
-               ($continue k src
-                 ($primcall 'cached-toplevel-box (scope name bound?))))))))))
-  (with-cps cps
-    (letv box)
-    (let$ body (val-proc box))
-    (letk kbox ($kargs ('box) (box) ,body))
-    ($ (with-cps-constants ((name name)
-                            (bound? bound?))
-         ($ (lookup name bound? kbox))))))
+(define (toplevel-box cps src name bound? have-var)
+  (define %unbound
+    #(unbound-variable #f "Unbound variable: ~S"))
+  (match (current-topbox-scope)
+    (#f
+     (with-cps cps
+       (letv mod name-var box)
+       (letk kbad ($kargs () () ($throw src 'throw/value %unbound (name-var))))
+       (let$ body
+             ((if bound?
+                  (lambda (cps)
+                    (with-cps cps
+                      (letv val)
+                      (let$ body (have-var box))
+                      (letk kdef ($kargs () () ,body))
+                      (letk ktest ($kargs ('val) (val)
+                                    ($branch kdef kbad src
+                                      'undefined? #f (val))))
+                      (build-term
+                        ($continue ktest src
+                          ($primcall 'scm-ref/immediate
+                                     '(box . 1) (box))))))
+                  (lambda (cps)
+                    (with-cps cps
+                      ($ (have-var box)))))))
+       (letk ktest ($kargs () () ,body))
+       (letk kbox ($kargs ('box) (box)
+                    ($branch kbad ktest src 'heap-object? #f (box))))
+       (letk kname ($kargs ('name) (name-var)
+                     ($continue kbox src
+                       ($primcall 'lookup #f (mod name-var)))))
+       (letk kmod ($kargs ('mod) (mod)
+                    ($continue kname src ($const name))))
+       (build-term
+         ($continue kmod src ($primcall 'current-module #f ())))))
+    (scope
+     (with-cps cps
+       (letv box)
+       (let$ body (have-var box))
+       (letk kbox ($kargs ('box) (box) ,body))
+       ($ (convert-primcall kbox src 'cached-toplevel-box
+                            (list scope name bound?)))))))
 
 (define (module-box cps src module name public? bound? val-proc)
   (with-cps cps
     (letv box)
     (let$ body (val-proc box))
     (letk kbox ($kargs ('box) (box) ,body))
-    ($ (with-cps-constants ((module module)
-                            (name name)
-                            (public? public?)
-                            (bound? bound?))
-         (build-term ($continue kbox src
-                       ($primcall 'cached-module-box
-                                  (module name public? bound?))))))))
+    ($ (convert-primcall kbox src 'cached-module-box
+                         (list module name public? bound?)))))
 
 (define (capture-toplevel-scope cps src scope-id k)
   (with-cps cps
     (letv module)
-    (let$ body (with-cps-constants ((scope scope-id))
-                 (build-term
-                   ($continue k src
-                     ($primcall 'cache-current-module! (module scope))))))
+    (let$ body (convert-primcall k src 'cache-current-module!
+                                 (list scope-id) module))
     (letk kmodule ($kargs ('module) (module) ,body))
-    (build-term ($continue kmodule src
-                  ($primcall 'current-module ())))))
+    ($ (convert-primcall kmodule src 'current-module #f))))
 
 (define (fold-formals proc seed arity gensyms inits)
   (match arity
@@ -168,16 +1491,6 @@
                   (fold-kw kw (cdr gensyms) (cdr inits) seed)))))
        (fold-req req gensyms seed)))))
 
-(define (unbound? cps src var kt kf)
-  (define tc8-iflag 4)
-  (define unbound-val 9)
-  (define unbound-bits (logior (ash unbound-val 8) tc8-iflag))
-  (with-cps cps
-    ($ (with-cps-constants ((unbound (pointer->scm
-                                      (make-pointer unbound-bits))))
-         (build-term ($continue kf src
-                       ($branch kt ($primcall 'eq? (var unbound)))))))))
-
 (define (init-default-value cps name sym subst init body)
   (match (hashq-ref subst sym)
     ((orig-var subst-var box?)
@@ -186,8 +1499,8 @@
          (if box?
              (with-cps cps
                (letv phi)
-               (letk kbox ($kargs (name) (phi)
-                            ($continue k src ($primcall 'box (phi)))))
+               (let$ body (convert-primcall k src 'box #f phi))
+               (letk kbox ($kargs (name) (phi) ,body))
                ($ (make-body kbox)))
              (make-body cps k)))
        (with-cps cps
@@ -204,7 +1517,21 @@
                  (letk kreceive ($kreceive (list name) 'rest krest))
                  (let$ init (convert init kreceive subst))
                  (letk kunbound ($kargs () () ,init))
-                 ($ (unbound? src orig-var kunbound kbound)))))))))))
+                 (build-term
+                   ($branch kbound kunbound src
+                     'undefined? #f (orig-var))))))))))))
+
+(define (build-list cps k src vals)
+  (match vals
+    (()
+     (with-cps cps
+       (build-term ($continue k src ($const '())))))
+    ((v . vals)
+     (with-cps cps
+       (letv tail)
+       (let$ head (convert-primcall k src 'cons #f v tail))
+       (letk ktail ($kargs ('tail) (tail) ,head))
+       ($ (build-list ktail src vals))))))
 
 ;;; The conversion from Tree-IL to CPS essentially wraps every
 ;;; expression in a $kreceive, which models the Tree-IL semantics that
@@ -276,12 +1603,15 @@
           (_
            ;; Arity mismatch.  Serialize a values call.
            (with-cps cps
+             (letv values)
              (let$ void (with-cps-constants ((unspecified *unspecified*))
                           (build-term
                             ($continue k src
-                              ($primcall 'values (unspecified))))))
-             (letk kvoid ($kargs () () ,void))
-             kvoid))))))
+                              ($call values (unspecified))))))
+             (letk kvoid ($kargs ('values) (values) ,void))
+             (letk kvalues ($kargs () ()
+                             ($continue kvoid src ($prim 'values))))
+             kvalues))))))
     (1
      (match (intmap-ref cps k)
        (($ $ktail)
@@ -297,8 +1627,8 @@
            (with-cps cps
              (letv val)
              (let$ body (with-cps-constants ((nil '()))
-                          (build-term
-                            ($continue kargs src ($primcall 'cons (val nil))))))
+                          ($ (convert-primcall kargs src 'cons #f
+                                               val nil))))
              (letk kval ($kargs ('val) (val) ,body))
              kval))
           (($ $arity (_) () #f () #f)
@@ -315,10 +1645,12 @@
           (_
            ;; Arity mismatch.  Serialize a values call.
            (with-cps cps
-             (letv val)
+             (letv val values)
+             (letk kvalues ($kargs ('values) (values)
+                             ($continue k src
+                               ($call values (val)))))
              (letk kval ($kargs ('val) (val)
-                          ($continue k src
-                            ($primcall 'values (val)))))
+                          ($continue kvalues src ($prim 'values))))
              kval))))))))
 
 ;; cps exp k-name alist -> cps term
@@ -334,14 +1666,13 @@
       ;; (($ <fix> src names syms vals body) (zero-valued? body))
       (($ <let-values> src exp body) (zero-valued? body))
       (($ <seq> src head tail) (zero-valued? tail))
+      (($ <primcall> src 'values args) (= (length args) 0))
       (($ <primcall> src name args)
-       (match (prim-instruction name)
+       (match (tree-il-primitive->cps-primitive+nargs+nvalues name)
          (#f #f)
-         (inst
-          (match (prim-arity inst)
-            ((out . in)
-             (and (eqv? out 0)
-                  (eqv? in (length args))))))))
+         (#(cps-prim nargs nvalues)
+          (and (eqv? nvalues 0)
+               (eqv? nargs (length args))))))
       (_ #f)))
   (define (single-valued? exp)
     (match exp
@@ -352,14 +1683,13 @@
       (($ <fix> src names syms vals body) (single-valued? body))
       (($ <let-values> src exp body) (single-valued? body))
       (($ <seq> src head tail) (single-valued? tail))
+      (($ <primcall> src 'values args) (= (length args) 1))
       (($ <primcall> src name args)
-       (match (prim-instruction name)
+       (match (tree-il-primitive->cps-primitive+nargs+nvalues name)
          (#f #f)
-         (inst
-          (match (prim-arity inst)
-            ((out . in)
-             (and (eqv? out 1)
-                  (eqv? in (length args))))))))
+         (#(cps-prim nargs nvalues)
+          (and (eqv? nvalues 1)
+               (eqv? nargs (length args))))))
       (_ #f)))
   ;; exp (v-name -> term) -> term
   (define (convert-arg cps exp k)
@@ -371,7 +1701,8 @@
             (letv unboxed)
             (let$ body (k unboxed))
             (letk kunboxed ($kargs ('unboxed) (unboxed) ,body))
-            (build-term ($continue kunboxed src ($primcall 'box-ref (box))))))
+            (build-term ($continue kunboxed src
+                          ($primcall 'scm-ref/immediate '(box . 1) (box))))))
          ((orig-var subst-var #f) (k cps subst-var))
          (var (k cps var))))
       ((? single-valued?)
@@ -402,7 +1733,7 @@
       ((orig-var subst-var #t)
        (with-cps cps
          (letk k ($kargs (name) (subst-var) ,body))
-         (build-term ($continue k #f ($primcall 'box (orig-var))))))
+         ($ (convert-primcall k #f 'box #f orig-var))))
       (else
        (with-cps cps body))))
   (define (box-bound-vars cps names syms body)
@@ -422,7 +1753,8 @@
      (with-cps cps
        (let$ k (adapt-arity k src 1))
        (rewrite-term (hashq-ref subst sym)
-         ((orig-var box #t) ($continue k src ($primcall 'box-ref (box))))
+         ((orig-var box #t) ($continue k src
+                              ($primcall 'scm-ref/immediate '(box . 1) (box))))
          ((orig-var subst-var #f) ($continue k src ($values (subst-var))))
          (var ($continue k src ($values (var)))))))
 
@@ -502,7 +1834,8 @@
       (lambda (cps box)
         (with-cps cps
           (let$ k (adapt-arity k src 1))
-          (build-term ($continue k src ($primcall 'box-ref (box))))))))
+          (build-term ($continue k src
+                        ($primcall 'scm-ref/immediate '(box . 1) (box))))))))
 
     (($ <module-set> src mod name public? exp)
      (convert-arg cps exp
@@ -513,7 +1846,8 @@
             (with-cps cps
               (let$ k (adapt-arity k src 0))
               (build-term
-                ($continue k src ($primcall 'box-set! (box val))))))))))
+                ($continue k src
+                  ($primcall 'scm-set!/immediate '(box . 1) (box val))))))))))
 
     (($ <toplevel-ref> src name)
      (toplevel-box
@@ -521,7 +1855,9 @@
       (lambda (cps box)
         (with-cps cps
           (let$ k (adapt-arity k src 1))
-          (build-term ($continue k src ($primcall 'box-ref (box))))))))
+          (build-term
+            ($continue k src
+              ($primcall 'scm-ref/immediate '(box . 1) (box))))))))
 
     (($ <toplevel-set> src name exp)
      (convert-arg cps exp
@@ -532,19 +1868,25 @@
             (with-cps cps
               (let$ k (adapt-arity k src 0))
               (build-term
-                ($continue k src ($primcall 'box-set! (box val))))))))))
+                ($continue k src
+                  ($primcall 'scm-set!/immediate '(box . 1) (box val))))))))))
 
     (($ <toplevel-define> src name exp)
      (convert-arg cps exp
        (lambda (cps val)
          (with-cps cps
            (let$ k (adapt-arity k src 0))
-           (letv box)
+           (letv box mod)
            (letk kset ($kargs ('box) (box)
-                        ($continue k src ($primcall 'box-set! (box val)))))
+                        ($continue k src
+                          ($primcall 'scm-set!/immediate '(box . 1) (box val)))))
            ($ (with-cps-constants ((name name))
+                (letk kmod
+                      ($kargs ('mod) (mod)
+                        ($continue kset src
+                          ($primcall 'define! #f (mod name)))))
                 (build-term
-                  ($continue kset src ($primcall 'define! (name))))))))))
+                  ($continue kmod src ($primcall 'current-module #f ())))))))))
 
     (($ <call> src proc args)
      (convert-args cps (cons proc args)
@@ -555,211 +1897,157 @@
 
     (($ <primcall> src name args)
      (cond
-      ((eq? name 'equal?)
-       (convert-args cps args
-         (lambda (cps args)
-           (with-cps cps
-             (let$ k* (adapt-arity k src 1))
-             (letk kt ($kargs () () ($continue k* src ($const #t))))
-             (letk kf* ($kargs () ()
-                         ;; Here we continue to the original $kreceive
-                         ;; or $ktail, as equal? doesn't have a VM op.
-                         ($continue k src ($primcall 'equal? args))))
-             (build-term ($continue kf* src
-                           ($branch kt ($primcall 'eqv? args))))))))
-      ((branching-primitive? name)
-       (convert-args cps args
-         (lambda (cps args)
-           (with-cps cps
-             (let$ k (adapt-arity k src 1))
-             (letk kt ($kargs () () ($continue k src ($const #t))))
-             (letk kf ($kargs () () ($continue k src ($const #f))))
-             (build-term ($continue kf src
-                           ($branch kt ($primcall name args))))))))
-      ((and (eq? name 'not) (match args ((_) #t) (_ #f)))
+      ((eq? name 'throw)
+       (let ()
+         (define (fallback)
+           (convert-args cps args
+             (lambda (cps args)
+               (match args
+                 ((key . args)
+                  (with-cps cps
+                    (letv arglist)
+                    (letk kargs ($kargs ('arglist) (arglist)
+                                  ($throw src 'throw #f (key arglist))))
+                    ($ (build-list kargs src args))))))))
+         (define (specialize op param . args)
+           (convert-args cps args
+             (lambda (cps args)
+               (with-cps cps
+                 (build-term
+                   ($throw src op param args))))))
+         (match args
+           ((($ <const> _ key) ($ <const> _ subr) ($ <const> _ msg) args data)
+            ;; Specialize `throw' invocations corresponding to common
+            ;; "error" invocations.
+            (let ()
+              (match (vector args data)
+                (#(($ <primcall> _ 'cons (x ($ <const> _ ())))
+                   ($ <primcall> _ 'cons (x ($ <const> _ ()))))
+                 (specialize 'throw/value+data `#(,key ,subr ,msg) x))
+                (#(($ <primcall> _ 'cons (x ($ <const> _ ()))) ($ <const> _ #f))
+                 (specialize 'throw/value `#(,key ,subr ,msg) x))
+                (_ (fallback)))))
+           (_ (fallback)))))
+      ((eq? name 'values)
        (convert-args cps args
          (lambda (cps args)
-           (with-cps cps
-             (let$ k (adapt-arity k src 1))
-             (letk kt ($kargs () () ($continue k src ($const #f))))
-             (letk kf ($kargs () () ($continue k src ($const #t))))
-             (build-term ($continue kf src
-                           ($branch kt ($values args))))))))
-      ((and (eq? name 'list)
-            (and-map (match-lambda
-                       ((or ($ <const>)
-                            ($ <void>)
-                            ($ <lambda>)
-                            ($ <lexical-ref>)) #t)
-                       (_ #f))
-                     args))
-       ;; See note below in `canonicalize' about `vector'.  The same
-       ;; thing applies to `list'.
-       (with-cps cps
-         (let$ k (adapt-arity k src 1))
-         ($ ((lambda (cps)
-               (let lp ((cps cps) (args args) (k k))
-                 (match args
-                   (()
-                    (with-cps cps
-                      (build-term ($continue k src ($const '())))))
-                   ((arg . args)
-                    (with-cps cps
-                      (letv tail)
-                      (let$ body (convert-arg arg
-                                   (lambda (cps head)
-                                     (with-cps cps
-                                       (build-term
-                                         ($continue k src
-                                           ($primcall 'cons (head tail))))))))
-                      (letk ktail ($kargs ('tail) (tail) ,body))
-                      ($ (lp args ktail)))))))))))
-      ((prim-instruction name)
-       => (lambda (instruction)
-            (define (box+adapt-arity cps k src out)
-              (case instruction
-                ((bv-f32-ref bv-f64-ref)
-                 (with-cps cps
-                   (letv f64)
-                   (let$ k (adapt-arity k src out))
-                   (letk kbox ($kargs ('f64) (f64)
-                                ($continue k src ($primcall 'f64->scm (f64)))))
-                   kbox))
-                ((char->integer
-                  string-length vector-length
-                  bv-length bv-u8-ref bv-u16-ref bv-u32-ref bv-u64-ref)
-                 (with-cps cps
-                   (letv u64)
-                   (let$ k (adapt-arity k src out))
-                   (letk kbox ($kargs ('u64) (u64)
-                                ($continue k src ($primcall 'u64->scm (u64)))))
-                   kbox))
-                ((bv-s8-ref bv-s16-ref bv-s32-ref bv-s64-ref)
-                 (with-cps cps
-                   (letv s64)
-                   (let$ k (adapt-arity k src out))
-                   (letk kbox ($kargs ('s64) (s64)
-                                ($continue k src ($primcall 's64->scm (s64)))))
-                   kbox))
-                (else
-                 (adapt-arity cps k src out))))
-            (define (unbox-arg cps arg unbox-op have-arg)
+           (match (intmap-ref cps k)
+             (($ $ktail)
               (with-cps cps
-                (letv unboxed)
-                (let$ body (have-arg unboxed))
-                (letk kunboxed ($kargs ('unboxed) (unboxed) ,body))
                 (build-term
-                  ($continue kunboxed src ($primcall unbox-op (arg))))))
-            (define (unbox-args cps args have-args)
-              (case instruction
-                ((bv-f32-ref bv-f64-ref
-                  bv-s8-ref bv-s16-ref bv-s32-ref bv-s64-ref
-                  bv-u8-ref bv-u16-ref bv-u32-ref bv-u64-ref)
-                 (match args
-                   ((bv idx)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (have-args cps (list bv idx)))))))
-                ((bv-f32-set! bv-f64-set!)
-                 (match args
-                   ((bv idx val)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (unbox-arg
-                        cps val 'scm->f64
-                        (lambda (cps val)
-                          (have-args cps (list bv idx val)))))))))
-                ((bv-s8-set! bv-s16-set! bv-s32-set! bv-s64-set!)
-                 (match args
-                   ((bv idx val)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (unbox-arg
-                        cps val 'scm->s64
-                        (lambda (cps val)
-                          (have-args cps (list bv idx val)))))))))
-                ((bv-u8-set! bv-u16-set! bv-u32-set! bv-u64-set!)
-                 (match args
-                   ((bv idx val)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (unbox-arg
-                        cps val 'scm->u64
-                        (lambda (cps val)
-                          (have-args cps (list bv idx val)))))))))
-                ((vector-ref struct-ref string-ref)
-                 (match args
-                   ((obj idx)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (have-args cps (list obj idx)))))))
-                ((vector-set! struct-set! string-set!)
-                 (match args
-                   ((obj idx val)
-                    (unbox-arg
-                     cps idx 'scm->u64
-                     (lambda (cps idx)
-                       (have-args cps (list obj idx val)))))))
-                ((make-vector)
-                 (match args
-                   ((length init)
-                    (unbox-arg
-                     cps length 'scm->u64
-                     (lambda (cps length)
-                       (have-args cps (list length init)))))))
-                ((allocate-struct)
-                 (match args
-                   ((vtable nfields)
-                    (unbox-arg
-                     cps nfields 'scm->u64
-                     (lambda (cps nfields)
-                       (have-args cps (list vtable nfields)))))))
-                ((integer->char)
-                 (match args
-                   ((integer)
-                    (unbox-arg
-                     cps integer 'scm->u64
-                     (lambda (cps integer)
-                       (have-args cps (list integer)))))))
-                (else (have-args cps args))))
-            (convert-args cps args
-              (lambda (cps args)
-                ;; Tree-IL primcalls are sloppy, in that it could be
-                ;; that they are called with too many or too few
-                ;; arguments.  In CPS we are more strict and only
-                ;; residualize a $primcall if the argument count
-                ;; matches.
-                (match (prim-arity instruction)
-                  ((out . in)
-                   (if (= in (length args))
-                       (with-cps cps
-                         (let$ k (box+adapt-arity k src out))
-                         ($ (unbox-args
-                             args
-                             (lambda (cps args)
-                               (with-cps cps
-                                 (build-term
-                                   ($continue k src
-                                     ($primcall instruction args))))))))
-                       (with-cps cps
-                         (letv prim)
-                         (letk kprim ($kargs ('prim) (prim)
-                                       ($continue k src ($call prim args))))
-                         (build-term ($continue kprim src ($prim name)))))))))))
+                  ($continue k src ($values args)))))
+             (($ $kargs names)
+              ;; Can happen if continuation already saw we produced the
+              ;; right number of values.
+              (with-cps cps
+                (build-term
+                  ($continue k src ($values args)))))
+             (($ $kreceive ($ $arity req () rest () #f) kargs)
+              (cond
+               ((and (not rest) (= (length args) (length req)))
+                (with-cps cps
+                  (build-term
+                    ($continue kargs src ($values args)))))
+               ((and rest (>= (length args) (length req)))
+                (with-cps cps
+                  (letv rest)
+                  (letk krest ($kargs ('rest) (rest)
+                                ($continue kargs src
+                                  ($values ,(append (list-head args (length req))
+                                                    (list rest))))))
+                  ($ (build-list krest src (list-tail args (length req))))))
+               (else
+                ;; Number of values mismatch; reify a values call.
+                (with-cps cps
+                  (letv val values)
+                  (letk kvalues ($kargs ('values) (values)
+                                  ($continue k src ($call values args))))
+                  (build-term ($continue kvalues src ($prim 'values)))))))))))
+      ((tree-il-primitive->cps-primitive+nargs+nvalues name)
+       =>
+       (match-lambda
+        (#(cps-prim nargs nvalues)
+         (define (cvt cps k src op args)
+           (define (default)
+             (convert-args cps args
+               (lambda (cps args)
+                 (with-cps cps
+                   ($ (convert-primcall* k src op #f args))))))
+           (define-syntax-rule (specialize-case (pat (op c (arg ...))) ...
+                                                (_ def))
+             (match (cons cps-prim args)
+               (pat
+                (convert-args cps (list arg ...)
+                  (lambda (cps args)
+                    (with-cps cps
+                      ($ (convert-primcall* k src 'op c args))))))
+               ...
+               (_ def)))
+           (define (uint? val) (and (exact-integer? val) (<= 0 val)))
+           (define (vector-index? val)
+             (and (exact-integer? val)
+                  (<= 0 val (1- (target-max-vector-length)))))
+           (define (vector-size? val)
+             (and (exact-integer? val)
+                  (<= 0 val (target-max-vector-length))))
+           (define (negint? val) (and (exact-integer? val) (< val 0)))
+           ;; FIXME: Add case for mul
+           (specialize-case
+            (('allocate-vector ($ <const> _ n))
+             (allocate-vector n ()))
+            (('make-vector ($ <const> _ (? vector-size? n)) init)
+             (make-vector/immediate n (init)))
+            (('vector-ref v ($ <const> _ (? vector-index? n)))
+             (vector-ref/immediate n (v)))
+            (('vector-set! v ($ <const> _ (? vector-index? n)) x)
+             (vector-set!/immediate n (v x)))
+            (('vector-init! v ($ <const> _ n) x)
+             (vector-init! n (v x)))
+            (('allocate-struct v ($ <const> _ n))
+             (allocate-struct n (v)))
+            (('struct-ref s ($ <const> _ (? uint? n)))
+             (struct-ref/immediate n (s)))
+            (('struct-set! s ($ <const> _ (? uint? n)) x)
+             (struct-set!/immediate n (s x)))
+            (('struct-init! s ($ <const> _ n) x)
+             (struct-init! n (s x)))
+            (('add x ($ <const> _ (? number? y)))
+             (add/immediate y (x)))
+            (('add ($ <const> _ (? number? y)) x)
+             (add/immediate y (x)))
+            (('sub x ($ <const> _ (? number? y)))
+             (sub/immediate y (x)))
+            (('lsh x ($ <const> _ (? uint? y)))
+             (lsh/immediate y (x)))
+            (('rsh x ($ <const> _ (? uint? y)))
+             (rsh/immediate y (x)))
+            (_
+             (default))))
+         ;; Tree-IL primcalls are sloppy, in that it could be that
+         ;; they are called with too many or too few arguments.  In
+         ;; CPS we are more strict and only residualize a $primcall
+         ;; if the argument count matches.
+         (if (= nargs (length args))
+             (with-cps cps
+               (let$ k (adapt-arity k src nvalues))
+               ($ (cvt k src cps-prim args)))
+             (convert-args cps args
+               (lambda (cps args)
+                 (with-cps cps
+                   (letv prim)
+                   (letk kprim ($kargs ('prim) (prim)
+                                 ($continue k src ($call prim args))))
+                   (build-term ($continue kprim src ($prim name))))))))))
       (else
        ;; We have something that's a primcall for Tree-IL but not for
-       ;; CPS, which will get compiled as a call and so the right thing
-       ;; to do is to continue to the given $ktail or $kreceive.
+       ;; CPS; compile as a call.
        (convert-args cps args
          (lambda (cps args)
            (with-cps cps
-             (build-term
-               ($continue k src ($primcall name args)))))))))
+             (letv prim)
+             (letk kprim ($kargs ('prim) (prim)
+                           ($continue k src ($call prim args))))
+             (build-term ($continue kprim src ($prim name)))))))))
 
     ;; Prompts with inline handlers.
     (($ <prompt> src escape-only? tag body
@@ -786,28 +2074,30 @@
                  (with-cps cps
                    (let$ body (convert body krest subst))
                    (letk kbody ($kargs () () ,body))
-                   (build-term ($continue kbody src ($prompt #t tag khargs))))
+                   (build-term ($prompt kbody khargs src #t tag)))
                  (convert-arg cps body
                    (lambda (cps thunk)
                      (with-cps cps
                        (letk kbody ($kargs () ()
                                      ($continue krest (tree-il-src body)
-                                       ($primcall 'call-thunk/no-inline
+                                       ($primcall 'call-thunk/no-inline #f
                                                   (thunk)))))
-                       (build-term ($continue kbody (tree-il-src body)
-                                     ($prompt #f tag khargs))))))))
+                       (build-term ($prompt kbody khargs (tree-il-src body)
+                                     #f tag)))))))
            (with-cps cps
-             (letv prim vals)
+             (letv prim vals apply)
              (let$ hbody (convert hbody k subst))
              (let$ hbody (box-bound-vars hnames hsyms hbody))
              (letk khbody ($kargs hnames bound-vars ,hbody))
              (letk khargs ($kreceive hreq hrest khbody))
+             (letk kapp ($kargs ('apply) (apply)
+                          ($continue k src ($call apply (prim vals)))))
              (letk kprim ($kargs ('prim) (prim)
-                           ($continue k src ($primcall 'apply (prim vals)))))
+                           ($continue kapp src ($prim 'apply))))
              (letk kret ($kargs () ()
                           ($continue kprim src ($prim 'values))))
              (letk kpop ($kargs ('rest) (vals)
-                          ($continue kret src ($primcall 'unwind ()))))
+                          ($continue kret src ($primcall 'unwind #f ()))))
              ;; FIXME: Attach hsrc to $kreceive.
              (letk krest ($kreceive '() 'rest kpop))
              ($ (convert-body khargs krest)))))))
@@ -816,17 +2106,24 @@
      (convert-args cps (cons tag args)
        (lambda (cps args*)
          (with-cps cps
+           (letv abort)
+           (letk kabort ($kargs ('abort) (abort)
+                          ($continue k src ($call abort args*))))
            (build-term
-             ($continue k src ($primcall 'abort-to-prompt args*)))))))
+             ($continue kabort src ($prim 'abort-to-prompt)))))))
 
     (($ <abort> src tag args tail)
      (convert-args cps
-         (append (list (make-primitive-ref #f 'abort-to-prompt) tag)
+         (append (list (make-primitive-ref #f 'apply)
+                       (make-primitive-ref #f 'abort-to-prompt)
+                       tag)
                  args
                  (list tail))
        (lambda (cps args*)
-         (with-cps cps
-           (build-term ($continue k src ($primcall 'apply args*)))))))
+         (match args*
+           ((apply . apply-args)
+            (with-cps cps
+              (build-term ($continue k src ($call apply apply-args)))))))))
 
     (($ <conditional> src test consequent alternate)
      (define (convert-test cps test kt kf)
@@ -834,9 +2131,14 @@
          (($ <primcall> src (? branching-primitive? name) args)
           (convert-args cps args
             (lambda (cps args)
-              (with-cps cps
-                (build-term ($continue kf src
-                              ($branch kt ($primcall name args))))))))
+              (if (heap-type-predicate? name)
+                  (with-cps cps
+                    (letk kt* ($kargs () ()
+                                ($branch kf kt src name #f args)))
+                    (build-term
+                      ($branch kf kt* src 'heap-object? #f args)))
+                  (with-cps cps
+                    (build-term ($branch kf kt src name #f args)))))))
          (($ <conditional> src test consequent alternate)
           (with-cps cps
             (let$ t (convert-test consequent kt kf))
@@ -844,11 +2146,13 @@
             (letk kt* ($kargs () () ,t))
             (letk kf* ($kargs () () ,f))
             ($ (convert-test test kt* kf*))))
+         (($ <const> src c)
+          (with-cps cps
+            (build-term ($continue (if c kt kf) src ($values ())))))
          (_ (convert-arg cps test
               (lambda (cps test)
                 (with-cps cps
-                  (build-term ($continue kf src
-                                ($branch kt ($values (test)))))))))))
+                  (build-term ($branch kt kf src 'false? #f (test)))))))))
      (with-cps cps
        (let$ t (convert consequent k subst))
        (let$ f (convert alternate k subst))
@@ -864,7 +2168,8 @@
             (with-cps cps
               (let$ k (adapt-arity k src 0))
               (build-term
-                ($continue k src ($primcall 'box-set! (box exp))))))))))
+                ($continue k src
+                  ($primcall 'scm-set!/immediate '(box . 1) (box exp))))))))))
 
     (($ <seq> src head tail)
      (if (zero-valued? head)
@@ -1034,59 +2339,181 @@ integer."
   (optimize x e opts))
 
 (define (canonicalize exp)
+  (define-syntax-rule (with-lexical src id . body)
+    (let ((k (lambda (id) . body)))
+      (match id
+        (($ <lexical-ref>) (k id))
+        (_
+         (let ((v (gensym "v ")))
+           (make-let src (list 'v) (list v) (list id)
+                     (k (make-lexical-ref src 'v v))))))))
+  (define-syntax with-lexicals
+    (syntax-rules ()
+      ((with-lexicals src () . body) (let () . body))
+      ((with-lexicals src (id . ids) . body)
+       (with-lexical src id (with-lexicals src ids . body)))))
+  (define (reduce-conditional exp)
+    (match exp
+      (($ <conditional> src
+          ($ <conditional> _ test ($ <const> _ t) ($ <const> _ f))
+          consequent alternate)
+       (cond
+        ((and t (not f))
+         (reduce-conditional (make-conditional src test consequent alternate)))
+        ((and (not t) f)
+         (reduce-conditional (make-conditional src test alternate consequent)))
+        (else
+         exp)))
+      (_ exp)))
+  (define (evaluate-args-eagerly-if-needed src inits k)
+    ;; Some macros generate calls to "vector" or "list" with like 300
+    ;; arguments.  Since we eventually compile to lower-level operations
+    ;; like make-vector and vector-set! or cons, it reduces live
+    ;; variable pressure to sink initializers if we can, if we can prove
+    ;; that the initializer can't capture the continuation.  (More on
+    ;; that caveat here:
+    ;; http://wingolog.org/archives/2013/11/02/scheme-quiz-time).
+    ;;
+    ;; Normally we would do this transformation in the optimizer, but
+    ;; it's quite tricky there and quite easy here, so we do it here.
+    (match inits
+      (() (k '()))
+      ((init . inits)
+       (match init
+         ((or ($ <const>) ($ <void>) ($ <lambda>) ($ <lexical-ref>))
+          (evaluate-args-eagerly-if-needed
+           src inits (lambda (inits) (k (cons init inits)))))
+         (_
+          (with-lexical
+           src init
+           (evaluate-args-eagerly-if-needed
+            src inits (lambda (inits) (k (cons init inits))))))))))
   (post-order
    (lambda (exp)
      (match exp
-       (($ <primcall> src 'vector
-           (and args
-                ((or ($ <const>) ($ <void>) ($ <lambda>) ($ <lexical-ref>))
-                 ...)))
-        ;; Some macros generate calls to "vector" with like 300
-        ;; arguments.  Since we eventually compile to make-vector and
-        ;; vector-set!, it reduces live variable pressure to allocate the
-        ;; vector first, then set values as they are produced, if we can
-        ;; prove that no value can capture the continuation.  (More on
-        ;; that caveat here:
-        ;; http://wingolog.org/archives/2013/11/02/scheme-quiz-time).
-        ;;
-        ;; Normally we would do this transformation in the compiler, but
-        ;; it's quite tricky there and quite easy here, so hold your nose
-        ;; while we drop some smelly code.
-        (let ((len (length args))
-              (v (gensym "v ")))
-          (make-let src
-                    (list 'v)
-                    (list v)
-                    (list (make-primcall src 'make-vector
-                                         (list (make-const #f len)
-                                               (make-const #f #f))))
-                    (fold (lambda (arg n tail)
-                            (make-seq
-                             src
-                             (make-primcall
-                              src 'vector-set!
-                              (list (make-lexical-ref src 'v v)
-                                    (make-const #f n)
-                                    arg))
-                             tail))
-                          (make-lexical-ref src 'v v)
-                          (reverse args) (reverse (iota len))))))
-
-       (($ <primcall> src 'struct-set! (struct index value))
-        ;; Unhappily, and undocumentedly, struct-set! returns the value
-        ;; that was set.  There is code that relies on this.  Hackety
-        ;; hack...
-        (let ((v (gensym "v ")))
-          (make-let src
-                    (list 'v)
-                    (list v)
-                    (list value)
-                    (make-seq src
-                              (make-primcall src 'struct-set!
-                                             (list struct
-                                                   index
-                                                   (make-lexical-ref src 'v v)))
-                              (make-lexical-ref src 'v v)))))
+       (($ <conditional>)
+        (reduce-conditional exp))
+
+       (($ <primcall> src 'exact-integer? (x))
+        ;; Both fixnum? and bignum? are branching primitives.
+        (with-lexicals src (x)
+          (make-conditional
+           src (make-primcall src 'fixnum? (list x))
+           (make-const src #t)
+           (make-conditional src (make-primcall src 'bignum? (list x))
+                             (make-const src #t)
+                             (make-const src #f)))))
+
+       (($ <primcall> src '<= (a b))
+        ;; No need to reduce as <= is a branching primitive.
+        (make-conditional src (make-primcall src '<= (list a b))
+                          (make-const src #t)
+                          (make-const src #f)))
+
+       (($ <primcall> src '>= (a b))
+        ;; No need to reduce as < is a branching primitive.
+        (make-conditional src (make-primcall src '<= (list b a))
+                          (make-const src #t)
+                          (make-const src #f)))
+
+       (($ <primcall> src '> (a b))
+        ;; No need to reduce as < is a branching primitive.
+        (make-conditional src (make-primcall src '< (list b a))
+                          (make-const src #t)
+                          (make-const src #f)))
+
+       (($ <primcall> src (? branching-primitive? name) args)
+        ;; No need to reduce because test is not reducible: reifying
+        ;; #t/#f is the right thing.
+        (make-conditional src exp
+                          (make-const src #t)
+                          (make-const src #f)))
+
+       (($ <primcall> src 'not (x))
+        (reduce-conditional
+         (make-conditional src x
+                           (make-const src #f)
+                           (make-const src #t))))
+
+       (($ <primcall> src (or 'eqv? 'equal?) (a b))
+        (let ()
+          (define-syntax-rule (primcall name . args)
+            (make-primcall src 'name (list . args)))
+          (define-syntax primcall-chain
+            (syntax-rules ()
+              ((_ x) x)
+              ((_ x . y)
+               (make-conditional src (primcall . x) (primcall-chain . y)
+                                 (make-const src #f)))))
+          (define-syntax-rule (bool x)
+            (make-conditional src x (make-const src #t) (make-const src #f)))
+          (with-lexicals src (a b)
+            (make-conditional
+             src
+             (primcall eq? a b)
+             (make-const src #t)
+             (match (primcall-name exp)
+               ('eqv?
+                ;; Completely inline.
+                (primcall-chain (heap-number? a)
+                                (heap-number? b)
+                                (bool (primcall heap-numbers-equal? a b))))
+               ('equal?
+                ;; Partially inline.
+                (primcall-chain (heap-object? a)
+                                (heap-object? b)
+                                (primcall equal? a b))))))))
+
+       (($ <primcall> src 'vector args)
+        ;; Expand to "allocate-vector" + "vector-init!".
+        (evaluate-args-eagerly-if-needed
+         src args
+         (lambda (args)
+           (define-syntax-rule (primcall name . args)
+             (make-primcall src 'name (list . args)))
+           (define-syntax-rule (const val)
+             (make-const src val))
+           (let ((v (primcall allocate-vector (const (length args)))))
+             (with-lexicals src (v)
+               (list->seq
+                src
+                (append (map (lambda (idx arg)
+                               (primcall vector-init! v (const idx) arg))
+                             (iota (length args))
+                             args)
+                        (list v))))))))
+
+       (($ <primcall> src 'make-struct/simple (vtable . args))
+        ;; Expand to "allocate-struct" + "struct-init!".
+        (evaluate-args-eagerly-if-needed
+         src args
+         (lambda (args)
+           (define-syntax-rule (primcall name . args)
+             (make-primcall src 'name (list . args)))
+           (define-syntax-rule (const val)
+             (make-const src val))
+           (let ((s (primcall allocate-struct vtable (const (length args)))))
+             (with-lexicals src (s)
+               (list->seq
+                src
+                (append (map (lambda (idx arg)
+                               (primcall struct-init! s (const idx) arg))
+                             (iota (length args))
+                             args)
+                        (list s))))))))
+
+       (($ <primcall> src 'list args)
+        ;; Expand to "cons".
+        (evaluate-args-eagerly-if-needed
+         src args
+         (lambda (args)
+           (define-syntax-rule (primcall name . args)
+             (make-primcall src 'name (list . args)))
+           (define-syntax-rule (const val)
+             (make-const src val))
+           (fold (lambda (arg tail) (primcall cons arg tail))
+                 (const '())
+                 (reverse args)))))
 
        ;; Lower (logand x (lognot y)) to (logsub x y).  We do it here
        ;; instead of in CPS because it gets rid of the lognot entirely;
@@ -1098,42 +2525,55 @@ integer."
        (($ <primcall> src 'logand (($ <primcall> _ 'lognot (y)) x))
         (make-primcall src 'logsub (list x y)))
 
+       (($ <primcall> src 'throw ())
+        (make-call src (make-primitive-ref src 'throw) '()))
+
        (($ <prompt> src escape-only? tag body
            ($ <lambda> hsrc hmeta
               ($ <lambda-case> _ hreq #f hrest #f () hsyms hbody #f)))
         exp)
 
+       (($ <primcall> src 'ash (a b))
+        (match b
+          (($ <const> src2 (? exact-integer? n))
+           (if (< n 0)
+               (make-primcall src 'rsh (list a (make-const src2 (- n))))
+               (make-primcall src 'lsh (list a b))))
+          (_
+           (with-lexicals src (a b)
+             (make-conditional
+              src
+              (make-primcall src '< (list b (make-const src 0)))
+              (let ((n (make-primcall src '- (list (make-const src 0) b))))
+                (make-primcall src 'rsh (list a n)))
+              (make-primcall src 'lsh (list a b)))))))
+
        ;; Eta-convert prompts without inline handlers.
        (($ <prompt> src escape-only? tag body handler)
         (let ((h (gensym "h "))
               (args (gensym "args ")))
-          (make-let
-           src (list 'h) (list h) (list handler)
-           (make-seq
-            src
+          (define-syntax-rule (primcall name . args)
+            (make-primcall src 'name (list . args)))
+          (define-syntax-rule (const val)
+            (make-const src val))
+          (with-lexicals src (handler)
             (make-conditional
              src
-             (make-primcall src 'procedure? (list (make-lexical-ref #f 'h h)))
-             (make-void src)
-             (make-primcall
-              src 'scm-error
-              (list
-               (make-const #f 'wrong-type-arg)
-               (make-const #f "call-with-prompt")
-               (make-const #f "Wrong type (expecting procedure): ~S")
-               (make-primcall #f 'list (list (make-lexical-ref #f 'h h)))
-               (make-primcall #f 'list (list (make-lexical-ref #f 'h h))))))
-            (make-prompt
-             src escape-only? tag body
-             (make-lambda
-              src '()
-              (make-lambda-case
-               src '() #f 'args #f '() (list args)
-               (make-primcall
-                src 'apply
-                (list (make-lexical-ref #f 'h h)
-                      (make-lexical-ref #f 'args args)))
-               #f)))))))
+             (primcall procedure? handler)
+             (make-prompt
+              src escape-only? tag body
+              (make-lambda
+               src '()
+               (make-lambda-case
+                src '() #f 'args #f '() (list args)
+                (primcall apply handler (make-lexical-ref #f 'args args))
+                #f)))
+             (primcall throw
+                       (const 'wrong-type-arg)
+                       (const "call-with-prompt")
+                       (const "Wrong type (expecting procedure): ~S")
+                       (primcall cons handler (const '()))
+                       (primcall cons handler (const '())))))))
        (_ exp)))
    exp))
 
@@ -1146,4 +2586,5 @@ integer."
 ;;; Local Variables:
 ;;; eval: (put 'convert-arg 'scheme-indent-function 2)
 ;;; eval: (put 'convert-args 'scheme-indent-function 2)
+;;; eval: (put 'with-lexicals 'scheme-indent-function 2)
 ;;; End:
diff --git a/module/language/tree-il/cps-primitives.scm b/module/language/tree-il/cps-primitives.scm
new file mode 100644
index 000000000..b9f2fe95b
--- /dev/null
+++ b/module/language/tree-il/cps-primitives.scm
@@ -0,0 +1,176 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2013- 2015, 2017-2018 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;;
+;;; Information about named primitives, as they appear in $prim and
+;;; $primcall.
+;;;
+;;; Code:
+
+(define-module (language tree-il cps-primitives)
+  #:use-module (ice-9 match)
+  #:use-module (language bytecode)
+  #:use-module (system base types internal)
+  #:export (tree-il-primitive->cps-primitive+nargs+nvalues
+            branching-primitive?
+            heap-type-predicate?))
+
+(define *primitives* (make-hash-table))
+
+(define-syntax define-cps-primitive
+  (syntax-rules ()
+    ((_ (tree-il-primitive cps-primitive) nargs nvalues)
+     (hashq-set! *primitives* 'tree-il-primitive
+                 '#(cps-primitive nargs nvalues)))
+    ((_ primitive nargs nvalues)
+     (define-cps-primitive (primitive primitive) nargs nvalues))))
+
+;; tree-il-prim -> #(cps-prim nargs nvalues) | #f
+(define (tree-il-primitive->cps-primitive+nargs+nvalues name)
+  (hashq-ref *primitives* name))
+
+(define-cps-primitive box 1 1)
+(define-cps-primitive (variable-ref box-ref) 1 1)
+(define-cps-primitive (variable-set! box-set!) 2 0)
+
+(define-cps-primitive current-module 0 1)
+(define-cps-primitive define! 1 1)
+
+(define-cps-primitive wind 2 0)
+(define-cps-primitive unwind 0 0)
+(define-cps-primitive push-dynamic-state 1 0)
+(define-cps-primitive pop-dynamic-state 0 0)
+
+(define-cps-primitive push-fluid 2 0)
+(define-cps-primitive pop-fluid 0 0)
+(define-cps-primitive fluid-ref 1 1)
+(define-cps-primitive fluid-set! 2 0)
+
+(define-cps-primitive string-length 1 1)
+(define-cps-primitive string-ref 2 1)
+(define-cps-primitive string-set! 3 0)
+(define-cps-primitive string->number 1 1)
+(define-cps-primitive string->symbol 1 1)
+(define-cps-primitive symbol->keyword 1 1)
+
+(define-cps-primitive integer->char 1 1)
+(define-cps-primitive char->integer 1 1)
+
+(define-cps-primitive cons 2 1)
+(define-cps-primitive car 1 1)
+(define-cps-primitive cdr 1 1)
+(define-cps-primitive set-car! 2 0)
+(define-cps-primitive set-cdr! 2 0)
+
+(define-cps-primitive (+ add) 2 1)
+(define-cps-primitive (- sub) 2 1)
+(define-cps-primitive (* mul) 2 1)
+(define-cps-primitive (/ div) 2 1)
+(define-cps-primitive (quotient quo) 2 1)
+(define-cps-primitive (remainder rem) 2 1)
+(define-cps-primitive (modulo mod) 2 1)
+
+(define-cps-primitive lsh 2 1)
+(define-cps-primitive rsh 2 1)
+(define-cps-primitive logand 2 1)
+(define-cps-primitive logior 2 1)
+(define-cps-primitive logxor 2 1)
+(define-cps-primitive logsub 2 1)
+(define-cps-primitive logbit? 2 1)
+
+(define-cps-primitive allocate-vector 1 1)
+(define-cps-primitive make-vector 2 1)
+(define-cps-primitive vector-length 1 1)
+(define-cps-primitive vector-ref 2 1)
+(define-cps-primitive vector-set! 3 0)
+(define-cps-primitive vector-init! 3 0)
+
+(define-cps-primitive struct-vtable 1 1)
+(define-cps-primitive allocate-struct 2 1)
+(define-cps-primitive struct-ref 2 1)
+;; Unhappily, and undocumentedly, struct-set! returns the value that was
+;; set.  There is code that relies on this.  The struct-set! lowering
+;; routines ensure this return arity.
+(define-cps-primitive struct-set! 3 1)
+(define-cps-primitive struct-init! 3 0)
+
+(define-cps-primitive class-of 1 1)
+
+(define-cps-primitive (bytevector-length bv-length) 1 1)
+(define-cps-primitive (bytevector-u8-ref bv-u8-ref) 2 1)
+(define-cps-primitive (bytevector-u16-native-ref bv-u16-ref) 2 1)
+(define-cps-primitive (bytevector-u32-native-ref bv-u32-ref) 2 1)
+(define-cps-primitive (bytevector-u64-native-ref bv-u64-ref) 2 1)
+(define-cps-primitive (bytevector-s8-ref bv-s8-ref) 2 1)
+(define-cps-primitive (bytevector-s16-native-ref bv-s16-ref) 2 1)
+(define-cps-primitive (bytevector-s32-native-ref bv-s32-ref) 2 1)
+(define-cps-primitive (bytevector-s64-native-ref bv-s64-ref) 2 1)
+(define-cps-primitive (bytevector-ieee-single-native-ref bv-f32-ref) 2 1)
+(define-cps-primitive (bytevector-ieee-double-native-ref bv-f64-ref) 2 1)
+(define-cps-primitive (bytevector-u8-set! bv-u8-set!) 3 0)
+(define-cps-primitive (bytevector-u16-native-set! bv-u16-set!) 3 0)
+(define-cps-primitive (bytevector-u32-native-set! bv-u32-set!) 3 0)
+(define-cps-primitive (bytevector-u64-native-set! bv-u64-set!) 3 0)
+(define-cps-primitive (bytevector-s8-set! bv-s8-set!) 3 0)
+(define-cps-primitive (bytevector-s16-native-set! bv-s16-set!) 3 0)
+(define-cps-primitive (bytevector-s32-native-set! bv-s32-set!) 3 0)
+(define-cps-primitive (bytevector-s64-native-set! bv-s64-set!) 3 0)
+(define-cps-primitive (bytevector-ieee-single-native-set! bv-f32-set!) 3 0)
+(define-cps-primitive (bytevector-ieee-double-native-set! bv-f64-set!) 3 0)
+
+(define-cps-primitive current-thread 0 1)
+
+(define-cps-primitive make-atomic-box 1 1)
+(define-cps-primitive atomic-box-ref 1 1)
+(define-cps-primitive atomic-box-set! 2 0)
+(define-cps-primitive atomic-box-swap! 2 1)
+(define-cps-primitive atomic-box-compare-and-swap! 3 1)
+
+(define *branching-primitive-arities* (make-hash-table))
+(define-syntax-rule (define-branching-primitive name nargs)
+  (hashq-set! *branching-primitive-arities* 'name '(0 . nargs)))
+
+(define-syntax-rule (define-immediate-type-predicate name pred mask tag)
+  (define-branching-primitive pred 1))
+(define *heap-type-predicates* (make-hash-table))
+(define-syntax-rule (define-heap-type-predicate name pred mask tag)
+  (begin
+    (hashq-set! *heap-type-predicates* 'pred #t)
+    (define-branching-primitive pred 1)))
+
+(visit-immediate-tags define-immediate-type-predicate)
+(visit-heap-tags define-heap-type-predicate)
+
+(define (branching-primitive? name)
+  "Is @var{name} a primitive that can only appear in $branch CPS terms?"
+  (hashq-ref *branching-primitive-arities* name))
+
+(define (heap-type-predicate? name)
+  "Is @var{name} a predicate that needs guarding by @code{heap-object?}
+ before it is lowered to CPS?"
+  (hashq-ref *heap-type-predicates* name))
+
+;; We only need to define those branching primitives that are used as
+;; Tree-IL primitives.  There are others like u64-= which are emitted by
+;; CPS code.
+(define-branching-primitive eq? 2)
+(define-branching-primitive heap-numbers-equal? 2)
+(define-branching-primitive < 2)
+(define-branching-primitive <= 2)
+(define-branching-primitive = 2)
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 8fa6a80e8..13b0977d4 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -1,6 +1,6 @@
 ;;; Tree-il optimizer
 
-;; Copyright (C) 2009, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010-2015, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -26,18 +26,38 @@
   #:use-module (language tree-il debug)
   #:use-module (ice-9 match)
   #:export (optimize
-            tree-il-default-optimization-options))
+            tree-il-optimizations))
+
+(define (kw-arg-ref args kw default)
+  (match (memq kw args)
+    ((_ val . _) val)
+    (_ default)))
+
+(define *debug?* #f)
+
+(define (maybe-verify x)
+  (if *debug?*
+      (verify-tree-il x)
+      x))
 
 (define (optimize x env opts)
-  (let ((peval (match (memq #:partial-eval? opts)
-                 ((#:partial-eval? #f _ ...)
-                  ;; Disable partial evaluation.
-                  (lambda (x e) x))
-                 (_ peval))))
-    (fix-letrec
-     (verify-tree-il
-      (peval (expand-primitives (resolve-primitives x env))
-             env)))))
-
-(define (tree-il-default-optimization-options)
-  '(#:partial-eval? #t))
+  (define-syntax-rule (run-pass pass kw default)
+    (when (kw-arg-ref opts kw default)
+      (set! x (maybe-verify (pass x)))))
+  (define (resolve* x) (resolve-primitives x env))
+  (define (peval* x) (peval x env))
+  (maybe-verify x)
+  (run-pass resolve*           #:resolve-primitives? #t)
+  (run-pass expand-primitives  #:expand-primitives?  #t)
+  (run-pass peval*             #:partial-eval?       #t)
+  (run-pass fix-letrec         #:fix-letrec?         #t)
+  x)
+
+(define (tree-il-optimizations)
+  ;; Avoid resolve-primitives until -O2, when CPS optimizations kick in.
+  ;; Otherwise, inlining the primcalls during Tree-IL->CPS compilation
+  ;; will result in a lot of code that will never get optimized nicely.
+  '((#:resolve-primitives? 2)
+    (#:expand-primitives? 1)
+    (#:partial-eval? 1)
+    (#:fix-letrec? 1)))
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 13b7d9bc4..b8a0fe9d0 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1,6 +1,6 @@
 ;;; Tree-IL partial evaluator
 
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014, 2017 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1193,7 +1193,7 @@ top-level bindings from ENV and return the resulting expression."
               (make-primcall src 'thunk? (list u))
               (make-call src w '())
               (make-primcall
-               src 'scm-error
+               src 'throw
                (list
                 (make-const #f 'wrong-type-arg)
                 (make-const #f "dynamic-wind")
@@ -1381,19 +1381,25 @@ top-level bindings from ENV and return the resulting expression."
            ($ <lexical-ref> _ _ sym) ($ <lexical-ref> _ _ sym))
           (for-tail (make-const #f #t)))
 
-         (('= ($ <primcall> src2 'logand (a b)) ($ <const> _ 0))
-          (let ((src (or src src2)))
-            (make-primcall src 'not
-                           (list (make-primcall src 'logtest (list a b))))))
-
          (('logbit? ($ <const> src2
                        (? (lambda (bit)
-                            (and (exact-integer? bit) (not (negative? bit))))
+                            (and (exact-integer? bit)
+                                 (<= 0 bit (logcount most-positive-fixnum))))
                           bit))
                     val)
-          (fold-constants src 'logtest
-                          (list (make-const (or src2 src) (ash 1 bit)) val)
-                          ctx))
+          (for-tail
+           (make-primcall src 'logtest
+                          (list (make-const src2 (ash 1 bit)) val))))
+
+         (('logtest a b)
+          (for-tail
+           (make-primcall
+            src
+            'not
+            (list
+             (make-primcall src 'eq?
+                            (list (make-primcall src 'logand (list a b))
+                                  (make-const src 0)))))))
 
          (((? effect-free-primitive?) . args)
           (fold-constants src name args ctx))
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index e716714fb..21124bbd4 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
 ;;; open-coding primitive procedures
 
-;; Copyright (C) 2009-2015, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015, 2017-2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -54,9 +54,12 @@
     pair? null? list? symbol? vector? string? struct? number? char? nil?
     bytevector? keyword? bitvector?
 
+    symbol->string string->symbol
+
     procedure? thunk?
 
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
+    exact-integer?
 
     char<? char<=? char>=? char>?
 
@@ -94,7 +97,7 @@
 
     string-length string-ref string-set!
 
-    allocate-struct struct-vtable make-struct/no-tail struct-ref struct-set!
+    make-struct/simple struct-vtable struct-ref struct-set!
 
     bytevector-length
 
@@ -139,7 +142,7 @@
 (define *primitive-constructors*
   ;; Primitives that return a fresh object.
   '(acons cons cons* list vector make-vector
-    allocate-struct make-struct/no-tail
+    make-struct/simple
     make-prompt-tag))
 
 (define *primitive-accessors*
@@ -174,8 +177,10 @@
     symbol? variable? vector? struct? string? number? char?
     bytevector? keyword? bitvector? atomic-box?
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
+    exact-integer?
     char<? char<=? char>=? char>?
     integer->char char->integer number->string string->number
+    symbol->string string->symbol
     struct-vtable
     length string-length vector-length bytevector-length
     ;; These all should get expanded out by expand-primitives.
@@ -194,6 +199,7 @@
     not
     pair? null? nil? list?
     symbol? variable? vector? struct? string? number? char?
+    exact-integer?
     bytevector? keyword? bitvector?
     procedure? thunk? atomic-box?
     acons cons cons* list vector))
@@ -378,6 +384,43 @@
                                     ,(consequent (cadr in)))
                                   out)))))))
 
+;; Oddly, scm-error is just an explicitly 5-argument `throw'.  Weird.
+(define-primitive-expander scm-error (key who message args data)
+  (throw key who message args data))
+
+(define (escape-format-directives str)
+  (string-join (string-split str #\~) "~~"))
+
+(hashq-set!
+ *primitive-expand-table*
+ 'error
+ (match-lambda*
+  ((src)
+   (make-primcall src 'throw
+                  (list (make-const src 'misc-error)
+                        (make-const src #f)
+                        (make-const src "?")
+                        (make-const src #f)
+                        (make-const src #f))))
+  ((src ($ <const> src2 (? string? message)) . args)
+   (let ((msg (string-join (cons (escape-format-directives message)
+                                 (make-list (length args) "~S")))))
+     (make-primcall src 'throw
+                    (list (make-const src 'misc-error)
+                          (make-const src #f)
+                          (make-const src2 msg)
+                          (make-primcall src 'list args)
+                          (make-const src #f)))))
+  ((src message . args)
+   (let ((msg (string-join (cons "~A" (make-list (length args) "~S")))))
+     (make-primcall src 'throw
+                    (list (make-const src 'misc-error)
+                          (make-const src #f)
+                          (make-const src msg)
+                          (make-const src "?")
+                          (make-primcall src 'list (cons message args))
+                          (make-const src #f)))))))
+
 (define-primitive-expander zero? (x)
   (= x 0))
 
@@ -427,6 +470,17 @@
   (x y) (logand x y)
   (x y z ... last) (logand (logand x y . z) last))
 
+(hashq-set!
+ *primitive-expand-table*
+ 'make-vector
+ (match-lambda*
+  ((src len)
+   (make-primcall src 'make-vector (list len (make-const src *unspecified*))))
+  ((src len init)
+   (make-primcall src 'make-vector (list len init)))
+  ((src . args)
+   (make-call src (make-primitive-ref src 'make-vector) args))))
+
 (define-primitive-expander caar (x) (car (car x)))
 (define-primitive-expander cadr (x) (car (cdr x)))
 (define-primitive-expander cdar (x) (cdr (car x)))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 837a667e6..df6df4f7b 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1,6 +1,6 @@
 ;;;; goops.scm -- The Guile Object-Oriented Programming System
 ;;;;
-;;;; Copyright (C) 1998-2003, 2006, 2009-2011, 2013-2015, 2018
+;;;; Copyright (C) 1998-2003,2006,2009-2011,2013-2015,2017-2018
 ;;;;   Free Software Foundation, Inc.
 ;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
 ;;;;
@@ -28,6 +28,8 @@
 (define-module (oop goops)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module ((ice-9 control) #:select (let/ec))
+  #:use-module (ice-9 threads)
   #:use-module ((language tree-il primitives)
                 :select (add-interesting-primitive!))
   #:export-syntax (define-class class standard-define-class
@@ -41,9 +43,12 @@
             ;; Slot types.
             <slot>
             <foreign-slot> <protected-slot> <hidden-slot> <opaque-slot>
-            <read-only-slot> <self-slot> <protected-opaque-slot>
+            <read-only-slot> <protected-opaque-slot>
             <protected-hidden-slot> <protected-read-only-slot>
-            <scm-slot> <int-slot> <float-slot> <double-slot>
+            <scm-slot>
+
+            ;; Redefinable classes.
+            <redefinable-class>
 
             ;; Methods are implementations of generic functions.
             <method> <accessor-method>
@@ -182,13 +187,12 @@
 (define-macro-folder fold-class-slots
   (layout #:class <protected-read-only-slot>)
   (flags #:class <hidden-slot>)
-  (self #:class <self-slot>)
   (instance-finalizer #:class <hidden-slot>)
   (print)
   (name #:class <protected-hidden-slot>)
   (nfields #:class <hidden-slot>)
-  (%reserved #:class <hidden-slot>)
-  (redefined)
+  (%reserved-6 #:class <hidden-slot>)
+  (%reserved-7 #:class <hidden-slot>)
   (direct-supers)
   (direct-slots)
   (direct-subclasses)
@@ -249,9 +253,11 @@
 ;;; a vtable are themselves vtables, and `vtable-flag-validated'
 ;;; indicates that the struct's layout has been validated.  goops.c
 ;;; defines a few additional flags: one to indicate that a vtable is
-;;; actually a class, one to indicate that the class is "valid" (meaning
-;;; that it hasn't been redefined), and one to indicate that instances
-;;; of a class are slot definition objects (<slot> instances).
+;;; actually a class, one to indicate that instances of a class are slot
+;;; definition objects (<slot> instances), one to indicate that this
+;;; class has "static slot allocation" (meaning that its slots must
+;;; always be allocated to the same indices in all subclasses), and two
+;;; more flags used for redefinable classes (more below).
 ;;;
 (define vtable-flag-goops-metaclass
   (logior vtable-flag-vtable vtable-flag-goops-class))
@@ -284,7 +290,13 @@
        (class-has-flags? (struct-vtable obj) vtable-flag-goops-class)))
 
 (define (class-has-statically-allocated-slots? class)
-  (class-has-flags? class vtable-flag-goops-static))
+  (class-has-flags? class vtable-flag-goops-static-slot-allocation))
+
+(define (class-has-indirect-instances? class)
+  (class-has-flags? class vtable-flag-goops-indirect))
+
+(define (indirect-slots-need-migration? slots)
+  (class-has-flags? (struct-vtable slots) vtable-flag-goops-needs-migration))
 
 ;;;
 ;;; Now that we know the slots that must be present in classes, and
@@ -299,15 +311,12 @@
                 ;; A simple way to compute class layout for the concrete
                 ;; types used in <class>.
                 (syntax-rules (<protected-read-only-slot>
-                               <self-slot>
                                <hidden-slot>
                                <protected-hidden-slot>)
                   ((_ (name) tail)
                    (string-append "pw" tail))
                   ((_ (name #:class <protected-read-only-slot>) tail)
-                   (string-append "pr" tail))
-                  ((_ (name #:class <self-slot>) tail)
-                   (string-append "sr" tail))
+                   (string-append "pw" tail))
                   ((_ (name #:class <hidden-slot>) tail)
                    (string-append "uh" tail))
                   ((_ (name #:class <protected-hidden-slot>) tail)
@@ -315,8 +324,7 @@
     (let* ((layout (fold-class-slots macro-fold-right cons-layout ""))
            (nfields (/ (string-length layout) 2))
            (<class> (%make-vtable-vtable layout)))
-      (class-add-flags! <class> (logior vtable-flag-goops-class
-                                        vtable-flag-goops-valid))
+      (class-add-flags! <class> vtable-flag-goops-class)
       (struct-set! <class> class-index-name '<class>)
       (struct-set!/unboxed <class> class-index-nfields nfields)
       (struct-set! <class> class-index-direct-supers '())
@@ -325,7 +333,6 @@
       (struct-set! <class> class-index-direct-methods '())
       (struct-set! <class> class-index-cpl '())
       (struct-set! <class> class-index-slots '())
-      (struct-set! <class> class-index-redefined #f)
       <class>)))
 
 ;;;
@@ -427,8 +434,7 @@ followed by its associated value.  If @var{l} does not hold a value for
            (nfields (/ (string-length layout) 2))
            (<slot> (make-struct/no-tail <class> (make-struct-layout layout))))
       (class-add-flags! <slot> (logior vtable-flag-goops-class
-                                       vtable-flag-goops-slot
-                                       vtable-flag-goops-valid))
+                                       vtable-flag-goops-slot))
       (struct-set! <slot> class-index-name '<slot>)
       (struct-set!/unboxed <slot> class-index-nfields nfields)
       (struct-set! <slot> class-index-direct-supers '())
@@ -437,7 +443,6 @@ followed by its associated value.  If @var{l} does not hold a value for
       (struct-set! <slot> class-index-direct-methods '())
       (struct-set! <slot> class-index-cpl (list <slot>))
       (struct-set! <slot> class-index-slots '())
-      (struct-set! <slot> class-index-redefined #f)
       <slot>)))
 
 ;;; Access to slot objects is performance-sensitive for slot-ref, so in
@@ -737,7 +742,7 @@ followed by its associated value.  If @var{l} does not hold a value for
 (define (read-only-slot? slot) #f)
 (define (unboxed-slot? slot)
   (memq (%slot-definition-name slot)
-        '(flags instance-finalizer nfields %reserved)))
+        '(flags instance-finalizer nfields %reserved-6 %reserved-7)))
 
 (define (allocate-slots class slots)
   "Transform the computed list of direct slot definitions @var{slots}
@@ -816,11 +821,9 @@ slots as we go."
     (let ((type (get-keyword #:class (%slot-definition-options slot))))
       (if (and type (subclass? type <foreign-slot>))
           (values (cond
-                   ((subclass? type <self-slot>) #\s)
                    ((subclass? type <protected-slot>) #\p)
                    (else #\u))
                   (cond
-                   ((subclass? type <read-only-slot>) #\r)
                    ((subclass? type <hidden-slot>) #\h)
                    (else #\w)))
           (values #\p #\w))))
@@ -871,7 +874,6 @@ slots as we go."
     (struct-set! z class-index-direct-supers dsupers)
     (struct-set! z class-index-direct-subclasses '())
     (struct-set! z class-index-direct-methods '())
-    (struct-set! z class-index-redefined #f)
     (let ((cpl (compute-cpl z)))
       (struct-set! z class-index-cpl cpl)
       (when (memq <slot> cpl)
@@ -928,7 +930,6 @@ slots as we go."
 (define-standard-class <hidden-slot> (<foreign-slot>))
 (define-standard-class <opaque-slot> (<foreign-slot>))
 (define-standard-class <read-only-slot> (<foreign-slot>))
-(define-standard-class <self-slot> (<read-only-slot>))
 (define-standard-class <protected-opaque-slot> (<protected-slot>
                                                 <opaque-slot>))
 (define-standard-class <protected-hidden-slot> (<protected-slot>
@@ -936,15 +937,11 @@ slots as we go."
 (define-standard-class <protected-read-only-slot> (<protected-slot>
                                                    <read-only-slot>))
 (define-standard-class <scm-slot> (<protected-slot>))
-(define-standard-class <int-slot> (<foreign-slot>))
-(define-standard-class <float-slot> (<foreign-slot>))
-(define-standard-class <double-slot> (<foreign-slot>))
 
 (define (opaque-slot? slot) (is-a? slot <opaque-slot>))
 (define (read-only-slot? slot) (is-a? slot <read-only-slot>))
 (define (unboxed-slot? slot)
   (and (is-a? slot <foreign-slot>)
-       (not (is-a? slot <self-slot>))
        (not (is-a? slot <protected-slot>))))
 
 
@@ -963,6 +960,30 @@ slots as we go."
           (compute-direct-slot-definition class initargs)))
       (struct-set! class class-index-direct-slots
                    (map make-direct-slot-definition specs))))
+  ;; Boot definition that avoids munging nfields.
+  (define (allocate-slots class slots)
+    (define (make-effective-slot-definition slot index)
+      (let* ((slot (compute-effective-slot-definition class slot))
+             (get/raw (standard-get index))
+             (set/raw (standard-set index)))
+        (struct-set! slot slot-index-slot-ref/raw (standard-get index))
+        (struct-set! slot slot-index-slot-ref
+                     (if (slot-definition-init-thunk slot)
+                         get/raw
+                         (bound-check-get index)))
+        (struct-set! slot slot-index-slot-set!
+                     (if (read-only-slot? slot)
+                         (lambda (o v)
+                           (let ((v* (get/raw o)))
+                             (if (unbound? v*)
+                                 ;; Allow initialization.
+                                 (set/raw o v)
+                                 (error "Slot is read-only" slot))))
+                         set/raw))
+        (struct-set! slot slot-index-index index)
+        (struct-set! slot slot-index-size 1)
+        slot))
+    (map make-effective-slot-definition slots (iota (length slots))))
   (define (initialize-slots! class)
     (let ((slots (build-slots-list (class-direct-slots class)
                                    (class-precedence-list class))))
@@ -976,8 +997,8 @@ slots as we go."
 
   ;; Now that we're all done with that, mark <class> and <slot> as
   ;; static.
-  (class-add-flags! <class> vtable-flag-goops-static)
-  (class-add-flags! <slot> vtable-flag-goops-static))
+  (class-add-flags! <class> vtable-flag-goops-static-slot-allocation)
+  (class-add-flags! <slot> vtable-flag-goops-static-slot-allocation))
 
 
 
@@ -1078,13 +1099,6 @@ slots as we go."
   "An internal routine to redefine a SMOB class that was added after
 GOOPS was loaded, and on which scm_set_smob_apply installed an apply
 function."
-  ;; Why not use class-redefinition?  We would, except that loading the
-  ;; compiler to compile effective methods can happen while GOOPS has
-  ;; only been partially loaded, and loading the compiler might cause
-  ;; SMOB types to be defined that need this facility.  Instead we make
-  ;; a very specific hack, not a general solution.  Probably the right
-  ;; solution is to avoid using the compiler, but that is another kettle
-  ;; of fish.
   (unless (memq <applicable> (class-precedence-list class))
     (unless (null? (class-slots class))
       (error "SMOB object has slots?"))
@@ -1145,8 +1159,7 @@ function."
                     (#:body body ())
                     (#:make-procedure make-procedure #f))))
        ((memq <class> (class-precedence-list class))
-        (class-add-flags! z (logior vtable-flag-goops-class
-                                    vtable-flag-goops-valid))
+        (class-add-flags! z vtable-flag-goops-class)
         (for-each (match-lambda
                    ((kw slot default)
                     (slot-set! z slot (get-keyword kw args default))))
@@ -1163,18 +1176,6 @@ function."
 ;;;
 ;;; Slot access.
 ;;;
-;;; Before we go on, some notes about class redefinition.  In GOOPS,
-;;; classes can be redefined.  Redefinition of a class marks the class
-;;; as invalid, and instances will be lazily migrated over to the new
-;;; representation as they are accessed.  Migration happens when
-;;; `class-of' is called on an instance.  For more technical details on
-;;; object redefinition, see struct.h.
-;;;
-;;; In the following interfaces, class-of handles the redefinition
-;;; protocol.  I would think though that there is some thread-unsafety
-;;; here though as the { class, object data } pair needs to be accessed
-;;; atomically, not the { class, object } pair.
-;;;
 (define-inlinable (%class-slot-definition class slot-name kt kf)
   (let lp ((slots (struct-ref class class-index-slots)))
     (match slots
@@ -1241,39 +1242,6 @@ function."
     #f)
   (%class-slot-definition (class-of obj) slot-name have-slot no-slot))
 
-(begin-deprecated
- (define (check-slot-args class obj slot-name)
-   (unless (eq? class (class-of obj))
-     (scm-error 'wrong-type-arg #f "~S is not the class of ~S"
-                (list class obj) #f))
-   (unless (symbol? slot-name)
-     (scm-error 'wrong-type-arg #f "Not a symbol: ~S"
-                (list slot-name) #f)))
-
- (define (slot-ref-using-class class obj slot-name)
-   (issue-deprecation-warning "slot-ref-using-class is deprecated.  "
-                              "Use slot-ref instead.")
-   (check-slot-args class obj slot-name)
-   (slot-ref obj slot-name))
-
- (define (slot-set-using-class! class obj slot-name value)
-   (issue-deprecation-warning "slot-set-using-class! is deprecated.  "
-                              "Use slot-set! instead.")
-   (check-slot-args class obj slot-name)
-   (slot-set! obj slot-name value))
-
- (define (slot-bound-using-class? class obj slot-name)
-   (issue-deprecation-warning "slot-bound-using-class? is deprecated.  "
-                              "Use slot-bound? instead.")
-   (check-slot-args class obj slot-name)
-   (slot-bound? obj slot-name))
-
- (define (slot-exists-using-class? class obj slot-name)
-   (issue-deprecation-warning "slot-exists-using-class? is deprecated.  "
-                              "Use slot-exists? instead.")
-   (check-slot-args class obj slot-name)
-   (slot-exists? obj slot-name)))
-
 
 
 
@@ -1800,12 +1768,12 @@ function."
 (define-syntax-rule (define-class name supers slot ...)
   (begin
     (define-class-pre-definitions (slot ...))
-    (if (and (defined? 'name)
-             (is-a? name <class>)
-             (memq <object> (class-precedence-list name)))
-        (class-redefinition name
-                            (class supers slot ... #:name 'name))
-        (toplevel-define! 'name (class supers slot ... #:name 'name)))))
+    (let ((cls (class supers slot ... #:name 'name)))
+      (toplevel-define!
+       'name
+       (if (defined? 'name)
+           (class-redefinition name cls)
+           cls)))))
 
 (define-syntax-rule (standard-define-class arg ...)
   (define-class arg ...))
@@ -2202,14 +2170,14 @@ function."
 ;;; have a rest argument.
 ;;;
 
-(define (map* fn . l) 		; A map which accepts dotted lists (arg lists  
+(define (map* fn . l) 		; A map which accepts dotted lists (arg lists
   (cond 			; must be "isomorph"
    ((null? (car l)) '())
    ((pair? (car l)) (cons (apply fn      (map car l))
 			  (apply map* fn (map cdr l))))
    (else            (apply fn l))))
 
-(define (for-each* fn . l) 	; A for-each which accepts dotted lists (arg lists  
+(define (for-each* fn . l) 	; A for-each which accepts dotted lists (arg lists
   (cond 			; must be "isomorph"
    ((null? (car l)) '())
    ((pair? (car l)) (apply fn (map car l)) (apply for-each* fn (map cdr l)))
@@ -2601,115 +2569,6 @@ function."
     clone))
 
 ;;;
-;;; {Class redefinition utilities}
-;;;
-
-;;; (class-redefinition OLD NEW)
-;;;
-
-;;; Has correct the following conditions:
-
-;;; Methods
-;;;
-;;; 1. New accessor specializers refer to new header
-;;;
-;;; Classes
-;;;
-;;; 1. New class cpl refers to the new class header
-;;; 2. Old class header exists on old super classes direct-subclass lists
-;;; 3. New class header exists on new super classes direct-subclass lists
-
-(define-method (class-redefinition (old <class>) (new <class>))
-  ;; Work on direct methods:
-  ;;            1. Remove accessor methods from the old class
-  ;;            2. Patch the occurences of new in the specializers by old
-  ;;            3. Displace the methods from old to new
-  (remove-class-accessors! old)                                 ;; -1-
-  (let ((methods (class-direct-methods new)))
-    (for-each (lambda (m)
-                 (update-direct-method! m new old))     ;; -2-
-              methods)
-    (struct-set! new
-                 class-index-direct-methods
-                 (append methods (class-direct-methods old))))
-
-  ;; Substitute old for new in new cpl
-  (set-car! (struct-ref new class-index-cpl) old)
-
-  ;; Remove the old class from the direct-subclasses list of its super classes
-  (for-each (lambda (c) (struct-set! c class-index-direct-subclasses
-                                     (delv! old (class-direct-subclasses c))))
-            (class-direct-supers old))
-
-  ;; Replace the new class with the old in the direct-subclasses of the supers
-  (for-each (lambda (c)
-              (struct-set! c class-index-direct-subclasses
-                           (cons old (delv! new (class-direct-subclasses c)))))
-            (class-direct-supers new))
-
-  ;; Swap object headers
-  (%modify-class old new)
-
-  ;; Now old is NEW!
-
-  ;; Redefine all the subclasses of old to take into account modification
-  (for-each
-   (lambda (c)
-     (update-direct-subclass! c new old))
-   (class-direct-subclasses new))
-
-  ;; Invalidate class so that subsequent instances slot accesses invoke
-  ;; change-object-class
-  (struct-set! new class-index-redefined old)
-  (class-clear-flags! new vtable-flag-goops-valid) ;must come after slot-set!
-
-  old)
-
-;;;
-;;; remove-class-accessors!
-;;;
-
-(define-method (remove-class-accessors! (c <class>))
-  (for-each (lambda (m)
-              (when (is-a? m <accessor-method>)
-                (let ((gf (slot-ref m 'generic-function)))
-                  ;; remove the method from its GF
-                  (slot-set! gf 'methods
-                             (delq1! m (slot-ref gf 'methods)))
-                  (invalidate-method-cache! gf)
-                  ;; remove the method from its specializers
-                  (remove-method-in-classes! m))))
-            (class-direct-methods c)))
-
-;;;
-;;; update-direct-method!
-;;;
-
-(define-method (update-direct-method! (m  <method>)
-                                      (old <class>)
-                                      (new <class>))
-  (let loop ((l (method-specializers m)))
-    ;; Note: the <top> in dotted list is never used.
-    ;; So we can work as if we had only proper lists.
-    (when (pair? l)
-      (when (eqv? (car l) old)
-        (set-car! l new))
-      (loop (cdr l)))))
-
-;;;
-;;; update-direct-subclass!
-;;;
-
-(define-method (update-direct-subclass! (c <class>)
-                                        (old <class>)
-                                        (new <class>))
-  (class-redefinition c
-                      (make-class (class-direct-supers c)
-                                  (class-direct-slots c)
-                                  #:name (class-name c)
-                                  #:metaclass (class-of c))))
-
-;;;
 ;;; {Utilities for INITIALIZE methods}
 ;;;
 
@@ -2891,21 +2750,19 @@ var{initargs}."
       (compute-direct-slot-definition class initargs)))
 
   (next-method)
-  (class-add-flags! class (logior vtable-flag-goops-class
-                                  vtable-flag-goops-valid))
+  (class-add-flags! class vtable-flag-goops-class)
   (struct-set! class class-index-name (get-keyword #:name initargs '???))
   (struct-set!/unboxed class class-index-nfields 0)
   (struct-set! class class-index-direct-supers
                (get-keyword #:dsupers initargs '()))
   (struct-set! class class-index-direct-subclasses '())
   (struct-set! class class-index-direct-methods '())
-  (struct-set! class class-index-redefined #f)
   (struct-set! class class-index-cpl (compute-cpl class))
   (when (get-keyword #:static-slot-allocation? initargs #f)
     (match (filter class-has-statically-allocated-slots?
                    (class-precedence-list class))
       (()
-       (class-add-flags! class vtable-flag-goops-static))
+       (class-add-flags! class vtable-flag-goops-static-slot-allocation))
       (classes
        (error "Class has superclasses with static slot allocation" classes))))
   (struct-set! class class-index-direct-slots
@@ -2982,43 +2839,6 @@ var{initargs}."
 
 
 ;;;
-;;; {Change-class}
-;;;
-
-(define (change-object-class old-instance old-class new-class)
-  (let ((new-instance (allocate-instance new-class '())))
-    ;; Initialize the slots of the new instance
-    (for-each
-     (lambda (slot)
-       (if (and (slot-exists? old-instance slot)
-                (eq? (%slot-definition-allocation
-                      (class-slot-definition old-class slot))
-                     #:instance)
-                (slot-bound? old-instance slot))
-           ;; Slot was present and allocated in old instance; copy it
-           (slot-set! new-instance slot (slot-ref old-instance slot))
-           ;; slot was absent; initialize it with its default value
-           (let ((init (slot-init-function new-class slot)))
-             (when init
-               (slot-set! new-instance slot (init))))))
-     (map slot-definition-name (class-slots new-class)))
-    ;; Exchange old and new instance in place to keep pointers valid
-    (%modify-instance old-instance new-instance)
-    ;; Allow class specific updates of instances (which now are swapped)
-    (update-instance-for-different-class new-instance old-instance)
-    old-instance))
-
-
-(define-method (update-instance-for-different-class (old-instance <object>)
-                                                    (new-instance
-                                                     <object>))
-  ;;not really important what we do, we just need a default method
-  new-instance)
-
-(define-method (change-class (old-instance <object>) (new-class <class>))
-  (change-object-class old-instance (class-of old-instance) new-class))
-
-;;;
 ;;; {make}
 ;;;
 ;;; A new definition which overwrites the previous one which was built-in
@@ -3136,6 +2956,332 @@ var{initargs}."
                 no-method
                 ))
 
+
+
+;;;
+;;; Class redefinition
+;;;
+
+;;; GOOPS has a facility to allow a user to change the definition of
+;;; class.  This will cause instances of that class to lazily migrate
+;;; over to the new definition.  Implementing this is tricky because
+;;; identity is a fundamental part of object-oriented programming; you
+;;; can't just make a new class and start using it, just like that.  In
+;;; GOOPS, classes are objects too and need to be addressable by
+;;; identity (by `eq?').  Classes need the ability to change their
+;;; definition "in place".  The same goes for instances; redefining a
+;;; class might change the amount of storage associated with each
+;;; instance, and yet we need to update the instances in place, and
+;;; without having classes maintain a list of all of their instances.
+;;;
+;;; The way that we implement this is by adding an indirection.  An
+;;; instance of a redefinable class becomes a small object containing
+;;; only a single field, a reference to an external "slots" objects that
+;;; holds the actual slots.  There is an exception however for objects
+;;; that have statically allocated slots, most importantly classes -- in
+;;; that case the indirected slots are allocated "directly" in the
+;;; object.
+;;;
+;;; Instances update by checking the class of their their indirected
+;;; slots object.  In addition to describing the slots of the indirected
+;;; slots object, that slots class (which is a direct class) has a
+;;; "redefined" slot.  If the indirect slots object is current, this
+;;; value is #f.  Otherwise it points to the old class definition
+;;; corresponding to its instances.
+;;;
+;;; To try to clarify things, here is a diagram of the "normal" state of
+;;; affairs.  The redefinable class has an associated slots class.  When
+;;; it makes instances, the instances have a pointer to the indirect
+;;; "slots" object.  The class of the indirect slots object is the slots
+;;; class associated with the instance's class.  The "V" arrows indicate
+;;; a vtable (class-of) relationship.  Dashed arrows indicate a reference
+;;; from a struct slot to an object.
+;;;
+;;;     Initial state.
+;;;     +-------------+  +------------------------------+
+;;;     | class      ----> slots class, redefined: #f   |
+;;;     +-V-----------+  +-V----------------------------+
+;;;       V                V
+;;;     +-V-----------+  +-V----------------------------+
+;;;     | instance   ----> slots ...                    |
+;;;     +-------------+  +------------------------------+
+;;;
+;;; When a class is redefined, it is updated in place.  However existing
+;;; instances are only migrated lazily.  So after a class has been
+;;; redefined but before the instance has been updated, the state looks
+;;; like this:
+;;;
+;;;     Redefined state.
+;;;       ,-------------------------------------------.
+;;;       |                                           |
+;;;     +-v-----------+  +----------------------------|-+
+;;;     | old class  ----> old slots class, redefined:' VVV
+;;;     +-------------+  +------------------------------+ V
+;;;                                                       V
+;;;     +-------------+  +------------------------------+ V
+;;;     | new class  ----> new slots class, redefined:#f| V
+;;;     +-V-----------+  +------------------------------+ V
+;;;       V                                               V
+;;;     +-V-----------+  +------------------------------+ V
+;;;     | old inst   ----> slots ...                    VVV
+;;;     +-------------+  +------------------------------+
+;;;
+;;; That is to say, because the class was updated in place, the old
+;;; instance's vtable is the new class, even though the old instance's
+;;; slots still correspond to the old class.  The vtable of the old slots
+;;; has the "redefined" field, which has been set to point to a fresh
+;;; object containing the direct slots of the old class, and a pointer to
+;;; the old slots class -- as if it were the old class, but with a new
+;;; temporary identity.  This allows us to then call
+;;;
+;;;   (change-object-class obj old-class new-class)
+;;;
+;;; which will allocate a fresh slots object for the old instance
+;;; corresponding to the new class, completing the migration for that
+;;; instance.
+;;;
+;;; Lazy instance migration is triggered by "class-of".  Calling
+;;; "class-of" on an indirect instance will check the indirect slots to
+;;; see if they need redefinition.  If so, we construct a fresh instance
+;;; of the new class and swap fields with the old instance (including
+;;; the indirect-slots field).  Unfortunately there is some
+;;; thread-unsafety here, as retrieving the class is unsynchronized with
+;;; retrieving the indirect slots.
+;;;
+(define-class <indirect-slots-class> (<class>)
+  (%redefined #:init-value #f))
+(define-class <redefinable-class> (<class>)
+  (indirect-slots-class))
+
+(define-method (compute-slots (class <redefinable-class>))
+  (let* ((slots (next-method))
+         ;; The base method ensured that at most one superclass has
+         ;; statically allocated slots.
+         (static-slots
+          (match (filter class-has-statically-allocated-slots?
+                         (cdr (class-precedence-list class)))
+            (() '())
+            ((class) (struct-ref class class-index-direct-slots)))))
+    (define (simplify-slot-definition s)
+      ;; Here we take a slot definition and strip it to just be a plain
+      ;; old name, suitable for use as a slot for the plain-old-data
+      ;; indirect-slots class.
+      (and (eq? (slot-definition-allocation s) #:instance)
+           (make (class-of s) #:name (slot-definition-name s))))
+    (define (maybe-make-indirect-slot-definition s)
+      ;; Here we copy over all the frippery of a slot definition
+      ;; (accessors, init-keywords, and so on), but we change the slot
+      ;; to have virtual allocation and we provide explicit
+      ;; slot-ref/slot-set! functions that access the slot value through
+      ;; the indirect slots object.  For slot definitions without
+      ;; instance allocation though, we just pass them through.
+      (cond
+       ((eq? (slot-definition-allocation s) #:instance)
+        (let* ((s* (class-slot-definition (slot-ref class 'indirect-slots-class)
+                                          (slot-definition-name s)))
+               (ref (slot-definition-slot-ref/raw s*))
+               (set! (slot-definition-slot-set! s*)))
+          (make (class-of s) #:name (slot-definition-name s)
+                #:getter (slot-definition-getter s)
+                #:setter (slot-definition-setter s)
+                #:accessor (slot-definition-accessor s)
+                #:init-keyword (slot-definition-init-keyword s)
+                #:init-thunk (slot-definition-init-thunk s)
+                #:allocation #:virtual
+                ;; TODO: Make faster.
+                #:slot-ref (lambda (o)
+                             (ref (slot-ref o 'indirect-slots)))
+                #:slot-set! (lambda (o v)
+                              (set! (slot-ref o 'indirect-slots) v)))))
+       (else s)))
+    (unless (equal? (list-head slots (length static-slots))
+                    static-slots)
+      (error "unexpected slots"))
+    (let* ((indirect-slots (list-tail slots (length static-slots)))
+           (indirect-slots-class
+            (make-class '()
+                        (filter-map simplify-slot-definition
+                                    indirect-slots)
+                        #:name 'indirect-slots
+                        #:metaclass <indirect-slots-class>)))
+      (slot-set! class 'indirect-slots-class indirect-slots-class)
+      (append static-slots
+              (cons (make <slot> #:name 'indirect-slots)
+                    (map maybe-make-indirect-slot-definition
+                         indirect-slots))))))
+
+(define-method (initialize (class <redefinable-class>) initargs)
+  (next-method)
+  (class-add-flags! class vtable-flag-goops-indirect))
+
+(define-method (allocate-instance (class <redefinable-class>) initargs)
+  (let ((instance (next-method))
+        (nfields (struct-ref/unboxed class class-index-nfields))
+        (indirect-slots-class (slot-ref class 'indirect-slots-class)))
+    ;; Indirect slots will be last struct field.
+    (struct-set! instance (1- nfields) (make indirect-slots-class))
+    instance))
+
+;; Called when redefining an existing binding, and the new binding is a
+;; class.  Two arguments: the old value, and the new.
+(define-generic class-redefinition)
+
+(define-method (class-redefinition (old <top>) (new <class>))
+  ;; Default class-redefinition method is to just replace old binding
+  ;; with the class.
+  new)
+
+(define-method (class-redefinition (old <redefinable-class>)
+                                   (new <redefinable-class>))
+  ;; When redefining a redefinable class with a redefinable class, we
+  ;; migrate the old definition and its instances to become the new
+  ;; definition.
+  ;;
+  ;; Work on direct methods:
+  ;;            1. Remove accessor methods from the old class
+  ;;            2. Patch the occurences of new in the specializers by old
+  ;;            3. Displace the methods from old to new
+  (remove-class-accessors! old)                                 ;; -1-
+  (let ((methods (class-direct-methods new)))
+    (for-each (lambda (m)
+                (update-direct-method! m new old))     ;; -2-
+              methods)
+    (struct-set! new
+                 class-index-direct-methods
+                 (append methods (class-direct-methods old))))
+
+  ;; Substitute old for new in new cpl
+  (set-car! (struct-ref new class-index-cpl) old)
+
+  ;; Remove the old class from the direct-subclasses list of its super classes
+  (for-each (lambda (c) (struct-set! c class-index-direct-subclasses
+                                     (delv! old (class-direct-subclasses c))))
+            (class-direct-supers old))
+
+  ;; Replace the new class with the old in the direct-subclasses of the supers
+  (for-each (lambda (c)
+              (struct-set! c class-index-direct-subclasses
+                           (cons old (delv! new (class-direct-subclasses c)))))
+            (class-direct-supers new))
+
+  ;; Swap object headers
+  (%modify-instance old new)
+
+  ;; Now old is NEW!
+
+  ;; Redefine all the subclasses of old to take into account modification
+  (for-each
+   (lambda (c)
+     (update-direct-subclass! c new old))
+   (class-direct-subclasses new))
+
+  ;; Invalidate class so that subsequent instance slot accesses invoke
+  ;; change-object-class
+  (let ((slots-class (slot-ref new 'indirect-slots-class)))
+    (slot-set! slots-class '%redefined new)
+    (class-add-flags! slots-class vtable-flag-goops-needs-migration))
+
+  old)
+
+(define-method (remove-class-accessors! (c <class>))
+  (for-each (lambda (m)
+              (when (is-a? m <accessor-method>)
+                (let ((gf (slot-ref m 'generic-function)))
+                  ;; remove the method from its GF
+                  (slot-set! gf 'methods
+                             (delq1! m (slot-ref gf 'methods)))
+                  (invalidate-method-cache! gf)
+                  ;; remove the method from its specializers
+                  (remove-method-in-classes! m))))
+            (class-direct-methods c)))
+
+(define-method (update-direct-method! (m  <method>)
+                                      (old <class>)
+                                      (new <class>))
+  (let loop ((l (method-specializers m)))
+    ;; Note: the <top> in dotted list is never used.
+    ;; So we can work as if we had only proper lists.
+    (when (pair? l)
+      (when (eqv? (car l) old)
+        (set-car! l new))
+      (loop (cdr l)))))
+
+(define-method (update-direct-subclass! (c <class>)
+                                        (old <class>)
+                                        (new <class>))
+  (class-redefinition c
+                      (make-class (class-direct-supers c)
+                                  (class-direct-slots c)
+                                  #:name (class-name c)
+                                  #:metaclass (class-of c))))
+
+(define (change-object-class old-instance old-class new-class)
+  (let ((new-instance (allocate-instance new-class '())))
+    ;; Initialize the slots of the new instance
+    (for-each
+     (lambda (slot)
+       (unless (eq? slot 'indirect-slots)
+         (if (and (slot-exists? old-instance slot)
+                  (memq (%slot-definition-allocation
+                         (class-slot-definition old-class slot))
+                        '(#:instance #:virtual))
+                  (slot-bound? old-instance slot))
+             ;; Slot was present and allocated in old instance; copy it
+             (slot-set! new-instance slot (slot-ref old-instance slot))
+             ;; slot was absent; initialize it with its default value
+             (let ((init (slot-init-function new-class slot)))
+               (when init
+                 (slot-set! new-instance slot (init)))))))
+     (map slot-definition-name (class-slots new-class)))
+    ;; Exchange old and new instance in place to keep pointers valid
+    (%modify-instance old-instance new-instance)
+    ;; Allow class specific updates of instances (which now are swapped)
+    (update-instance-for-different-class new-instance old-instance)
+    old-instance))
+
+
+(define-method (update-instance-for-different-class (old-instance <object>)
+                                                    (new-instance
+                                                     <object>))
+  ;;not really important what we do, we just need a default method
+  new-instance)
+
+(define-method (change-class (old-instance <object>)
+                             (new-class <redefinable-class>))
+  (unless (is-a? (class-of old-instance) <redefinable-class>)
+    (error (string-append
+            "Default change-class implementation only works on"
+            " instances of redefinable classes")))
+  (change-object-class old-instance (class-of old-instance) new-class))
+
+(define class-of-obsolete-indirect-instance
+  (let ((lock (make-mutex))
+        (stack '()))
+    (lambda (instance)
+      (let* ((new-class (struct-vtable instance))
+             (nfields (struct-ref/unboxed new-class class-index-nfields))
+             ;; Indirect slots are in last instance slot.  For normal
+             ;; instances last slot is 0 of course.
+             (slots (struct-ref instance (1- nfields)))
+             (old-class (slot-ref (class-of slots) '%redefined)))
+        (let/ec return
+          (dynamic-wind
+              (lambda ()
+                (with-mutex lock
+                  (if (memv slots stack)
+                      (return (or old-class new-class))
+                      (set! stack (cons slots stack)))))
+              (lambda ()
+                (when old-class
+                  (change-class instance new-class))
+                new-class)
+              (lambda ()
+                (with-mutex lock
+                  (set! stack (delq! slots stack))))))))))
+
+
+
+
 ;;;
 ;;; {Final initialization}
 ;;;
@@ -3150,10 +3296,6 @@ var{initargs}."
 ;;; {SMOB and port classes}
 ;;;
 
-(begin-deprecated
- (define-public <arbiter> (find-subclass <top> '<arbiter>))
- (define-public <async> (find-subclass <top> '<async>)))
-
 (define <promise> (find-subclass <top> '<promise>))
 (define <thread> (find-subclass <top> '<thread>))
 (define <mutex> (find-subclass <top> '<mutex>))
diff --git a/module/rnrs/records/procedural.scm b/module/rnrs/records/procedural.scm
index 2bd908856..cbcd4e5ce 100644
--- a/module/rnrs/records/procedural.scm
+++ b/module/rnrs/records/procedural.scm
@@ -54,22 +54,24 @@
 			hashq-ref
 			hashq-set!
 
-			vector->list)
+			vector->list
+
+                        vtable-offset-user)
 	  (ice-9 receive)
 	  (only (srfi :1) fold split-at take))
 
   (define (record-internal? obj)
     (and (struct? obj) (record-type-descriptor? (struct-vtable obj))))
 
-  (define rtd-index-name 8)
-  (define rtd-index-uid 9)
-  (define rtd-index-parent 10)
-  (define rtd-index-sealed? 11)
-  (define rtd-index-opaque? 12)
-  (define rtd-index-predicate 13)
-  (define rtd-index-field-names 14)
-  (define rtd-index-field-bit-field 15)
-  (define rtd-index-field-binder 16)
+  (define rtd-index-name            (+ vtable-offset-user 0))
+  (define rtd-index-uid             (+ vtable-offset-user 1))
+  (define rtd-index-parent          (+ vtable-offset-user 2))
+  (define rtd-index-sealed?         (+ vtable-offset-user 3))
+  (define rtd-index-opaque?         (+ vtable-offset-user 4))
+  (define rtd-index-predicate       (+ vtable-offset-user 5))
+  (define rtd-index-field-names     (+ vtable-offset-user 6))
+  (define rtd-index-field-bit-field (+ vtable-offset-user 7))
+  (define rtd-index-field-binder    (+ vtable-offset-user 8))
 
   (define rctd-index-rtd 0)
   (define rctd-index-parent 1)
@@ -78,13 +80,13 @@
   (define vtable-base-layout (symbol->string (struct-layout (make-vtable ""))))
 
   (define record-type-vtable 
-    (make-vtable (string-append vtable-base-layout "prprprprprprprprprpr")
+    (make-vtable (string-append vtable-base-layout "pwpwpwpwpwpwpwpwpwpw")
 		 (lambda (obj port) 
 		   (simple-format port "#<r6rs:record-type:~A>"
 				  (struct-ref obj rtd-index-name)))))
 
   (define record-constructor-vtable 
-    (make-vtable "prprpr"
+    (make-vtable "pwpwpw"
 		 (lambda (obj port) 
 		   (simple-format port "#<r6rs:record-constructor:~A>" 
 				  (struct-ref (struct-ref obj rctd-index-rtd)
@@ -95,7 +97,7 @@
   (define (make-record-type-descriptor name parent uid sealed? opaque? fields)
     (define fields-pair
       (let loop ((field-list (vector->list fields))
-                 (layout-sym 'pr)
+                 (layout-sym 'pw)
                  (layout-bit-field 0)
                  (counter 0))
         (if (null? field-list)
@@ -103,7 +105,7 @@
             (case (caar field-list)
               ((immutable) 
                (loop (cdr field-list)
-                     (symbol-append layout-sym 'pr) 
+                     (symbol-append layout-sym 'pw)
                      layout-bit-field 
                      (+ counter 1)))
               ((mutable)
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index ae96c9e1f..d86f2f2bc 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -1,6 +1,6 @@
 ;;; Compile --- Command-line Guile Scheme compiler  -*- coding: iso-8859-1 -*-
 
-;; Copyright 2005, 2008-2011, 2013-2015, 2017-2018 Free Software Foundation, Inc.
+;; Copyright 2005,2008-2011,2013-2015,2017-2018 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public License
@@ -33,8 +33,7 @@
   #:use-module ((system base compile) #:select (compile-file))
   #:use-module (system base target)
   #:use-module (system base message)
-  #:use-module (language tree-il optimize)
-  #:use-module (language cps optimize)
+  #:use-module (system base optimize)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-37)
@@ -49,20 +48,6 @@
   (format (current-error-port) "error: ~{~a~}~%" messages)
   (exit 1))
 
-(define (available-optimizations)
-  (append (tree-il-default-optimization-options)
-          (cps-default-optimization-options)))
-
-;; Turn on all optimizations unless -O0.
-(define (optimizations-for-level level)
-  (let lp ((options (available-optimizations)))
-    (match options
-      (() '())
-      ((#:partial-eval? val . options)
-       (cons* #:partial-eval? (> level 0) (lp options)))
-      ((kw val . options)
-       (cons* kw (> level 1) (lp options))))))
-
 (define %options
   ;; Specifications of the command-line options.
   (list (option '(#\h "help") #f #f
@@ -106,7 +91,7 @@
                   (define (return-option name val)
                     (let ((kw (symbol->keyword
                                (string->symbol (string-append name "?")))))
-                      (unless (memq kw (available-optimizations))
+                      (unless (assq kw (available-optimizations))
                         (fail "Unknown optimization pass `~a'" name))
                       (return (list kw val))))
                   (cond
@@ -175,11 +160,10 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
   (let lp ((options (available-optimizations)))
     (match options
       (() #t)
-      ((kw val . options)
+      (((kw level) . options)
        (let ((name (string-trim-right (symbol->string (keyword->symbol kw))
                                       #\?)))
-         (format #t "  -O~a~%"
-                 (if val name (string-append "no-" name)))
+         (format #t "  -O~a~%" name)
          (lp options)))))
   (format #t "~%")
   (format #t "To disable an optimization, prepend it with `no-', for example~%")
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 224c6af7e..626026d74 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -46,9 +46,8 @@
 
 (define %condition-type-vtable
   ;; The vtable of all condition types.
-  ;;   vtable fields: vtable, self, printer
   ;;   user fields:   id, parent, all-field-names
-  (let ((s (make-vtable (string-append standard-vtable-fields "prprpr")
+  (let ((s (make-vtable (string-append standard-vtable-fields "pwpwpw")
                         (lambda (ct port)
                           (format port "#<condition-type ~a ~a>"
                                   (condition-type-id ct)
@@ -93,11 +92,11 @@
   ;; Return a string denoting the layout required to hold the fields listed
   ;; in FIELD-NAMES.
   (let loop ((field-names field-names)
-	     (layout      '("pr")))
+	     (layout      '("pw")))
     (if (null? field-names)
 	(string-concatenate/shared layout)
 	(loop (cdr field-names)
-	      (cons "pr" layout)))))
+	      (cons "pw" layout)))))
 
 (define (print-condition c port)
   ;; Print condition C to PORT in a way similar to how records print:
diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm
index 153b0cbcd..e1bf19e9d 100644
--- a/module/srfi/srfi-43.scm
+++ b/module/srfi/srfi-43.scm
@@ -1,6 +1,6 @@
 ;;; srfi-43.scm -- SRFI 43 Vector library
 
-;;      Copyright (C) 2014 Free Software Foundation, Inc.
+;;      Copyright (C) 2014, 2018 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -41,10 +41,14 @@
 
 (cond-expand-provide (current-module) '(srfi-43))
 
-(define (error-from who msg . args)
-  (apply error
-         (string-append (symbol->string who) ": " msg)
-         args))
+(define-syntax error-from
+  (lambda (stx)
+    (syntax-case stx (quote)
+      ((_ 'who msg arg ...)
+       #`(error #,(string-append (symbol->string (syntax->datum #'who))
+                                 ": "
+                                 (syntax->datum #'msg))
+                arg ...)))))
 
 (define-syntax-rule (assert-nonneg-exact-integer k who)
   (unless (and (exact-integer? k)
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index 718986285..aee8be01c 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -1,7 +1,7 @@
 ;;; srfi-9.scm --- define-record-type
 
 ;; Copyright (C) 2001, 2002, 2006, 2009, 2010, 2011, 2012,
-;;   2013, 2014 Free Software Foundation, Inc.
+;;   2013, 2014, 2018 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -180,16 +180,12 @@
                           copier-name "unknown getter" x id)))
                    #'(getter ...))
          (with-syntax ((unsafe-expr
-                        #`(let ((new (allocate-struct type-name #,nfields)))
-                            #,@(map (lambda (getter index)
-                                      #`(struct-set!
-                                         new
-                                         #,index
-                                         #,(lookup getter
-                                                   #`(struct-ref s #,index))))
-                                    #'(getter-id ...)
-                                    (iota nfields))
-                            new)))
+                        #`(make-struct/simple
+                           type-name
+                           #,@(map (lambda (getter index)
+                                     (lookup getter #`(struct-ref s #,index)))
+                                   #'(getter-id ...)
+                                   (iota nfields)))))
            (if (syntax->datum #'check?)
                #`(if (eq? (struct-vtable s) type-name)
                      unsafe-expr
@@ -217,23 +213,24 @@
       (syntax-case constructor-spec ()
         ((ctor field ...)
          (every identifier? #'(field ...))
-         (let ((slots (map (lambda (field)
-                             (or (list-index (lambda (x)
-                                               (free-identifier=? x field))
-                                             field-ids)
-                                 (syntax-violation
-                                  (syntax-case form ()
-                                    ((macro . args)
-                                     (syntax->datum #'macro)))
-                                  "unknown field in constructor spec"
-                                  form field)))
-                           #'(field ...))))
+         (letrec* ((id-list-contains?
+                    (lambda (id-list id)
+                      (and (not (null? id-list))
+                           (or (free-identifier=? (car id-list) id)
+                               (id-list-contains? (cdr id-list) id)))))
+                   (inits (map (lambda (id)
+                                 (and (id-list-contains? #'(field ...) id) id))
+                               field-ids)))
+           (for-each
+            (lambda (field)
+              (unless (id-list-contains? field-ids field)
+                (syntax-violation
+                 (syntax-case form () ((macro . args) (syntax->datum #'macro)))
+                 "unknown field in constructor spec"
+                 form field)))
+            #'(field ...))
            #`(define-inlinable #,constructor-spec
-               (let ((s (allocate-struct #,type-name #,(length field-ids))))
-                 #,@(map (lambda (arg slot)
-                           #`(struct-set! s #,slot #,arg))
-                         #'(field ...) slots)
-                 s))))))
+               (make-struct/simple #,type-name #,@inits))))))
 
     (define (getters type-name getter-ids copier-id)
       (map (lambda (getter index)
diff --git a/module/statprof.scm b/module/statprof.scm
index 59a2f12d0..a1e0efbd7 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -1,7 +1,7 @@
 ;;;; (statprof) -- a statistical profiler for Guile
 ;;;; -*-scheme-*-
 ;;;;
-;;;; 	Copyright (C) 2009, 2010, 2011, 2013-2017  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2011, 2013-2018  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;;    Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
 ;;;; 
@@ -65,7 +65,6 @@
 
             statprof-display
             statprof-display-anomalies
-            statprof-display-anomolies ; Deprecated spelling.
 
             statprof-fetch-stacks
             statprof-fetch-call-tree
@@ -92,26 +91,16 @@
 ;;; distinguish between different closures which share the same code,
 ;;; but that is usually what we want anyway.
 ;;;
-;;; One case in which we do want to distinguish closures is the case of
-;;; primitive procedures.  If slot 0 in the frame is a primitive
-;;; procedure, we record the procedure's name into the buffer instead of
-;;; the IP.  It's fairly cheap to check whether a value is a primitive
-;;; procedure, and then get its name, as its name is stored in the
-;;; closure data.  Calling procedure-name in the stack sampler isn't
-;;; something you want to do for other kinds of procedures, though, as
-;;; that involves grovelling the debug information.
-;;;
 ;;; The other part of data collection is the exact call counter, which
 ;;; uses the VM's "apply" hook to record each procedure call.
 ;;; Naturally, this is quite expensive, and it is off by default.
 ;;; Running code at every procedure call effectively penalizes procedure
 ;;; calls.  Still, it's useful sometimes.  If the profiler state has a
 ;;; call-counts table, then calls will be counted.  As with the stack
-;;; counter, usually the key in the hash table is the code pointer of
-;;; the procedure being called, except for primitive procedures, in
-;;; which case it is the name of the primitive.  The call counter can
-;;; also see calls of non-programs, for example in the case of
-;;; applicable structs.  In that case the key is the procedure itself.
+;;; counter, the key in the hash table is the code pointer of the
+;;; procedure being called.  The call counter can also see calls of
+;;; non-programs, for example in the case of applicable structs.  In
+;;; that case the key is the procedure itself.
 ;;;
 ;;; After collection is finished, the data can be analyzed.  The first
 ;;; step is usually to run over the stack traces, tabulating sample
@@ -250,8 +239,7 @@
       (set-buffer! state buffer)
       (set-buffer-pos! state (1+ pos)))
      (else
-      (write-sample-and-continue
-       (frame-instruction-pointer-or-primitive-procedure-name frame))))))
+      (write-sample-and-continue (frame-instruction-pointer frame))))))
 
 (define (reset-sigprof-timer usecs)
   ;; Guile's setitimer binding is terrible.
@@ -297,7 +285,7 @@
 (define (count-call frame)
   (let ((state (existing-profiler-state)))
     (unless (inside-profiler? state)
-      (let* ((key (frame-instruction-pointer-or-primitive-procedure-name frame))
+      (let* ((key (frame-instruction-pointer frame))
              (handle (hashv-create-handle! (call-counts state) key 0)))
         (set-cdr! handle (1+ (cdr handle)))))))
 
@@ -325,7 +313,7 @@ than @code{statprof-stop}, @code{#f} otherwise."
         (set-prev-sigprof-handler! state (car prev)))
       (reset-sigprof-timer (if (zero? rpt) (sampling-period state) rpt))
       (when (call-counts state)
-        (add-hook! (vm-apply-hook) count-call)
+        (vm-add-apply-hook! count-call)
         (set-vm-trace-level! (1+ (vm-trace-level))))
       #t)))
   
@@ -338,7 +326,7 @@ than @code{statprof-stop}, @code{#f} otherwise."
   (when (zero? (profile-level state))
     (when (call-counts state)
       (set-vm-trace-level! (1- (vm-trace-level)))
-      (remove-hook! (vm-apply-hook) count-call))
+      (vm-remove-apply-hook! count-call))
     (set-gc-time-taken! state
                         (- (assq-ref (gc-stats) 'gc-time-taken)
                            (gc-time-taken state)))
@@ -448,42 +436,26 @@ always collects full stacks.)"
               (hashv-set! table entry data)
               data))))
 
-    (define (callee->call-data callee)
-      (cond
-       ((number? callee) (addr->call-data callee))
-       ((hashv-ref table callee))
-       (else
-        (let ((data (make-call-data
-                     (cond ((procedure? callee) (procedure-name callee))
-                           ;; a primitive
-                           ((symbol? callee) callee)
-                           (else #f))
-                     (with-output-to-string (lambda () (write callee)))
-                     #f
-                     (and call-counts (hashv-ref call-counts callee))
-                     0
-                     0)))
-          (hashv-set! table callee data)
-          data))))
-
     (when call-counts
       (hash-for-each (lambda (callee count)
-                       (callee->call-data callee))
+                       (unless (number? callee)
+                         (error "unexpected callee" callee))
+                       (addr->call-data callee))
                      call-counts))
 
     (let visit-stacks ((pos 0))
       (cond
        ((< pos len)
         (let ((pos (if call-counts
-                       (skip-count-call buffer pos len)
-                       pos)))
+                        (skip-count-call buffer pos len)
+                        pos)))
           (inc-call-data-self-sample-count!
-           (callee->call-data (vector-ref buffer pos)))
+           (addr->call-data (vector-ref buffer pos)))
           (let visit-stack ((pos pos))
             (cond
              ((vector-ref buffer pos)
-              => (lambda (callee)
-                   (inc-call-data-cum-sample-count! (callee->call-data callee))
+              => (lambda (ip)
+                   (inc-call-data-cum-sample-count! (addr->call-data ip))
                    (visit-stack (1+ pos))))
              (else
               (visit-stacks (1+ pos)))))))
@@ -531,11 +503,7 @@ none is available."
     (error "Can't call statprof-proc-call-data while profiler is running."))
   (unless (program? proc)
     (error "statprof-call-data only works for VM programs"))
-  (let* ((code (program-code proc))
-         (key (if (primitive-code? code)
-                  (procedure-name proc)
-                  code)))
-    (hashv-ref (stack-samples->procedure-data state) key)))
+  (hashv-ref (stack-samples->procedure-data state) (program-code proc)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Stats
@@ -677,11 +645,6 @@ statistics.@code{}"
   (format #t "Total time: ~A\n" (statprof-accumulated-time state))
   (format #t "Sample count: ~A\n" (statprof-sample-count state)))
 
-(define (statprof-display-anomolies)
-  (issue-deprecation-warning "statprof-display-anomolies is a misspelling. "
-                             "Use statprof-display-anomalies instead.")
-  (statprof-display-anomalies))
-
 (define* (statprof-accumulated-time #:optional (state
                                                 (existing-profiler-state)))
   "Returns the time accumulated during the last statprof run.@code{}"
@@ -895,49 +858,6 @@ operation is somewhat expensive."
           (statprof-stop state)
           (statprof-display port state #:style display-style))))))
 
-(begin-deprecated
- (define-macro (with-statprof . args)
-   "Profile the expressions in the body, and return the body's return values.
-
-Keyword arguments:
-
-@table @code
-@item #:display-style
-Set the display style, either @code{'flat} or @code{'tree}.
-
-@item #:loop
-Execute the body @var{loop} number of times, or @code{#f} for no looping
-
-default: @code{#f}
-@item #:hz
-Sampling rate
-
-default: @code{20}
-@item #:count-calls?
-Whether to instrument each function call (expensive)
-
-default: @code{#f}
-@end table"
-   (define (kw-arg-ref kw args def)
-     (cond
-      ((null? args) (error "Invalid macro body"))
-      ((keyword? (car args))
-       (if (eq? (car args) kw)
-           (cadr args)
-           (kw-arg-ref kw (cddr args) def)))
-      ((eq? kw #f def) ;; asking for the body
-       args)
-      (else def))) ;; kw not found
-   (issue-deprecation-warning
-    "`with-statprof' is deprecated.  Use `statprof' instead.")
-   `((@ (statprof) statprof)
-     (lambda () ,@(kw-arg-ref #f args #f))
-     #:display-style ,(kw-arg-ref #:display-style args ''flat)
-     #:loop ,(kw-arg-ref #:loop args 1)
-     #:hz ,(kw-arg-ref #:hz args 100)
-     #:count-calls? ,(kw-arg-ref #:count-calls? args #f)))
- (export with-statprof))
-
 (define* (gcprof thunk #:key (loop 1) full-stacks? (port (current-output-port)))
   "Do an allocation profile of the execution of @var{thunk}.
 
diff --git a/module/system/base/optimize.scm b/module/system/base/optimize.scm
new file mode 100644
index 000000000..562f94ae7
--- /dev/null
+++ b/module/system/base/optimize.scm
@@ -0,0 +1,43 @@
+;;; Optimization flags
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system base optimize)
+  #:use-module (language tree-il optimize)
+  #:use-module (language cps optimize)
+  #:use-module (ice-9 match)
+  #:export (available-optimizations
+            pass-optimization-level
+            optimizations-for-level))
+
+(define (available-optimizations)
+  (append (tree-il-optimizations) (cps-optimizations)))
+
+(define (pass-optimization-level kw)
+  (match (assq kw (available-optimizations))
+    ((kw level) level)
+    (_ (error "unknown optimization" kw))))
+
+;; Turn on all optimizations unless -O0.
+(define (optimizations-for-level level)
+  (let lp ((options (available-optimizations)))
+    (match options
+      (() '())
+      (((kw at-level) . options)
+       (cons* kw (<= at-level level) (lp options))))))
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index a3f6f8ff9..2088cd866 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -1,6 +1,6 @@
 ;;; Compilation targets
 
-;; Copyright (C) 2011-2014, 2018 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014,2017-2018 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -26,7 +26,15 @@
 
             target-cpu target-vendor target-os
 
-            target-endianness target-word-size))
+            target-endianness target-word-size
+
+            target-max-size-t
+            target-max-size-t/scm
+            target-max-vector-length
+
+            target-most-negative-fixnum
+            target-most-positive-fixnum
+            target-fixnum?))
 
 
 
@@ -150,3 +158,39 @@
 (define (target-word-size)
   "Return the word size, in bytes, of the target platform."
   (fluid-ref %target-word-size))
+
+(define (target-max-size-t)
+  "Return the maximum size_t value of the target platform, in bytes."
+  ;; Apply the currently-universal restriction of a maximum 48-bit
+  ;; address space.
+  (1- (ash 1 (min (* (target-word-size) 8) 48))))
+
+(define (target-max-size-t/scm)
+  "Return the maximum size_t value of the target platform, in units of
+SCM words."
+  ;; Apply the currently-universal restriction of a maximum 48-bit
+  ;; address space.
+  (/ (target-max-size-t) (target-word-size)))
+
+(define (target-max-vector-length)
+  "Return the maximum vector length of the target platform, in units of
+SCM words."
+  ;; Vector size fits in first word; the low 8 bits are taken by the
+  ;; type tag.  Additionally, restrict to 48-bit address space.
+  (1- (ash 1 (min (- (* (target-word-size) 8) 8) 48))))
+
+(define (target-most-negative-fixnum)
+  "Return the most negative integer representable as a fixnum on the
+target platform."
+  (- (ash 1 (- (* (target-word-size) 8) 3))))
+
+(define (target-most-positive-fixnum)
+  "Return the most positive integer representable as a fixnum on the
+target platform."
+  (1- (ash 1 (- (* (target-word-size) 8) 3))))
+
+(define (target-fixnum? n)
+  (and (exact-integer? n)
+       (<= (target-most-negative-fixnum)
+           n
+           (target-most-positive-fixnum))))
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 2018dd85b..418c9fed4 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 vlist)
   #:use-module (system foreign)
+  #:use-module (system base types internal)
   #:export (%word-size
 
             memory-backend
@@ -178,6 +179,10 @@ return the corresponding string."
                  (a (logand bits (bitwise-not n))))
              consequent)
            alternate)))
+    ((match-bit-pattern bits (= c) consequent alternate)
+     (if (= bits c)
+         consequent
+         alternate))
     ((match-bit-pattern bits (x & n = c) consequent alternate)
      (let ((tag (logand bits n)))
        (if (= tag c)
@@ -242,53 +247,6 @@ the matching bits, possibly with bitwise operations to extract it from BITS."
        (match-scm-clauses bits* clauses ...)))))
 
 
-;;;
-;;; Tags---keep in sync with libguile/tags.h!
-;;;
-
-;; Immediate values.
-(define %tc2-int 2)
-(define %tc3-imm24 4)
-
-(define %tc3-cons 0)
-(define %tc3-int1 %tc2-int)
-(define %tc3-int2 (+ %tc2-int 4))
-
-(define %tc8-char (+ 8 %tc3-imm24))
-(define %tc8-flag (+ %tc3-imm24 0))
-
-;; Cell types.
-(define %tc3-struct #x01)
-(define %tc7-symbol #x05)
-(define %tc7-variable #x07)
-(define %tc7-vector #x0d)
-(define %tc7-wvect #x0f)
-(define %tc7-string #x15)
-(define %tc7-number #x17)
-(define %tc7-hashtable #x1d)
-(define %tc7-pointer #x1f)
-(define %tc7-fluid #x25)
-(define %tc7-stringbuf #x27)
-(define %tc7-dynamic-state #x2d)
-(define %tc7-frame #x2f)
-(define %tc7-keyword #x35)
-(define %tc7-syntax #x3d)
-(define %tc7-program #x45)
-(define %tc7-vm-continuation #x47)
-(define %tc7-bytevector #x4d)
-(define %tc7-weak-set #x55)
-(define %tc7-weak-table #x57)
-(define %tc7-array #x5d)
-(define %tc7-bitvector #x5f)
-(define %tc7-port #x7d)
-(define %tc7-smob #x77)
-
-(define %tc16-bignum (+ %tc7-number (* 1 256)))
-(define %tc16-real (+ %tc7-number (* 2 256)))
-(define %tc16-complex (+ %tc7-number (* 3 256)))
-(define %tc16-fraction (+ %tc7-number (* 4 256)))
-
-
 ;; "Stringbufs".
 (define-record-type <stringbuf>
   (stringbuf string)
@@ -395,13 +353,14 @@ TYPE-NUMBER."
                                                  (%visited-cells))))
        body ...))))
 
-(define (address->inferior-struct address vtable-data-address backend)
+(define (address->inferior-struct address vtable-address backend)
   "Read the struct at ADDRESS using BACKEND.  Return an 'inferior-struct'
 object representing it."
-  (define %vtable-layout-index 0)
-  (define %vtable-name-index 5)
+  (define %vtable-layout-index vtable-index-layout)
+  (define %vtable-name-index 4)
 
-  (let* ((layout-address (+ vtable-data-address
+  (let* ((vtable-data-address (+ vtable-address %word-size))
+         (layout-address (+ vtable-data-address
                             (* %vtable-layout-index %word-size)))
          (layout-bits    (dereference-word backend layout-address))
          (layout         (scm->object layout-bits backend))
@@ -412,7 +371,7 @@ object representing it."
     (if (symbol? layout)
         (let* ((layout (symbol->string layout))
                (len    (/ (string-length layout) 2))
-               (slots  (dereference-word backend (+ address %word-size)))
+               (slots  (+ address %word-size))
                (port   (memory-port backend slots (* len %word-size)))
                (fields (get-bytevector-n port (* len %word-size)))
                (result (inferior-struct name #f)))
@@ -434,9 +393,9 @@ using BACKEND."
   (or (and=> (vhash-assv address (%visited-cells)) cdr) ; circular object
       (let ((port (memory-port backend address)))
         (match-cell port
-          (((vtable-data-address & 7 = %tc3-struct))
+          (((vtable-address & 7 = %tc3-struct))
            (address->inferior-struct address
-                                     (- vtable-data-address %tc3-struct)
+                                     (- vtable-address %tc3-struct)
                                      backend))
           (((_ & #x7f = %tc7-symbol) buf hash props)
            (match (cell->object buf backend)
@@ -471,7 +430,7 @@ using BACKEND."
                           (bytevector->uint-list words (native-endianness)
                                                  %word-size)))
                vector)))
-          (((_ & #x7f = %tc7-wvect))
+          (((_ & #x7f = %tc7-weak-vector))
            (inferior-object 'weak-vector address))   ; TODO: show elements
           (((_ & #x7f = %tc7-fluid) init-value)
            (inferior-object 'fluid address))
@@ -483,14 +442,14 @@ using BACKEND."
            (inferior-object 'program address))
           (((_ & #xffff = %tc16-bignum))
            (inferior-object 'bignum address))
-          (((_ & #xffff = %tc16-real) pad)
-           (let* ((address (+ address (* 2 %word-size)))
+          (((_ & #xffff = %tc16-flonum) pad)
+           (let* ((address (+ address (match %word-size (4 8) (8 8))))
                   (port    (memory-port backend address (sizeof double)))
                   (words   (get-bytevector-n port (sizeof double))))
              (bytevector-ieee-double-ref words 0 (native-endianness))))
-          (((_ & #x7f = %tc7-number) mpi)
+          (((_ & #x7f = %tc7-heap-number) mpi)
            (inferior-object 'number address))
-          (((_ & #x7f = %tc7-hashtable) buckets meta-data unused)
+          (((_ & #x7f = %tc7-hash-table) buckets meta-data unused)
            (inferior-object 'hash-table address))
           (((_ & #x7f = %tc7-pointer) address)
            (make-pointer address))
@@ -522,11 +481,11 @@ using BACKEND."
   "Return the Scheme object corresponding to BITS, the bits of an 'SCM'
 object."
   (match-scm bits
-    (((integer << 2) || %tc2-int)
+    (((integer << 2) || %tc2-fixnum)
      integer)
-    ((address & 6 = %tc3-cons)
+    ((address & 7 = %tc3-heap-object)
      (let* ((type  (dereference-word backend address))
-            (pair? (not (bit-set? 0 type))))
+            (pair? (= (logand type #b1) %tc1-pair)))
        (if pair?
            (or (and=> (vhash-assv address (%visited-cells)) cdr)
                (let ((car    type)
@@ -541,16 +500,13 @@ object."
            (cell->object address backend))))
     (((char << 8) || %tc8-char)
      (integer->char char))
-    (((flag << 8) || %tc8-flag)
-     (case flag
-       ((0)  #f)
-       ((1)  #nil)
-       ((3)  '())
-       ((4)  #t)
-       ((8)  (if #f #f))
-       ((9)  (inferior-object 'undefined bits))
-       ((10) (eof-object))
-       ((11) (inferior-object 'unbound bits))))))
+    ((= %tc16-false) #f)
+    ((= %tc16-nil) #nil)
+    ((= %tc16-null) '())
+    ((= %tc16-true) #t)
+    ((= %tc16-unspecified) (if #f #f))
+    ((= %tc16-undefined) (inferior-object 'undefined bits))
+    ((= %tc16-eof) (eof-object))))
 
 ;;; Local Variables:
 ;;; eval: (put 'match-scm 'scheme-indent-function 1)
diff --git a/module/system/base/types/internal.scm b/module/system/base/types/internal.scm
new file mode 100644
index 000000000..9e4e4cc9c
--- /dev/null
+++ b/module/system/base/types/internal.scm
@@ -0,0 +1,217 @@
+;;; Details on internal value representation.
+;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (system base types internal)
+  #:export (;; Immediate tags.
+            %tc2-fixnum
+            %tc3-heap-object
+            %tc8-char
+            %tc16-false
+            %tc16-nil
+            %tc16-null
+            %tc16-true
+            %tc16-unspecified
+            %tc16-undefined
+            %tc16-eof
+            visit-immediate-tags
+
+            ;; Heap object tags (cell types).
+            %tc1-pair
+            %tc3-struct
+            %tc7-symbol
+            %tc7-variable
+            %tc7-vector
+            %tc8-immutable-vector
+            %tc8-mutable-vector
+            %tc7-weak-vector
+            %tc7-string
+            %tc7-heap-number
+            %tc7-hash-table
+            %tc7-pointer
+            %tc7-fluid
+            %tc7-stringbuf
+            %tc7-dynamic-state
+            %tc7-frame
+            %tc7-keyword
+            %tc7-atomic-box
+            %tc7-syntax
+            %tc7-program
+            %tc7-vm-continuation
+            %tc7-bytevector
+            %tc7-weak-set
+            %tc7-weak-table
+            %tc7-array
+            %tc7-bitvector
+            %tc7-port
+            %tc7-smob
+            %tc16-bignum
+            %tc16-flonum
+            %tc16-complex
+            %tc16-fraction
+            visit-heap-tags))
+
+;;; Commentary:
+;;;
+;;; Tag values used to represent Scheme values, internally to Guile.
+;;;
+;;; Code:
+
+
+;;;
+;;; Tags---keep in sync with libguile/tags.h!
+;;;
+
+(define-syntax define-tags
+  (lambda (x)
+    (define (id-append ctx a b)
+      (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b))))
+    (syntax-case x ()
+      ((_ tag-set (name pred mask tag) ...)
+       #`(define-syntax #,(id-append #'tag-set #'visit- #'tag-set)
+           (lambda (x)
+             (define (introduce ctx id)
+               (datum->syntax ctx (syntax->datum id)))
+             (syntax-case x ()
+               ((_ f)
+                #`(begin
+                    (f #,(introduce #'f #'name)
+                       #,(introduce #'f #'pred)
+                       mask
+                       tag)
+                    ...)))))))))
+
+(define-tags immediate-tags
+  ;;                                    321076543210    321076543210
+  (fixnum           fixnum?                     #b11            #b10)
+  (heap-object      heap-object?               #b111           #b000)
+  (char             char?                 #b11111111      #b00001100)
+  (false            eq-false?         #b111111111111  #b000000000100)
+  (nil              eq-nil?           #b111111111111  #b000100000100)
+  (null             eq-null?          #b111111111111  #b001100000100)
+  (true             eq-true?          #b111111111111  #b010000000100)
+  (unspecified      unspecified?      #b111111111111  #b100000000100)
+  (undefined        undefined?        #b111111111111  #b100100000100)
+  (eof              eof-object?       #b111111111111  #b101000000100)
+
+  ;;(nil            eq-nil?           #b111111111111  #b000100000100)
+  ;;(eol            eq-null?          #b111111111111  #b001100000100)
+  ;;(false          eq-false?         #b111111111111  #b000000000100)
+  (null+nil         null?             #b110111111111  #b000100000100)
+  (false+nil        false?            #b111011111111  #b000000000100)
+  (null+false+nil   nil?              #b110011111111  #b000000000100))
+
+(define-tags heap-tags
+  ;;                                    321076543210    321076543210
+  (pair             pair?                        #b1             #b0)
+  (struct           struct?                    #b111           #b001)
+  ;; For tc7 values, low bits 2 and 0 must be 1.
+  (symbol           symbol?                #b1111111       #b0000101)
+  (variable         variable?              #b1111111       #b0000111)
+  (vector           vector?                #b1111111       #b0001101)
+  (immutable-vector immutable-vector?     #b11111111      #b10001101)
+  (mutable-vector   mutable-vector?       #b11111111      #b00001101)
+  (weak-vector      weak-vector?           #b1111111       #b0001111)
+  (string           string?                #b1111111       #b0010101)
+  (heap-number      heap-number?           #b1111111       #b0010111)
+  (hash-table       hash-table?            #b1111111       #b0011101)
+  (pointer          pointer?               #b1111111       #b0011111)
+  (fluid            fluid?                 #b1111111       #b0100101)
+  (stringbuf        stringbuf?             #b1111111       #b0100111)
+  (dynamic-state    dynamic-state?         #b1111111       #b0101101)
+  (frame            frame?                 #b1111111       #b0101111)
+  (keyword          keyword?               #b1111111       #b0110101)
+  (atomic-box       atomic-box?            #b1111111       #b0110111)
+  (syntax           syntax?                #b1111111       #b0111101)
+  ;;(unused         unused                 #b1111111       #b0111111)
+  (program          program?               #b1111111       #b1000101)
+  (vm-continuation  vm-continuation?       #b1111111       #b1000111)
+  (bytevector       bytevector?            #b1111111       #b1001101)
+  ;;(unused         unused                 #b1111111       #b1001111)
+  (weak-set         weak-set?              #b1111111       #b1010101)
+  (weak-table       weak-table?            #b1111111       #b1010111)
+  (array            array?                 #b1111111       #b1011101)
+  (bitvector        bitvector?             #b1111111       #b1011111)
+  ;;(unused         unused                 #b1111111       #b1100101)
+  ;;(unused         unused                 #b1111111       #b1100111)
+  ;;(unused         unused                 #b1111111       #b1101101)
+  ;;(unused         unused                 #b1111111       #b1101111)
+  ;;(unused         unused                 #b1111111       #b1110101)
+  (smob             smob?                  #b1111111       #b1110111)
+  (port             port?                  #b1111111       #b1111101)
+  ;;(unused         unused                 #b1111111       #b1111111)
+  
+  ;(heap-number     heap-number?           #b1111111       #b0010111)
+  (bignum           bignum?           #b111111111111  #b000100010111)
+  (flonum           flonum?           #b111111111111  #b001000010111)
+  (complex          compnum?          #b111111111111  #b001100010111)
+  (fraction         fracnum?          #b111111111111  #b010000010111))
+
+(define-syntax define-tag
+  (lambda (x)
+    (define (id-append ctx a b)
+      (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b))))
+    (define (def prefix name tag)
+      #`(define #,(id-append name prefix name) #,tag))
+    (syntax-case x ()
+      ((_ name pred #b1 tag)             (def #'%tc1- #'name #'tag))
+      ((_ name pred #b11 tag)            (def #'%tc2- #'name #'tag))
+      ((_ name pred #b111 tag)           (def #'%tc3- #'name #'tag))
+      ((_ name pred #b1111111 tag)       (def #'%tc7- #'name #'tag))
+      ((_ name pred #b11111111 tag)      (def #'%tc8- #'name #'tag))
+      ;; Only 12 bits of mask but for historic reasons these are called
+      ;; tc16 values.
+      ((_ name pred #b111111111111 tag)  (def #'%tc16- #'name #'tag))
+      ((_ name pred mask tag)
+       #`(begin
+           (define #,(id-append #'name #'name #'-mask) mask)
+           (define #,(id-append #'name #'name #'-tag) tag))))))
+
+(visit-immediate-tags define-tag)
+(visit-heap-tags define-tag)
+
+;; See discussion in tags.h and boolean.h.
+(eval-when (expand)
+  (let ()
+    (visit-immediate-tags define-tag)
+    (define (exactly-one-bit-set? x)
+      (and (not (zero? x)) (zero? (logand x (1- x)))))
+    (define (exactly-two-bits-set? x)
+      (exactly-one-bit-set? (logand x (1- x))))
+    (define (bits-differ-in-exactly-one-bit-position? a b)
+      (exactly-one-bit-set? (logxor a b)))
+    (define (bits-differ-in-exactly-two-bit-positions? a b)
+      (exactly-two-bits-set? (logxor a b)))
+    (define (common-bits a b)
+      (values (logand #xfff (lognot (logxor a b))) (logand a b)))
+
+    (unless (bits-differ-in-exactly-one-bit-position? %tc16-null %tc16-nil)
+      (error "expected #nil and '() to differ in exactly one bit position"))
+    (unless (bits-differ-in-exactly-one-bit-position? %tc16-false %tc16-nil)
+      (error "expected #f and '() to differ in exactly one bit position"))
+    (unless (bits-differ-in-exactly-two-bit-positions? %tc16-false %tc16-null)
+      (error "expected #f and '() to differ in exactly two bit positions"))
+    (call-with-values (lambda () (common-bits %tc16-null %tc16-nil))
+      (lambda (mask tag)
+        (unless (= mask null+nil-mask) (error "unexpected mask for null?"))
+        (unless (= tag null+nil-tag) (error "unexpected tag for null?"))))
+    (call-with-values (lambda () (common-bits %tc16-false %tc16-nil))
+      (lambda (mask tag)
+        (unless (= mask false+nil-mask) (error "unexpected mask for false?"))
+        (unless (= tag false+nil-tag) (error "unexpected tag for false?"))))
+    (call-with-values (lambda () (common-bits %tc16-false %tc16-null))
+      (lambda (mask tag)
+        (unless (= mask null+false+nil-mask) (error "unexpected mask for nil?"))
+        (unless (= tag null+false+nil-tag) (error "unexpected tag for nil?"))))))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8d71dc551..c9e9f5f7b 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1,6 +1,6 @@
 ;;; Guile bytecode assembler
 
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009-2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -44,6 +44,7 @@
 
 (define-module (system vm assembler)
   #:use-module (system base target)
+  #:use-module (system base types internal)
   #:use-module (system vm dwarf)
   #:use-module (system vm elf)
   #:use-module (system vm linker)
@@ -63,97 +64,196 @@
             (emit-mov* . emit-mov)
             (emit-fmov* . emit-fmov)
 
+            emit-u64=?
+            emit-u64<?
+            emit-u64-imm<?
+            emit-imm-u64<?
+            emit-s64-imm=?
+            emit-s64<?
+            emit-s64-imm<?
+            emit-imm-s64<?
+            emit-f64=?
+            emit-f64<?
+            emit-=?
+            emit-<?
+            emit-arguments<=?
+            emit-positional-arguments<=?
+            emit-immediate-tag=?
+            emit-heap-tag=?
+            emit-eq?
+            emit-heap-numbers-equal?
+            emit-j
+            emit-jl
+            emit-je
+            emit-jnl
+            emit-jne
+            emit-jge
+            emit-jnge
+
+            emit-fixnum?
+            emit-heap-object?
+            emit-char?
+            emit-eq-null?
+            emit-eq-nil?
+            emit-eq-false?
+            emit-eq-true?
+            emit-unspecified?
+            emit-undefined?
+            emit-eof-object?
+
+            emit-untag-fixnum
+            emit-tag-fixnum
+            emit-untag-char
+            emit-tag-char
+
+            emit-throw
+            (emit-throw/value* . emit-throw/value)
+            (emit-throw/value+data* . emit-throw/value+data)
+
+            emit-pair?
+            emit-struct?
+            emit-symbol?
+            emit-variable?
+            emit-vector?
+            emit-mutable-vector?
+            emit-immutable-vector?
+            emit-weak-vector?
+            emit-string?
+            emit-heap-number?
+            emit-hash-table?
+            emit-pointer?
+            emit-fluid?
+            emit-stringbuf?
+            emit-dynamic-state?
+            emit-frame?
+            emit-keyword?
+            emit-syntax?
+            emit-program?
+            emit-vm-continuation?
+            emit-bytevector?
+            emit-weak-set?
+            emit-weak-table?
+            emit-array?
+            emit-bitvector?
+            emit-port?
+            emit-smob?
+            emit-bignum?
+            emit-flonum?
+            emit-compnum?
+            emit-fracnum?
+
+            emit-allocate-words
+            emit-allocate-words/immediate
+
+            emit-scm-ref
+            emit-scm-set!
+            emit-scm-ref/tag
+            emit-scm-set!/tag
+            emit-scm-ref/immediate
+            emit-scm-set!/immediate
+
+            emit-word-ref
+            emit-word-set!
+            emit-word-ref/immediate
+            emit-word-set!/immediate
+
+            emit-pointer-ref/immediate
+            emit-pointer-set!/immediate
+            emit-tail-pointer-ref/immediate
+
+            emit-u8-ref
+            emit-s8-ref
+            emit-u16-ref
+            emit-s16-ref
+            emit-u32-ref
+            emit-s32-ref
+            emit-u64-ref
+            emit-s64-ref
+            emit-f32-ref
+            emit-f64-ref
+            emit-u8-set!
+            emit-s8-set!
+            emit-u16-set!
+            emit-s16-set!
+            emit-u32-set!
+            emit-s32-set!
+            emit-u64-set!
+            emit-s64-set!
+            emit-f32-set!
+            emit-f64-set!
+
+            emit-atomic-scm-ref/immediate
+            emit-atomic-scm-set!/immediate
+            emit-atomic-scm-swap!/immediate
+            emit-atomic-scm-compare-and-swap!/immediate
+
+            ;; Intrinsics.
+            emit-add
+            emit-add/immediate
+            emit-sub
+            emit-sub/immediate
+            emit-mul
+            emit-div
+            emit-quo
+            emit-rem
+            emit-mod
+            emit-logand
+            emit-logior
+            emit-logxor
+            emit-logsub
+            emit-string-set!
+            emit-string->number
+            emit-string->symbol
+            emit-symbol->keyword
+            emit-class-of
+            emit-scm->f64
+            emit-scm->u64
+            emit-scm->u64/truncate
+            emit-scm->s64
+            emit-u64->scm
+            emit-s64->scm
+            emit-wind
+            emit-unwind
+            emit-push-fluid
+            emit-pop-fluid
+            emit-fluid-ref
+            emit-fluid-set!
+            emit-push-dynamic-state
+            emit-pop-dynamic-state
+            emit-lsh
+            emit-rsh
+            emit-lsh/immediate
+            emit-rsh/immediate
+            emit-resolve-module
+            emit-lookup
+            emit-define!
+            emit-current-module
+
+            emit-cache-ref
+            emit-cache-set!
+
             emit-call
             emit-call-label
             emit-tail-call
             emit-tail-call-label
+            (emit-instrument-entry* . emit-instrument-entry)
+            (emit-instrument-loop* . emit-instrument-loop)
             emit-receive-values
-            emit-return
             emit-return-values
             emit-call/cc
             emit-abort
             emit-builtin-ref
-            emit-br-if-nargs-ne
-            emit-br-if-nargs-lt
-            emit-br-if-nargs-gt
             emit-assert-nargs-ee
             emit-assert-nargs-ge
             emit-assert-nargs-le
-            emit-alloc-frame
             emit-reset-frame
             emit-assert-nargs-ee/locals
-            emit-br-if-npos-gt
             emit-bind-kwargs
             emit-bind-rest
-            emit-br
-            emit-br-if-true
-            emit-br-if-null
-            emit-br-if-nil
-            emit-br-if-pair
-            emit-br-if-struct
-            emit-br-if-char
-            emit-br-if-tc7
-            emit-br-if-eq
-            emit-br-if-eqv
-            emit-br-if-=
-            emit-br-if-<
-            emit-br-if-<=
-            emit-br-if-logtest
-            emit-br-if-u64-=
-            emit-br-if-u64-<
-            emit-br-if-u64-<=
-            emit-br-if-u64-<-scm
-            emit-br-if-u64-<=-scm
-            emit-br-if-u64-=-scm
-            emit-br-if-u64->=-scm
-            emit-br-if-u64->-scm
-            emit-br-if-f64-=
-            emit-br-if-f64-<
-            emit-br-if-f64-<=
-            emit-br-if-f64->
-            emit-br-if-f64->=
-            emit-box
-            emit-box-ref
-            emit-box-set!
-            emit-make-closure
-            emit-free-ref
-            emit-free-set!
-            emit-current-module
+            emit-load-label
             emit-resolve
-            emit-define!
-            emit-toplevel-box
-            emit-module-box
             emit-prompt
-            emit-wind
-            emit-unwind
-            emit-push-fluid
-            emit-pop-fluid
-            emit-push-dynamic-state
-            emit-pop-dynamic-state
             emit-current-thread
-            emit-fluid-ref
-            emit-fluid-set!
-            emit-string-length
-            emit-string-ref
-            emit-string-set!
-            emit-string->number
-            emit-string->symbol
-            emit-symbol->keyword
-            emit-cons
-            emit-car
-            emit-cdr
-            emit-set-car!
-            emit-set-cdr!
-            emit-add
-            emit-add/immediate
-            emit-sub
-            emit-sub/immediate
-            emit-mul
-            emit-div
-            emit-quo
-            emit-rem
-            emit-mod
-            emit-ash
             emit-fadd
             emit-fsub
             emit-fmul
@@ -164,72 +264,20 @@
             emit-uadd/immediate
             emit-usub/immediate
             emit-umul/immediate
-            emit-logand
-            emit-logior
-            emit-logxor
-            emit-logsub
             emit-ulogand
             emit-ulogior
             emit-ulogxor
             emit-ulogsub
             emit-ursh
+            emit-srsh
             emit-ulsh
             emit-ursh/immediate
+            emit-srsh/immediate
             emit-ulsh/immediate
-            emit-char->integer
-            emit-integer->char
-            emit-make-vector
-            emit-make-vector/immediate
-            emit-vector-length
-            emit-vector-ref
-            emit-vector-ref/immediate
-            emit-vector-set!
-            emit-vector-set!/immediate
-            emit-struct-vtable
-            emit-allocate-struct/immediate
-            emit-struct-ref/immediate
-            emit-struct-set!/immediate
-            emit-allocate-struct
-            emit-struct-ref
-            emit-struct-set!
-            emit-class-of
             emit-make-array
-            emit-scm->f64
             emit-load-f64
-            emit-f64->scm
-            emit-scm->u64
-            emit-scm->u64/truncate
             emit-load-u64
-            emit-u64->scm
-            emit-scm->s64
             emit-load-s64
-            emit-s64->scm
-            emit-bv-length
-            emit-bv-u8-ref
-            emit-bv-s8-ref
-            emit-bv-u16-ref
-            emit-bv-s16-ref
-            emit-bv-u32-ref
-            emit-bv-s32-ref
-            emit-bv-u64-ref
-            emit-bv-s64-ref
-            emit-bv-f32-ref
-            emit-bv-f64-ref
-            emit-bv-u8-set!
-            emit-bv-s8-set!
-            emit-bv-u16-set!
-            emit-bv-s16-set!
-            emit-bv-u32-set!
-            emit-bv-s32-set!
-            emit-bv-u64-set!
-            emit-bv-s64-set!
-            emit-bv-f32-set!
-            emit-bv-f64-set!
-            emit-make-atomic-box
-            emit-atomic-box-ref
-            emit-atomic-box-set!
-            emit-atomic-box-swap!
-            emit-atomic-box-compare-and-swap!
             emit-handle-interrupts
 
             emit-text
@@ -255,10 +303,9 @@
 ;;; These helpers create one 32-bit unit from multiple components.
 
 (define-inline (check-urange x mask)
-  (let ((x* (logand x mask)))
-    (unless (= x x*)
-      (error "out of range" x))
-    x*))
+  (unless (and (exact-integer? x) (= x (logand x mask)))
+    (error "out of range" x))
+  x)
 
 (define-inline (check-srange x mask)
   (let ((x* (logand x mask)))
@@ -278,6 +325,11 @@
         (y (check-srange y #xffffff)))
     (logior x (ash y 8))))
 
+(define-inline (pack-u16-u16 x y)
+  (let ((x (check-urange x #xffff))
+        (y (check-urange y #xffff)))
+    (logior x (ash y 16))))
+
 (define-inline (pack-u1-u7-u24 x y z)
   (let ((x (check-urange x #x1))
         (y (check-urange y #x7f))
@@ -290,6 +342,12 @@
         (z (check-urange z #xfff)))
     (logior x (ash y 8) (ash z 20))))
 
+(define-inline (pack-u8-u12-s12 x y z)
+  (let ((x (check-urange x #xff))
+        (y (check-urange y #xfff))
+        (z (check-srange z #xfff)))
+    (logior x (ash y 8) (ash z 20))))
+
 (define-inline (pack-u8-u8-u16 x y z)
   (let ((x (check-urange x #xff))
         (y (check-urange y #xff))
@@ -340,19 +398,26 @@ N-byte unit."
       (unless (match x (pattern #t) (_ #f))
         (error (string-append "expected " kind) x)))))
 
+(define-record-type <jit-data>
+  (make-jit-data low-pc high-pc)
+  jit-data?
+  (low-pc jit-data-low-pc)
+  (high-pc jit-data-high-pc))
+
 (define-record-type <meta>
-  (%make-meta label properties low-pc high-pc arities)
+  (%make-meta label properties low-pc high-pc arities jit-data-label)
   meta?
   (label meta-label)
   (properties meta-properties set-meta-properties!)
   (low-pc meta-low-pc)
   (high-pc meta-high-pc set-meta-high-pc!)
-  (arities meta-arities set-meta-arities!))
+  (arities meta-arities set-meta-arities!)
+  (jit-data-label meta-jit-data-label))
 
 (define (make-meta label properties low-pc)
   (assert-match label (or (? exact-integer?) (? symbol?)) "symbol")
   (assert-match properties (((? symbol?) . _) ...) "alist with symbolic keys")
-  (%make-meta label properties low-pc #f '()))
+  (%make-meta label properties low-pc #f '() (gensym "jit-data")))
 
 (define (meta-name meta)
   (assq-ref (meta-properties meta) 'name))
@@ -411,7 +476,7 @@ N-byte unit."
   (labels asm-labels set-asm-labels!)
 
   ;; A list of relocations needed by the program text.  We use an
-  ;; internal representation for relocations, and handle textualn
+  ;; internal representation for relocations, and handle textual
   ;; relative relocations in the assembler.  Other kinds of relocations
   ;; are later reified as linker relocations and resolved by the linker.
   ;;
@@ -566,6 +631,8 @@ later by the linker."
             (emit asm (pack-u8-u12-u12 opcode a b)))
            ((X8_S12_C12 a b)
             (emit asm (pack-u8-u12-u12 opcode a b)))
+           ((X8_S12_Z12 a b)
+            (emit asm (pack-u8-u12-s12 opcode a b)))
            ((X8_C12_C12 a b)
             (emit asm (pack-u8-u12-u12 opcode a b)))
            ((X8_F12_F12 a b)
@@ -621,6 +688,10 @@ later by the linker."
           (emit asm 0))
          ((C8_C24 a b)
           (emit asm (pack-u8-u24 a b)))
+         ((C8_S24 a b)
+          (emit asm (pack-u8-u24 a b)))
+         ((C16_C16 a b)
+          (emit asm (pack-u16-u16 a b)))
          ((B1_X7_L24 a label)
           (record-label-reference asm label)
           (emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
@@ -733,23 +804,14 @@ later by the linker."
     (emit-push asm a)
     (encode-X8_S12_S12 asm 0 0 opcode)
     (emit-pop asm dst))))
-(define (encode-X8_S12_S12-X8_C24!/shuffle asm a b c opcode)
-  (cond
-   ((< (logior a b) (ash 1 12))
-    (encode-X8_S12_S12-X8_C24 asm a b c opcode))
-   (else
-    (emit-push asm a)
-    (emit-push asm (1+ b))
-    (encode-X8_S12_S12-X8_C24 asm 1 0 c opcode)
-    (emit-drop asm 2))))
-(define (encode-X8_S12_S12-X8_C24<-/shuffle asm dst a const opcode)
+(define (encode-X8_S12_C12!/shuffle asm a const opcode)
   (cond
-   ((< (logior dst a) (ash 1 12))
-    (encode-X8_S12_S12-X8_C24 asm dst a const opcode))
+   ((< a (ash 1 12))
+    (encode-X8_S12_C12 asm a const opcode))
    (else
     (emit-push asm a)
-    (encode-X8_S12_S12-X8_C24 asm 0 0 const opcode)
-    (emit-pop asm dst))))
+    (encode-X8_S12_C12 asm 0 const opcode)
+    (emit-drop asm 1))))
 (define (encode-X8_S12_C12<-/shuffle asm dst const opcode)
   (cond
    ((< dst (ash 1 12))
@@ -759,6 +821,14 @@ later by the linker."
     (emit-push asm dst)
     (encode-X8_S12_C12 asm 0 const opcode)
     (emit-pop asm dst))))
+(define (encode-X8_S12_Z12!/shuffle asm a const opcode)
+  (cond
+   ((< a (ash 1 12))
+    (encode-X8_S12_Z12 asm a const opcode))
+   (else
+    (emit-push asm a)
+    (encode-X8_S12_Z12 asm 0 const opcode)
+    (emit-drop asm 1))))
 (define (encode-X8_S8_I16<-/shuffle asm dst imm opcode)
   (cond
    ((< dst (ash 1 8))
@@ -813,6 +883,51 @@ later by the linker."
     (emit-push asm a)
     (encode-X8_S8_C8_S8 asm 0 const 0 opcode)
     (emit-pop asm dst))))
+(define (encode-X8_S8_S8_S8-C32<-/shuffle asm dst a b c32 opcode)
+  (cond
+   ((< (logior dst a b) (ash 1 8))
+    (encode-X8_S8_S8_S8-C32 asm dst a b c32 opcode))
+   (else
+    (emit-push asm a)
+    (emit-push asm (1+ b))
+    (encode-X8_S8_S8_S8-C32 asm 1 1 0 c32 opcode)
+    (emit-drop asm 1)
+    (emit-pop asm dst))))
+(define (encode-X8_S8_S8_C8-C32<-/shuffle asm dst a const c32 opcode)
+  (cond
+   ((< (logior dst a) (ash 1 8))
+    (encode-X8_S8_S8_C8-C32 asm dst a const c32 opcode))
+   (else
+    (emit-push asm a)
+    (encode-X8_S8_S8_C8-C32 asm 0 0 const c32 opcode)
+    (emit-pop asm dst))))
+(define (encode-X8_S8_S8_S8-C32!/shuffle asm a b c c32 opcode)
+  (cond
+   ((< (logior a b c) (ash 1 8))
+    (encode-X8_S8_S8_S8-C32 asm a b c c32 opcode))
+   (else
+    (emit-push asm a)
+    (emit-push asm (+ b 1))
+    (emit-push asm (+ c 2))
+    (encode-X8_S8_S8_S8-C32 asm 2 1 0 c32 opcode)
+    (emit-drop asm 3))))
+(define (encode-X8_S12_S12-C32<-/shuffle asm dst src c32 opcode)
+  (cond
+   ((< (logior dst src) (ash 1 12))
+    (encode-X8_S12_S12-C32 asm dst src c32 opcode))
+   (else
+    (emit-push asm src)
+    (encode-X8_S12_S12-C32 asm 0 0 c32 opcode)
+    (emit-pop asm dst))))
+(define (encode-X8_S12_S12-C32!/shuffle asm a b c32 opcode)
+  (cond
+   ((< (logior a b) (ash 1 12))
+    (encode-X8_S12_S12-C32 asm a b c32 opcode))
+   (else
+    (emit-push asm a)
+    (emit-push asm b)
+    (encode-X8_S12_S12-C32 asm 1 0 c32 opcode)
+    (emit-drop asm 2))))
 
 (eval-when (expand)
   (define (id-append ctx a b)
@@ -824,11 +939,18 @@ later by the linker."
       (('<- 'X8_S12_S12)         #'encode-X8_S12_S12<-/shuffle)
       (('! 'X8_S12_S12 'X8_C24)  #'encode-X8_S12_S12-X8_C24!/shuffle)
       (('<- 'X8_S12_S12 'X8_C24) #'encode-X8_S12_S12-X8_C24<-/shuffle)
+      (('! 'X8_S12_C12)          #'encode-X8_S12_C12!/shuffle)
       (('<- 'X8_S12_C12)         #'encode-X8_S12_C12<-/shuffle)
+      (('! 'X8_S12_Z12)          #'encode-X8_S12_Z12!/shuffle)
       (('<- 'X8_S8_I16)          #'encode-X8_S8_I16<-/shuffle)
       (('! 'X8_S8_S8_S8)         #'encode-X8_S8_S8_S8!/shuffle)
       (('<- 'X8_S8_S8_S8)        #'encode-X8_S8_S8_S8<-/shuffle)
       (('<- 'X8_S8_S8_C8)        #'encode-X8_S8_S8_C8<-/shuffle)
+      (('<- 'X8_S8_S8_S8 'C32)   #'encode-X8_S8_S8_S8-C32<-/shuffle)
+      (('<- 'X8_S8_S8_C8 'C32)   #'encode-X8_S8_S8_C8-C32<-/shuffle)
+      (('! 'X8_S8_S8_C8 'C32)    #'encode-X8_S8_S8_C8-C32!/shuffle)
+      (('<- 'X8_S12_S12 'C32)    #'encode-X8_S12_S12-C32<-/shuffle)
+      (('! 'X8_S12_S12 'C32)     #'encode-X8_S12_S12-C32!/shuffle)
       (('! 'X8_S8_C8_S8)         #'encode-X8_S8_C8_S8!/shuffle)
       (('<- 'X8_S8_C8_S8)        #'encode-X8_S8_C8_S8<-/shuffle)
       (else (encoder-name operands))))
@@ -852,6 +974,8 @@ later by the linker."
           ('L32 #'(label))
           ('LO32 #'(label offset))
           ('C8_C24 #'(a b))
+          ('C8_S24 #'(a b))
+          ('C16_C16 #'(a b))
           ('B1_X7_L24 #'(a label))
           ('B1_C7_L24 #'(a b label))
           ('B1_X31 #'(a))
@@ -865,6 +989,7 @@ later by the linker."
           ('X8_S8_I16 #'(a imm))
           ('X8_S12_S12 #'(a b))
           ('X8_S12_C12 #'(a b))
+          ('X8_S12_Z12 #'(a b))
           ('X8_C12_C12 #'(a b))
           ('X8_F12_F12 #'(a b))
           ('X8_S8_S8_S8 #'(a b c))
@@ -928,6 +1053,20 @@ later by the linker."
         (emit-fmov* asm dst (1+ proc))
         (emit-reset-frame asm nlocals))))
 
+(define (emit-throw/value* asm val param)
+  (emit-throw/value asm val (intern-non-immediate asm param)))
+
+(define (emit-throw/value+data* asm val param)
+  (emit-throw/value+data asm val (intern-non-immediate asm param)))
+
+(define (emit-instrument-entry* asm)
+  (let ((meta (car (asm-meta asm))))
+    (emit-instrument-entry asm (meta-jit-data-label meta))))
+
+(define (emit-instrument-loop* asm)
+  (let ((meta (car (asm-meta asm))))
+    (emit-instrument-loop asm (meta-jit-data-label meta))))
+
 (define (emit-text asm instructions)
   "Assemble @var{instructions} using the assembler @var{asm}.
 @var{instructions} is a sequence of instructions, expressed as a list of
@@ -998,9 +1137,8 @@ immediate, and @code{#f} otherwise."
   (element-size uniform-vector-backing-store-element-size))
 
 (define-record-type <cache-cell>
-  (make-cache-cell scope key)
+  (make-cache-cell key)
   cache-cell?
-  (scope cache-cell-scope)
   (key cache-cell-key))
 
 (define (simple-vector? obj)
@@ -1109,16 +1247,11 @@ label."
     (error "expected a non-immediate" obj))
   (intern-constant asm obj))
 
-(define (intern-cache-cell asm scope key)
+(define (intern-cache-cell asm key)
   "Intern a cache cell into the constant table, and return its label.
 If there is already a cache cell with the given scope and key, it is
 returned instead."
-  (intern-constant asm (make-cache-cell scope key)))
-
-;; Return the label of the cell that holds the module for a scope.
-(define (intern-module-cache-cell asm scope)
-  "Intern a cache cell for a module, and return its label."
-  (intern-cache-cell asm scope #t))
+  (intern-constant asm (make-cache-cell key)))
 
 
 
@@ -1161,60 +1294,133 @@ returned instead."
   (let ((loc (intern-constant asm (make-static-procedure label))))
     (emit-make-non-immediate asm dst loc)))
 
-(define-syntax-rule (define-tc7-macro-assembler name tc7)
-  (define-macro-assembler (name asm slot invert? label)
-    (emit-br-if-tc7 asm slot invert? tc7 label)))
-
-;; Keep in sync with tags.h.  Part of Guile's ABI.  Currently unused
-;; macro assemblers are commented out.  See also
-;; *branching-primcall-arities* in (language cps primitives), the set of
-;; macro-instructions in assembly.scm, and
-;; disassembler.scm:code-annotation.
-;;
-;; FIXME: Define all tc7 values in Scheme in one place, derived from
-;; tags.h.
-(define-tc7-macro-assembler br-if-symbol #x05)
-(define-tc7-macro-assembler br-if-variable #x07)
-(define-tc7-macro-assembler br-if-vector #x0d)
-;(define-tc7-macro-assembler br-if-weak-vector 13)
-(define-tc7-macro-assembler br-if-string #x15)
-;(define-tc7-macro-assembler br-if-heap-number 23)
-;(define-tc7-macro-assembler br-if-stringbuf 39)
-(define-tc7-macro-assembler br-if-bytevector #x4d)
-;(define-tc7-macro-assembler br-if-pointer 31)
-;(define-tc7-macro-assembler br-if-hashtable 29)
-;(define-tc7-macro-assembler br-if-fluid 37)
-;(define-tc7-macro-assembler br-if-dynamic-state 45)
-;(define-tc7-macro-assembler br-if-frame 47)
-(define-tc7-macro-assembler br-if-keyword #x35)
-;(define-tc7-macro-assembler br-if-syntax #x3d)
-;(define-tc7-macro-assembler br-if-vm 55)
-;(define-tc7-macro-assembler br-if-vm-cont 71)
-;(define-tc7-macro-assembler br-if-rtl-program 69)
-;(define-tc7-macro-assembler br-if-weak-set 85)
-;(define-tc7-macro-assembler br-if-weak-table 87)
-;(define-tc7-macro-assembler br-if-array 93)
-(define-tc7-macro-assembler br-if-bitvector #x5f)
-;(define-tc7-macro-assembler br-if-port 125)
-;(define-tc7-macro-assembler br-if-smob 127)
+(define-syntax-rule (define-immediate-tag=?-macro-assembler name pred mask tag)
+  (define-macro-assembler (pred asm slot)
+    (emit-immediate-tag=? asm slot mask tag)))
+
+(visit-immediate-tags define-immediate-tag=?-macro-assembler)
+
+(define-syntax-rule (define-heap-tag=?-macro-assembler name pred mask tag)
+  (define-macro-assembler (pred asm slot)
+    (emit-heap-tag=? asm slot mask tag)))
+
+(visit-heap-tags define-heap-tag=?-macro-assembler)
+
+(define-syntax-rule (define-scm<-scm-scm-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (emit-call-scm<-scm-scm asm dst a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scm-uimm-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm-sz-u32-intrinsic name)
+  (define-macro-assembler (name asm a b c)
+    (emit-call-scm-sz-u32 asm a b c (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-scm<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-f64<-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-f64<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-u64<-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-u64<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-s64<-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-s64<-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-u64-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-scm<-u64 asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-s64-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-scm<-s64 asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-thread-intrinsic name)
+  (define-macro-assembler (name asm)
+    (emit-call-thread asm (intrinsic-name->index 'name))))
+(define-syntax-rule (define-thread-scm-intrinsic name)
+  (define-macro-assembler (name asm a)
+    (emit-call-thread-scm asm a (intrinsic-name->index 'name))))
+(define-syntax-rule (define-thread-scm-scm-intrinsic name)
+  (define-macro-assembler (name asm a b)
+    (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-thread-scm-intrinsic name)
+  (define-macro-assembler (name asm dst src)
+    (emit-call-scm<-thread-scm asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scm-u64-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (emit-call-scm<-scm-u64 asm dst a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scm-bool-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (emit-call-scm<-scm-uimm asm dst a (if b 1 0) (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-thread-intrinsic name)
+  (define-macro-assembler (name asm dst)
+    (emit-call-scm<-thread asm dst (intrinsic-name->index 'name))))
+
+(define-scm<-scm-scm-intrinsic add)
+(define-scm<-scm-uimm-intrinsic add/immediate)
+(define-scm<-scm-scm-intrinsic sub)
+(define-scm<-scm-uimm-intrinsic sub/immediate)
+(define-scm<-scm-scm-intrinsic mul)
+(define-scm<-scm-scm-intrinsic div)
+(define-scm<-scm-scm-intrinsic quo)
+(define-scm<-scm-scm-intrinsic rem)
+(define-scm<-scm-scm-intrinsic mod)
+(define-scm<-scm-scm-intrinsic logand)
+(define-scm<-scm-scm-intrinsic logior)
+(define-scm<-scm-scm-intrinsic logxor)
+(define-scm<-scm-scm-intrinsic logsub)
+(define-scm-sz-u32-intrinsic string-set!)
+(define-scm<-scm-intrinsic string->number)
+(define-scm<-scm-intrinsic string->symbol)
+(define-scm<-scm-intrinsic symbol->keyword)
+(define-scm<-scm-intrinsic class-of)
+(define-f64<-scm-intrinsic scm->f64)
+(define-u64<-scm-intrinsic scm->u64)
+(define-u64<-scm-intrinsic scm->u64/truncate)
+(define-s64<-scm-intrinsic scm->s64)
+(define-scm<-u64-intrinsic u64->scm)
+(define-scm<-s64-intrinsic s64->scm)
+(define-thread-scm-scm-intrinsic wind)
+(define-thread-intrinsic unwind)
+(define-thread-scm-scm-intrinsic push-fluid)
+(define-thread-intrinsic pop-fluid)
+(define-scm<-thread-scm-intrinsic fluid-ref)
+(define-thread-scm-scm-intrinsic fluid-set!)
+(define-thread-scm-intrinsic push-dynamic-state)
+(define-thread-intrinsic pop-dynamic-state)
+(define-scm<-scm-u64-intrinsic lsh)
+(define-scm<-scm-u64-intrinsic rsh)
+(define-scm<-scm-uimm-intrinsic lsh/immediate)
+(define-scm<-scm-uimm-intrinsic rsh/immediate)
+(define-scm<-scm-bool-intrinsic resolve-module)
+(define-scm<-scm-scm-intrinsic lookup)
+(define-scm<-scm-scm-intrinsic define!)
+(define-scm<-thread-intrinsic current-module)
 
 (define-macro-assembler (begin-program asm label properties)
   (emit-label asm label)
   (let ((meta (make-meta label properties (asm-start asm))))
-    (set-asm-meta! asm (cons meta (asm-meta asm)))))
+    (set-asm-meta! asm (cons meta (asm-meta asm))))
+  (emit-instrument-entry* asm))
 
 (define-macro-assembler (end-program asm)
   (let ((meta (car (asm-meta asm))))
     (set-meta-high-pc! meta (asm-start asm))
-    (set-meta-arities! meta (reverse (meta-arities meta)))))
-
-(define-macro-assembler (begin-standard-arity asm req nlocals alternate)
-  (emit-begin-opt-arity asm req '() #f nlocals alternate))
-
-(define-macro-assembler (begin-opt-arity asm req opt rest nlocals alternate)
-  (emit-begin-kw-arity asm req opt rest '() #f nlocals alternate))
-
-(define-macro-assembler (begin-kw-arity asm req opt rest kw-indices
+    (set-meta-arities! meta (reverse (meta-arities meta)))
+    (set-asm-constants!
+     asm
+     (vhash-cons (make-jit-data (meta-low-pc meta) (meta-high-pc meta))
+                 (meta-jit-data-label meta)
+                 (asm-constants asm)))))
+
+(define-macro-assembler (begin-standard-arity asm has-closure? req nlocals
+                                              alternate)
+  (emit-begin-opt-arity asm has-closure? req '() #f nlocals alternate))
+
+(define-macro-assembler (begin-opt-arity asm has-closure? req opt rest nlocals
+                                         alternate)
+  (emit-begin-kw-arity asm has-closure? req opt rest '() #f nlocals alternate))
+
+(define-macro-assembler (begin-kw-arity asm has-closure? req opt rest kw-indices
                                         allow-other-keys? nlocals alternate)
   (assert-match req ((? symbol?) ...) "list of symbols")
   (assert-match opt ((? symbol?) ...) "list of symbols")
@@ -1226,11 +1432,17 @@ returned instead."
   (assert-match alternate (or #f (? exact-integer?) (? symbol?)) "#f or symbol")
   (let* ((meta (car (asm-meta asm)))
          (arity (make-arity req opt rest kw-indices allow-other-keys?
-                            (asm-start asm) #f '()))
+                            ;; Include the initial instrument-entry in
+                            ;; the first arity.
+                            (if (null? (meta-arities meta))
+                                (meta-low-pc meta)
+                                (asm-start asm))
+                            #f '()))
          ;; The procedure itself is in slot 0, in the standard calling
          ;; convention.  For procedure prologues, nreq includes the
          ;; procedure, so here we add 1.
-         (nreq (1+ (length req)))
+         (nclosure (if has-closure? 1 0))
+         (nreq (+ nclosure (length req)))
          (nopt (length opt))
          (rest? (->bool rest)))
     (set-meta-arities! meta (cons arity (meta-arities meta)))
@@ -1251,7 +1463,8 @@ returned instead."
 (define-macro-assembler (standard-prelude asm nreq nlocals alternate)
   (cond
    (alternate
-    (emit-br-if-nargs-ne asm nreq alternate)
+    (emit-arguments<=? asm nreq)
+    (emit-jne asm alternate)
     (emit-alloc-frame asm nlocals))
    ((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
     (emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
@@ -1261,24 +1474,39 @@ returned instead."
 
 (define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
   (if alternate
-      (emit-br-if-nargs-lt asm nreq alternate)
+      (begin
+        (emit-arguments<=? asm nreq)
+        (emit-jl asm alternate))
       (emit-assert-nargs-ge asm nreq))
   (cond
    (rest?
+    (unless (zero? nopt)
+      (emit-bind-optionals asm (+ nreq nopt)))
     (emit-bind-rest asm (+ nreq nopt)))
    (alternate
-    (emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
+    (emit-arguments<=? asm (+ nreq nopt))
+    ;; The arguments<=? instruction sets NONE to indicate greater-than,
+    ;; whereas for <, NONE usually indicates greater-than-or-equal,
+    ;; hence the name jge.  Perhaps we just need to rename jge to
+    ;; br-if-none.
+    (emit-jge asm alternate)
+    (unless (zero? nopt)
+      (emit-bind-optionals asm (+ nreq nopt))))
    (else
-    (emit-assert-nargs-le asm (+ nreq nopt))))
+    (emit-assert-nargs-le asm (+ nreq nopt))
+    (unless (zero? nopt)
+      (emit-bind-optionals asm (+ nreq nopt)))))
   (emit-alloc-frame asm nlocals))
 
 (define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices
                                     allow-other-keys? nlocals alternate)
   (if alternate
       (begin
-        (emit-br-if-nargs-lt asm nreq alternate)
+        (emit-arguments<=? asm nreq)
+        (emit-jl asm alternate)
         (unless rest?
-          (emit-br-if-npos-gt asm nreq (+ nreq nopt) alternate)))
+          (emit-positional-arguments<=? asm nreq (+ nreq nopt))
+          (emit-jge asm alternate)))
       (emit-assert-nargs-ge asm nreq))
   (let ((ntotal (fold (lambda (kw ntotal)
                         (match kw
@@ -1305,22 +1533,11 @@ returned instead."
                       (- (asm-start asm) (arity-low-pc arity)))))
     (set-arity-definitions! arity (cons def (arity-definitions arity)))))
 
-(define-macro-assembler (cache-current-module! asm module scope)
-  (let ((mod-label (intern-module-cache-cell asm scope)))
-    (emit-static-set! asm module mod-label 0)))
+(define-macro-assembler (cache-ref asm dst key)
+  (emit-static-ref asm dst (intern-cache-cell asm key)))
 
-(define-macro-assembler (cached-toplevel-box asm dst scope sym bound?)
-  (let ((sym-label (intern-non-immediate asm sym))
-        (mod-label (intern-module-cache-cell asm scope))
-        (cell-label (intern-cache-cell asm scope sym)))
-    (emit-toplevel-box asm dst cell-label mod-label sym-label bound?)))
-
-(define-macro-assembler (cached-module-box asm dst module-name sym public? bound?)
-  (let* ((sym-label (intern-non-immediate asm sym))
-         (key (cons public? module-name))
-         (mod-name-label (intern-constant asm key))
-         (cell-label (intern-cache-cell asm key sym)))
-    (emit-module-box asm dst cell-label mod-name-label sym-label bound?)))
+(define-macro-assembler (cache-set! asm key val)
+  (emit-static-set! asm val (intern-cache-cell asm key) 0))
 
 (define-macro-assembler (slot-map asm proc-slot slot-map)
   (unless (zero? slot-map)
@@ -1341,7 +1558,8 @@ corresponding linker symbol for the start of the section."
   (let ((name-idx (intern-section-name! asm (symbol->string name)))
         (index (asm-next-section-number asm)))
     (set-asm-next-section-number! asm (1+ index))
-    (make-linker-object (apply make-elf-section
+    (make-linker-object (symbol->string name)
+                        (apply make-elf-section
                                #:index index
                                #:name name-idx
                                #:size (bytevector-length bv)
@@ -1379,8 +1597,9 @@ a procedure to do that and return its label.  Otherwise return
                       `((begin-program ,label ())
                         (assert-nargs-ee/locals 1 1)
                         ,@(reverse inits)
+                        (reset-frame 1)
                         (load-constant 0 ,*unspecified*)
-                        (return-values 2)
+                        (return-values)
                         (end-program)))
            label))))
 
@@ -1435,6 +1654,11 @@ should be .data or .rodata), and return the resulting linker object.
         (* (1+ (vector-length x)) word-size))
        ((syntax? x)
         (* 4 word-size))
+       ((jit-data? x)
+        (case word-size
+          ((4) (+ word-size (* 4 3)))
+          ((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding.
+          (else (error word-size))))
        ((simple-uniform-vector? x)
         (* 4 word-size))
        ((uniform-vector-backing-store? x)
@@ -1501,6 +1725,10 @@ should be .data or .rodata), and return the resulting linker object.
        ((cache-cell? obj)
         (write-placeholder asm buf pos))
 
+       ((jit-data? obj)
+        ;; Default initialization of 0.
+        (values))
+
        ((string? obj)
         (let ((tag (logior tc7-string string-read-only-flag)))
           (case word-size
@@ -1621,6 +1849,19 @@ should be .data or .rodata), and return the resulting linker object.
        (else
         (error "unrecognized object" obj))))
 
+    (define (add-relocs obj pos relocs)
+      (match obj
+        (($ <jit-data> low-pc high-pc)
+         ;; Patch "start" and "end" fields of "struct jit_data".
+         (cons* (make-linker-reloc 'rel32/1 (+ pos word-size 4)
+                                   (+ low-pc word-size 4)
+                                   '.rtl-text)
+                (make-linker-reloc 'rel32/1 (+ pos word-size 8)
+                                   (+ high-pc word-size 8)
+                                   '.rtl-text)
+                relocs))
+        (_ relocs)))
+
     (cond
      ((vlist-null? data) #f)
      (else
@@ -1628,16 +1869,16 @@ should be .data or .rodata), and return the resulting linker object.
                                      (+ (byte-length k) (align len 8)))
                                    0 data))
              (buf (make-bytevector byte-len 0)))
-        (let lp ((i 0) (pos 0) (symbols '()))
+        (let lp ((i 0) (pos 0) (relocs '()) (symbols '()))
           (if (< i (vlist-length data))
-              (let* ((pair (vlist-ref data i))
-                     (obj (car pair))
-                     (obj-label (cdr pair)))
-                (write buf pos obj)
-                (lp (1+ i)
-                    (align (+ (byte-length obj) pos) 8)
-                    (cons (make-linker-symbol obj-label pos) symbols)))
-              (make-object asm name buf '() symbols
+              (match (vlist-ref data i)
+                ((obj . obj-label)
+                 (write buf pos obj)
+                 (lp (1+ i)
+                     (align (+ (byte-length obj) pos) 8)
+                     (add-relocs obj pos relocs)
+                     (cons (make-linker-symbol obj-label pos) symbols))))
+              (make-object asm name buf relocs symbols
                            #:flags (match name
                                      ('.data (logior SHF_ALLOC SHF_WRITE))
                                      ('.rodata SHF_ALLOC))))))))))
@@ -1661,7 +1902,8 @@ these may be @code{#f}."
                  (lp (1+ i))))))
      ((uniform-vector-backing-store? x) #t)
      (else #f)))
-  (let* ((constants (asm-constants asm))
+  (let* ((init-constants (emit-init-constants asm))
+         (constants (asm-constants asm))
          (len (vlist-length constants)))
     (let lp ((i 0)
              (ro vlist-null)
@@ -1669,11 +1911,12 @@ these may be @code{#f}."
       (if (= i len)
           (values (link-data asm ro '.rodata)
                   (link-data asm rw '.data)
-                  (emit-init-constants asm))
-          (let ((pair (vlist-ref constants i)))
-            (if (shareable? (car pair))
-                (lp (1+ i) (vhash-consq (car pair) (cdr pair) ro) rw)
-                (lp (1+ i) ro (vhash-consq (car pair) (cdr pair) rw))))))))
+                  init-constants)
+          (match (vlist-ref constants i)
+            ((obj . label)
+             (if (shareable? obj)
+                 (lp (1+ i) (vhash-consq obj label ro) rw)
+                 (lp (1+ i) ro (vhash-consq obj label rw)))))))))
 
 
 
@@ -1806,8 +2049,8 @@ needed."
 ;;;
 
 ;; FIXME: Define these somewhere central, shared with C.
-(define *bytecode-major-version* #x0202)
-(define *bytecode-minor-version* (char->integer #\A))
+(define *bytecode-major-version* #x0300)
+(define *bytecode-minor-version* 1)
 
 (define (link-dynamic-section asm text rw rw-init frame-maps)
   "Link the dynamic section for an ELF image with bytecode @var{text},
@@ -2052,8 +2295,9 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                         ((f64) 1)
                         ((u64) 2)
                         ((s64) 3)
+                        ((ptr) 4)
                         (else (error "what!" representation)))))
-             (put-uleb128 names-port (logior (ash slot 2) tag)))
+             (put-uleb128 names-port (logior (ash slot 3) tag)))
            (lp definitions))))))
   (let lp ((metas metas) (pos arities-prefix-len) (relocs '()))
     (match metas
diff --git a/module/system/vm/coverage.scm b/module/system/vm/coverage.scm
index f47e33f58..0d51e261a 100644
--- a/module/system/vm/coverage.scm
+++ b/module/system/vm/coverage.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2013, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -70,17 +70,16 @@ by THUNK."
   ;; VM is different from the current one, continuations will not be
   ;; resumable.
   (call-with-values (lambda ()
-                      (let ((level   (vm-trace-level))
-                            (hook    (vm-next-hook)))
+                      (let ((level   (vm-trace-level)))
                         (dynamic-wind
                           (lambda ()
                             (set-vm-trace-level! (+ level 1))
-                            (add-hook! hook collect!))
+                            (vm-add-next-hook! collect!))
                           (lambda ()
                             (call-with-vm thunk))
                           (lambda ()
                             (set-vm-trace-level! level)
-                            (remove-hook! hook collect!)))))
+                            (vm-remove-next-hook! collect!)))))
     (lambda args
       (apply values (make-coverage-data ip-counts) args))))
 
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 09d076692..c3b27697c 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -1,6 +1,6 @@
 ;;; Guile runtime debug information
 
-;;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2013, 2014, 2015, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -382,12 +382,13 @@ section of the ELF image.  Returns an ELF symbol, or @code{#f}."
              (lambda (def-offset pos)
                (call-with-values (lambda () (read-uleb128 bv pos))
                  (lambda (slot+representation pos)
-                   (let ((slot (ash slot+representation -2))
-                         (representation (case (logand slot+representation #x3)
+                   (let ((slot (ash slot+representation -3))
+                         (representation (case (logand slot+representation #x7)
                                            ((0) 'scm)
                                            ((1) 'f64)
                                            ((2) 'u64)
                                            ((3) 's64)
+                                           ((4) 'ptr)
                                            (else 'unknown))))
                      (cons (vector name def-offset slot representation)
                            (lp pos names)))))))))))
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 4db4a033d..73910fda0 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -1,6 +1,6 @@
 ;;; Guile bytecode disassembler
 
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -24,6 +24,7 @@
   #:use-module (system vm debug)
   #:use-module (system vm program)
   #:use-module (system vm loader)
+  #:use-module (system base types internal)
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 format)
@@ -71,6 +72,11 @@
       s
       (- s (ash 1 24))))
 
+(define (unpack-s12 s)
+  (if (zero? (logand s (ash 1 11)))
+      s
+      (- s (ash 1 12))))
+
 (define (unpack-s32 s)
   (if (zero? (logand s (ash 1 31)))
       s
@@ -96,6 +102,9 @@
             X8_F12_F12)
            #'((logand (ash word -8) #xfff)
               (ash word -20)))
+          ((X8_S12_Z12)
+           #'((logand (ash word -8) #xfff)
+              (unpack-s12 (ash word -20))))
           ((X8_S8_S8_S8
             X8_S8_S8_C8
             X8_S8_C8_S8)
@@ -112,9 +121,12 @@
            #'(word))
           ((N32 R32 L32 LO32)
            #'((unpack-s32 word)))
-          ((C8_C24)
+          ((C8_C24 C8_S24)
            #'((logand word #xff)
               (ash word -8)))
+          ((C16_C16)
+           #'((logand word #xffff)
+              (ash word -16)))
           ((B1_C7_L24)
            #'((not (zero? (logand word #x1)))
               (logand (ash word -1) #x7f)
@@ -177,6 +189,19 @@
 address of that offset."
   (+ (debug-context-base context) (* offset 4)))
 
+(define immediate-tag-annotations '())
+(define-syntax-rule (define-immediate-tag-annotation name pred mask tag)
+  (set! immediate-tag-annotations
+        (cons `((,mask ,tag) ,(symbol->string 'pred)) immediate-tag-annotations)))
+(visit-immediate-tags define-immediate-tag-annotation)
+
+(define heap-tag-annotations '())
+(define-syntax-rule (define-heap-tag-annotation name pred mask tag)
+  (set! heap-tag-annotations
+        (cons `((,mask ,tag) ,(symbol->string 'pred)) heap-tag-annotations)))
+
+(visit-heap-tags define-heap-tag-annotation)
+
 (define (code-annotation code len offset start labels context push-addr!)
   ;; FIXME: Print names for register loads and stores that correspond to
   ;; access to named locals.
@@ -190,32 +215,12 @@ address of that offset."
        (dereference-pointer (make-pointer addr)))))
 
   (match code
-    (((or 'br
-          'br-if-nargs-ne 'br-if-nargs-lt 'br-if-nargs-gt
-          'br-if-true 'br-if-null 'br-if-nil 'br-if-pair 'br-if-struct
-          'br-if-char 'br-if-eq 'br-if-eqv
-          'br-if-= 'br-if-< 'br-if-<= 'br-if-> 'br-if->=
-          'br-if-u64-= 'br-if-u64-< 'br-if-u64-<=
-          'br-if-u64-<-scm 'br-if-u64-<=-scm 'br-if-u64-=-scm
-          'br-if-u64->-scm 'br-if-u64->=-scm
-          'br-if-f64-= 'br-if-f64-< 'br-if-f64-<=
-          'br-if-f64-> 'br-if-f64->=
-          'br-if-logtest) _ ... target)
+    (((or 'j 'je 'jl 'jge 'jne 'jnl 'jnge) target)
      (list "-> ~A" (vector-ref labels (- (+ offset target) start))))
-    (('br-if-tc7 slot invert? tc7 target)
-     (list "~A -> ~A"
-           (let ((tag (case tc7
-                        ((5) "symbol?")
-                        ((7) "variable?")
-                        ((13) "vector?")
-                        ((15) "string?")
-                        ((53) "keyword?")
-                        ((#x3d) "syntax?")
-                        ((77) "bytevector?")
-                        ((95) "bitvector?")
-                        (else (number->string tc7)))))
-             (if invert? (string-append "not " tag) tag))
-           (vector-ref labels (- (+ offset target) start))))
+    (('immediate-tag=? _ mask tag)
+     (assoc-ref immediate-tag-annotations (list mask tag)))
+    (('heap-tag=? _ mask tag)
+     (assoc-ref heap-tag-annotations (list mask tag)))
     (('prompt tag escape-only? proc-slot handler)
      ;; The H is for handler.
      (list "H -> ~A" (vector-ref labels (- (+ offset handler) start))))
@@ -226,18 +231,14 @@ address of that offset."
     (('assert-nargs-ee/locals nargs locals)
      ;; The nargs includes the procedure.
      (list "~a slot~:p (~a arg~:p)" (+ locals nargs) (1- nargs)))
+    (('bind-optionals nargs)
+     (list "~a args~:p" (1- nargs)))
     (('alloc-frame nlocals)
      (list "~a slot~:p" nlocals))
     (('reset-frame nlocals)
      (list "~a slot~:p" nlocals))
-    (('return-values nlocals)
-     (if (zero? nlocals)
-         (list "all values")
-         (list "~a value~:p" (1- nlocals))))
     (('bind-rest dst)
      (list "~a slot~:p" (1+ dst)))
-    (('tail-call nargs proc)
-     (list "~a arg~:p" nargs))
     (('make-closure dst target nfree)
      (let* ((addr (u32-offset->addr (+ offset target) context))
             (pdi (find-program-debug-info addr context))
@@ -245,6 +246,13 @@ address of that offset."
                       "anonymous procedure")))
        (push-addr! addr name)
        (list "~A at #x~X (~A free var~:p)" name addr nfree)))
+    (('load-label dst src)
+     (let* ((addr (u32-offset->addr (+ offset src) context))
+            (pdi (find-program-debug-info addr context))
+            (name (or (and pdi (program-debug-info-name pdi))
+                      "anonymous procedure")))
+       (push-addr! addr name)
+       (list "~A at #x~X" name addr)))
     (('call-label closure nlocals target)
      (let* ((addr (u32-offset->addr (+ offset target) context))
             (pdi (find-program-debug-info addr context))
@@ -252,7 +260,7 @@ address of that offset."
                       "anonymous procedure")))
        (push-addr! addr name)
        (list "~A at #x~X" name addr)))
-    (('tail-call-label nlocals target)
+    (('tail-call-label target)
      (let* ((addr (u32-offset->addr (+ offset target) context))
             (pdi (find-program-debug-info addr context))
             (name (or (and pdi (program-debug-info-name pdi))
@@ -264,22 +272,14 @@ address of that offset."
        (when (program? val)
          (push-addr! (program-code val) val))
        (list "~@Y" val)))
+    (((or 'throw/value 'throw/value+data) dst target)
+     (list "~@Y" (reference-scm target)))
     (('builtin-ref dst idx)
      (list "~A" (builtin-index->name idx)))
     (((or 'static-ref 'static-set!) _ target)
      (list "~@Y" (dereference-scm target)))
-    (((or 'free-ref 'free-set!) _ _ index)
-     (list "free var ~a" index))
     (('resolve-module dst name public)
      (list "~a" (if (zero? public) "private" "public")))
-    (('toplevel-box _ var-offset mod-offset sym-offset bound?)
-     (list "`~A'~A" (dereference-scm sym-offset)
-           (if bound? "" " (maybe unbound)")))
-    (('module-box _ var-offset mod-name-offset sym-offset bound?)
-     (let ((mod-name (reference-scm mod-name-offset)))
-       (list "`(~A ~A ~A)'~A" (if (car mod-name) '@ '@@) (cdr mod-name)
-             (dereference-scm sym-offset)
-             (if bound? "" " (maybe unbound)"))))
     (('load-typed-array dst type shape target len)
      (let ((addr (u32-offset->addr (+ offset target) context)))
        (list "~a bytes from #x~X" len addr)))
@@ -298,14 +298,7 @@ address of that offset."
             (match elt
               ((inst arg ...)
                (case inst
-                 ((br
-                   br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt
-                   br-if-true br-if-null br-if-nil br-if-pair br-if-struct
-                   br-if-char br-if-tc7 br-if-eq br-if-eqv
-                   br-if-= br-if-< br-if-<= br-if-> br-if->= br-if-logtest
-                   br-if-u64-= br-if-u64-< br-if-u64-<=
-                   br-if-u64-<-scm br-if-u64-<=-scm br-if-u64-=-scm
-                   br-if-u64->-scm br-if-u64->=-scm)
+                 ((j je jl jge jne jnl jnge)
                   (match arg
                     ((_ ... target)
                      (add-label! (+ offset target) "L"))))
@@ -413,26 +406,14 @@ address of that offset."
        `(make-closure ,dst
                       ,(u32-offset->addr (+ offset target) context)
                       ,nfree))
+      (('load-label dst src)
+       `(load-label ,dst ,(u32-offset->addr (+ offset src) context)))
       (('make-non-immediate dst target)
        `(make-non-immediate ,dst ,(reference-scm target)))
       (('builtin-ref dst idx)
        `(builtin-ref ,dst ,(builtin-index->name idx)))
       (((or 'static-ref 'static-set!) dst target)
        `(,(car code) ,dst ,(dereference-scm target)))
-      (('toplevel-box dst var-offset mod-offset sym-offset bound?)
-       `(toplevel-box ,dst
-                      ,(dereference-scm var-offset)
-                      ,(dereference-scm mod-offset)
-                      ,(dereference-scm sym-offset)
-                      ,bound?))
-      (('module-box dst var-offset mod-name-offset sym-offset bound?)
-       (let ((mod-name (reference-scm mod-name-offset)))
-         `(module-box ,dst
-                      ,(dereference-scm var-offset)
-                      ,(car mod-name)
-                      ,(cdr mod-name)
-                      ,(dereference-scm sym-offset)
-                      ,bound?)))
       (_ code)))
   (let lp ((offset start) (seed seed))
     (cond
@@ -522,11 +503,11 @@ address of that offset."
 (define (instruction-has-fallthrough? code pos)
   (define non-fallthrough-set
     (static-opcode-set halt
-                       tail-call tail-call-label tail-call/shuffle
+                       throw throw/value throw/value+data
+                       tail-call tail-call-label
                        return-values
                        subr-call foreign-call continuation-call
-                       tail-apply
-                       br))
+                       j))
   (let ((opcode (logand (bytevector-u32-native-ref code pos) #xff)))
     (not (bitvector-ref non-fallthrough-set opcode))))
 
@@ -535,8 +516,7 @@ address of that offset."
     (syntax-case x ()
       ((_ name opcode kind word0 word* ...)
        (let ((symname (syntax->datum #'name)))
-         (if (or (memq symname '(br prompt))
-                 (string-prefix? "br-" (symbol->string symname)))
+         (if (memq symname '(prompt j je jl jge jne jnl jnge))
              (let ((offset (* 4 (length #'(word* ...)))))
                #`(vector-set!
                   jump-parsers
@@ -561,14 +541,14 @@ address of that offset."
     (define (stack-effect-parser name)
       (case name
         ((push)
-         #'(lambda (code pos size) (+ size 1)))
+         #'(lambda (code pos size) (and size (+ size 1))))
         ((pop)
-         #'(lambda (code pos size) (- size 1)))
+         #'(lambda (code pos size) (and size (- size 1))))
         ((drop)
          #'(lambda (code pos size)
              (let ((count (ash (bytevector-u32-native-ref code pos) -8)))
-               (- size count))))
-        ((alloc-frame reset-frame)
+               (and size (- size count)))))
+        ((alloc-frame reset-frame bind-optionals)
          #'(lambda (code pos size)
              (let ((nlocals (ash (bytevector-u32-native-ref code pos) -8)))
                nlocals)))
@@ -591,10 +571,14 @@ address of that offset."
                                   #xfff))
                    (nlocals (ash (bytevector-u32-native-ref code pos) -20)))
                (+ nargs nlocals))))
-        ((call call-label)
-         #'(lambda (code pos size) #f))
-        ((tail-call tail-call-label tail-call/shuffle tail-apply)
+        ((call call-label tail-call tail-call-label expand-apply-argument)
          #'(lambda (code pos size) #f))
+        ((shuffle-down)
+         #'(lambda (code pos size)
+             (let ((from (logand (ash (bytevector-u32-native-ref code pos) -8)
+                                 #xfff))
+                   (to (ash (bytevector-u32-native-ref code pos) -20)))
+               (and size (- size (- from to))))))
         (else
          #f)))
     (syntax-case x ()
@@ -624,10 +608,11 @@ address of that offset."
                                   (lambda ()
                                     (disassemble-one code (/ pos 4)))
                                 (lambda (len elt)
+                                  (define frame-size 3)
                                   (match elt
                                     ((_ proc . _)
-                                     (let lp ((slot (- proc 2)))
-                                       (if (< slot nslots-in)
+                                     (let lp ((slot (- proc frame-size)))
+                                       (if (and nslots-in (< slot nslots-in))
                                            (cons slot (lp (1+ slot)))
                                            '())))))))))
                  (vector-set! clobber-parsers opcode parse)))
@@ -645,7 +630,9 @@ address of that offset."
                                       ((X8_F24 X8_F12_F12)
                                        #'(list dst))
                                       (else
-                                       #'(list (- nslots-out 1 dst)))))))))))
+                                       #'(if nslots-out
+                                             (list (- nslots-out 1 dst))
+                                             '()))))))))))
               (vector-set! clobber-parsers opcode parse)))
          (else (error "unexpected instruction kind" #'kind)))))))
 
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index b699590f6..2b55ce4f6 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM frame functions
 
-;;; Copyright (C) 2001, 2005, 2009-2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2005, 2009-2016, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -37,8 +37,8 @@
             frame-lookup-binding
             binding-ref binding-set!
 
-            frame-instruction-pointer-or-primitive-procedure-name
             frame-call-representation
+            frame-return-values
             frame-environment
             frame-object-binding frame-object-name))
 
@@ -205,9 +205,9 @@
         (for-each (lambda (slot)
                     (when (< slot (vector-length defs-by-slot))
                       (kill-slot! n slot)))
-                  (instruction-slot-clobbers code pos
-                                             (vector-ref in-sizes n)
-                                             (vector-ref out-sizes n)))
+                  (let ((in (vector-ref in-sizes n))
+                        (out (vector-ref out-sizes n)))
+                    (instruction-slot-clobbers code pos in out)))
         (lp (1+ n) (+ pos (vector-ref parsed n)))))
     killv))
 
@@ -325,24 +325,9 @@
 (define* (frame-procedure-name frame #:key
                                (info (find-program-debug-info
                                       (frame-instruction-pointer frame))))
-  (cond
-   (info => program-debug-info-name)
-   ;; We can only try to get the name from the closure if we know that
-   ;; slot 0 corresponds to the frame's procedure.  This isn't possible
-   ;; to know in general.  If the frame has already begun executing and
-   ;; the closure binding is dead, it could have been replaced with any
-   ;; other random value, or an unboxed value.  Even if we're catching
-   ;; the frame at its application, before it has started running, if
-   ;; the callee is well-known and has only one free variable, closure
-   ;; optimization could have chosen to represent its closure as that
-   ;; free variable, and that free variable might be some other program,
-   ;; or even an unboxed value.  It would be an error to try to get the
-   ;; procedure name of some procedure that doesn't correspond to the
-   ;; one being applied.  (Free variables are currently always boxed but
-   ;; that could change in the future.)
-   ((primitive-code? (frame-instruction-pointer frame))
-    (procedure-name (frame-local-ref frame 0 'scm)))
-   (else #f)))
+  (if info
+      (program-debug-info-name info)
+      (primitive-code-name (frame-instruction-pointer frame))))
 
 ;; This function is always called to get some sort of representation of the
 ;; frame to present to the user, so let's do the logical thing and dispatch to
@@ -350,23 +335,12 @@
 (define (frame-arguments frame)
   (cdr (frame-call-representation frame)))
 
-;; Usually the IP is sufficient to identify the procedure being called.
-;; However all primitive applications of the same arity share the same
-;; code.  Perhaps we should change that in the future, but for now we
-;; export this function to avoid having to export frame-local-ref.
-;;
-(define (frame-instruction-pointer-or-primitive-procedure-name frame)
-  (let ((ip (frame-instruction-pointer frame)))
-    (if (primitive-code? ip)
-        (procedure-name (frame-local-ref frame 0 'scm))
-        ip)))
-
 
 ;;;
 ;;; Pretty printing
 ;;;
 
-;; Basically there are two cases to deal with here:
+;; Basically there are three cases to deal with here:
 ;;
 ;;   1. We've already parsed the arguments, and bound them to local
 ;;      variables. In a standard (lambda (a b c) ...) call, this doesn't
@@ -380,6 +354,10 @@
 ;;      number of arguments, or perhaps we're doing a typed dispatch and
 ;;      the types don't match. In that case the arguments are all on the
 ;;      stack, and nothing else is on the stack.
+;;
+;;   3. Alternately it's possible that we're between a primitive call
+;;      and its associated return.  In that case, we won't be able to
+;;      say anything at all.
 
 (define* (frame-call-representation frame #:key top-frame?)
   (let* ((ip (frame-instruction-pointer frame))
diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm
index 80c3dcf9e..ac1da6ecb 100644
--- a/module/system/vm/linker.scm
+++ b/module/system/vm/linker.scm
@@ -79,6 +79,7 @@
 
             make-linker-object
             linker-object?
+            linker-object-name
             linker-object-section
             linker-object-bv
             linker-object-relocs
@@ -133,18 +134,20 @@
   (address linker-symbol-address))
 
 (define-record-type <linker-object>
-  (%make-linker-object section bv relocs symbols)
+  (%make-linker-object name section bv relocs symbols)
   linker-object?
+  (name linker-object-name)
   (section linker-object-section)
   (bv linker-object-bv)
   (relocs linker-object-relocs)
   (symbols linker-object-symbols))
 
-(define (make-linker-object section bv relocs symbols)
-  "Create a linker object with the @code{<elf-section>} header
-@var{section}, bytevector contents @var{bv}, list of linker relocations
-@var{relocs}, and list of linker symbols @var{symbols}."
-  (%make-linker-object section bv relocs
+(define (make-linker-object name section bv relocs symbols)
+  "Create a linker object named @var{name} (a string, or #f for no name),
+@code{<elf-section>} header @var{section}, bytevector contents @var{bv},
+list of linker relocations @var{relocs}, and list of linker symbols
+@var{symbols}."
+  (%make-linker-object name section bv relocs
                        ;; Hide a symbol to the beginning of the section
                        ;; in the symbols.
                        (cons (make-linker-symbol (gensym "*section*") 0)
@@ -396,6 +399,7 @@ the segment table using @code{write-segment-header!}."
                   (addr (align addr (elf-section-addralign section))))
              (values
               (cons (make-linker-object
+                     (linker-object-name o)
                      (relocate-section-header section addr)
                      (linker-object-bv o)
                      (linker-object-relocs o)
@@ -474,13 +478,8 @@ locations, as given in @var{symtab}."
   "Find the section name string table in @var{objects}, and return its
 section index."
   (or-map (lambda (object)
-            (let* ((section (linker-object-section object))
-                   (bv (linker-object-bv object))
-                   (name (elf-section-name section)))
-              (and (= (elf-section-type section) SHT_STRTAB)
-                   (< name (bytevector-length bv))
-                   (string=? (string-table-ref bv name) ".shstrtab")
-                   (elf-section-index section))))
+            (and (equal? (linker-object-name object) ".shstrtab")
+                 (elf-section-index (linker-object-section object))))
           objects))
 
 (define (add-elf-objects objects endianness word-size abi type machine-type)
@@ -513,7 +512,8 @@ list of objects, augmented with objects for the special ELF sections."
   ;; SHT_NULL.
   ;;
   (define (make-null-section)
-    (make-linker-object (make-elf-section #:index 0 #:type SHT_NULL
+    (make-linker-object ""
+                        (make-elf-section #:index 0 #:type SHT_NULL
                                           #:flags 0 #:addralign 0)
                         #vu8() '() '()))
 
@@ -534,7 +534,8 @@ list of objects, augmented with objects for the special ELF sections."
       (write-elf-header bv header)
       ;; Leave the segment table uninitialized; it will be filled in
       ;; later by calls to the write-segment-header! closure.
-      (make-linker-object (make-elf-section #:index index #:type SHT_PROGBITS
+      (make-linker-object #f
+                          (make-elf-section #:index index #:type SHT_PROGBITS
                                             #:flags SHF_ALLOC #:size size)
                           bv
                           (list shoff-reloc)
@@ -580,7 +581,7 @@ list of objects, augmented with objects for the special ELF sections."
                         relocs))
                      objects
                      (write-and-reloc shoff-label section-table '()))))
-        (%make-linker-object section-table bv relocs
+        (%make-linker-object #f section-table bv relocs
                              (list (make-linker-symbol shoff-label 0))))))
 
   (let* ((null-section (make-null-section))
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 32c96f26a..e5dbcc089 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM program functions
 
-;;; Copyright (C) 2001, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2013, 2014, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -44,7 +44,8 @@
 
             print-program
 
-            primitive-code?))
+            primitive-code?
+            primitive-code-name))
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_programs")
@@ -203,7 +204,7 @@ of integers."
         ((nreq nopt rest?)
          (let ((start (primitive-call-ip prog)))
            ;; Assume that there is only one IP for the call.
-           (and (or (not ip) (= start ip))
+           (and (or (not ip) (and start (= start ip)))
                 (arity->arguments-alist
                  prog
                  (list 0 0 nreq nopt rest? '(#f . ()))))))))
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 36fbe92a6..e9f17dae8 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM tracer
 
-;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2009-2010,2012-2014,2018 Free Software Foundation, Inc.
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -48,8 +48,9 @@
             width
             (frame-call-representation frame #:top-frame? #t))))
 
-(define (print-return depth width prefix max-indent values)
-  (let ((prefix (build-prefix prefix depth "|  " "~d< "max-indent)))
+(define (print-return frame depth width prefix max-indent)
+  (let ((prefix (build-prefix prefix depth "|  " "~d< "max-indent))
+        (values (frame-return-values frame)))
     (case (length values)
       ((0)
        (format (current-error-port) "~ano values\n" prefix))
@@ -72,8 +73,8 @@
                                    (max-indent (- width 40)))
   (define (apply-handler frame depth)
     (print-application frame depth width prefix max-indent))
-  (define (return-handler frame depth . values)
-    (print-return depth width prefix max-indent values))
+  (define (return-handler frame depth values)
+    (print-return frame depth width prefix max-indent))
   (trap-calls-to-procedure proc apply-handler return-handler))
 
 (define* (trace-calls-in-procedure proc #:key (width 80)
@@ -81,8 +82,8 @@
                                    (max-indent (- width 40)))
   (define (apply-handler frame depth)
     (print-application frame depth width prefix max-indent))
-  (define (return-handler frame depth . values)
-    (print-return depth width prefix max-indent values))
+  (define (return-handler frame depth)
+    (print-return frame depth width prefix max-indent))
   (trap-calls-in-dynamic-extent proc apply-handler return-handler))
 
 (define* (trace-instructions-in-procedure proc #:key (width 80)
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index 8bee10355..76be8d7d3 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -1,6 +1,6 @@
 ;;; Traps: stepping, breakpoints, and such.
 
-;; Copyright (C)  2010, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
+;; Copyright (C)  2010,2012-2014,2017-2018 Free Software Foundation, Inc.
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -55,7 +55,7 @@
 ;;; Code:
 
 (define-module (system vm traps)
-  #:use-module (system base pmatch)
+  #:use-module (ice-9 match)
   #:use-module (system vm vm)
   #:use-module (system vm debug)
   #:use-module (system vm frame)
@@ -145,9 +145,9 @@
     (new-enabled-trap
      #f
      (lambda (frame)
-       (add-hook! (vm-apply-hook) apply-hook))
+       (vm-add-apply-hook! apply-hook))
      (lambda (frame)
-       (remove-hook! (vm-apply-hook) apply-hook)))))
+       (vm-remove-apply-hook! apply-hook)))))
 
 ;; A more complicated trap, traps when control enters a procedure.
 ;;
@@ -190,13 +190,14 @@
       (if (our-frame? frame)
           (enter-proc frame)))
 
-    (define (pop-cont-hook frame . values)
+    (define (return-hook frame)
       (if in-proc?
           (exit-proc frame))
-      (if (our-frame? frame)
-          (enter-proc frame)))
+      (let ((prev (frame-previous frame)))
+        (if (our-frame? prev)
+            (enter-proc prev))))
 
-    (define (abort-hook frame . values)
+    (define (abort-hook frame)
       (if in-proc?
           (exit-proc frame))
       (if (our-frame? frame)
@@ -205,17 +206,17 @@
     (new-enabled-trap
      current-frame
      (lambda (frame)
-       (add-hook! (vm-apply-hook) apply-hook)
-       (add-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (add-hook! (vm-abort-continuation-hook) abort-hook)
+       (vm-add-apply-hook! apply-hook)
+       (vm-add-return-hook! return-hook)
+       (vm-add-abort-hook! abort-hook)
        (if (and frame (our-frame? frame))
            (enter-proc frame)))
      (lambda (frame)
        (if in-proc?
            (exit-proc frame))
-       (remove-hook! (vm-apply-hook) apply-hook)
-       (remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (remove-hook! (vm-abort-continuation-hook) abort-hook)))))
+       (vm-remove-apply-hook! apply-hook)
+       (vm-remove-return-hook! return-hook)
+       (vm-remove-abort-hook! abort-hook)))))
 
 ;; Building on trap-in-procedure, we have trap-instructions-in-procedure
 ;;
@@ -231,12 +232,12 @@
           (next-handler frame)))
     
     (define (enter frame)
-      (add-hook! (vm-next-hook) next-hook)
+      (vm-add-next-hook! next-hook)
       (if frame (next-hook frame)))
 
     (define (exit frame)
       (exit-handler frame)
-      (remove-hook! (vm-next-hook) next-hook))
+      (vm-remove-next-hook! next-hook))
 
     (trap-in-procedure proc enter exit
                        #:current-frame current-frame
@@ -307,34 +308,31 @@
     (let ((code (program-code proc)))
       (let lp ((sources (program-sources proc))
                (out '()))
-        (if (pair? sources)
-            (lp (cdr sources)
-                (pmatch (car sources)
-                  ((,start-ip ,start-file ,start-line . ,start-col)
-                   (if (equal? start-file file)
-                       (acons start-line
-                              (if (pair? (cdr sources))
-                                  (pmatch (cadr sources)
-                                    ((,end-ip . _)
-                                     (cons (+ start-ip code)
-                                           (+ end-ip code)))
-                                    (else (error "unexpected")))
-                                  (cons (+ start-ip code)
-                                        (program-last-ip proc)))
-                              out)
-                       out))
-                  (else (error "unexpected"))))
-            (let ((alist '()))
-              (for-each
-               (lambda (pair)
-                 (set! alist
-                       (assv-set! alist (car pair)
-                                  (cons (cdr pair)
-                                        (or (assv-ref alist (car pair))
-                                            '())))))
-               out)
-              (sort! alist (lambda (x y) (< (car x) (car y))))
-              alist)))))
+        (match sources
+          (((start-ip start-file start-line . start-col) . sources)
+           (lp sources
+               (if (equal? start-file file)
+                   (acons start-line
+                          (cons (+ start-ip code)
+                                (match sources
+                                  (((end-ip . _) . _)
+                                   (+ end-ip code))
+                                  (()
+                                   (program-last-ip proc))))
+                          out)
+                   out)))
+          (()
+           (let ((alist '()))
+             (for-each
+              (lambda (pair)
+                (set! alist
+                      (assv-set! alist (car pair)
+                                 (cons (cdr pair)
+                                       (or (assv-ref alist (car pair))
+                                           '())))))
+              out)
+             (sort! alist (lambda (x y) (< (car x) (car y))))
+             alist))))))
    (else '())))
 
 (define (source->ip-range proc file line)
@@ -398,29 +396,29 @@
   (arg-check return-handler procedure?)
   (arg-check abort-handler procedure?)
   (let ((fp (frame-address frame)))
-    (define (pop-cont-hook frame . values)
-      (if (and fp (< (frame-address frame) fp))
+    (define (return-hook frame)
+      (if (and fp (<= (frame-address frame) fp))
           (begin
             (set! fp #f)
-            (apply return-handler frame values))))
+            (return-handler frame))))
     
-    (define (abort-hook frame . values)
-      (if (and fp (< (frame-address frame) fp))
+    (define (abort-hook frame)
+      (if (and fp (<= (frame-address frame) fp))
           (begin
             (set! fp #f)
-            (apply abort-handler frame values))))
+            (abort-handler frame))))
     
     (new-enabled-trap
      frame
      (lambda (frame)
        (if (not fp)
            (error "return-or-abort traps may only be enabled once"))
-       (add-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (add-hook! (vm-abort-continuation-hook) abort-hook))
+       (vm-add-return-hook! return-hook)
+       (vm-add-abort-hook! abort-hook))
      (lambda (frame)
        (set! fp #f)
-       (remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (remove-hook! (vm-abort-continuation-hook) abort-hook)))))
+       (vm-remove-return-hook! return-hook)
+       (vm-remove-abort-hook! abort-hook)))))
 
 ;; A more traditional dynamic-wind trap. Perhaps this should not be
 ;; based on the above trap-frame-finish?
@@ -433,12 +431,12 @@
   (arg-check return-handler procedure?)
   (arg-check abort-handler procedure?)
   (let ((exit-trap #f))
-    (define (return-hook frame . values)
+    (define (return-hook frame)
       (exit-trap frame) ; disable the return/abort trap.
       (set! exit-trap #f)
       (return-handler frame))
     
-    (define (abort-hook frame . values)
+    (define (abort-hook frame)
       (exit-trap frame) ; disable the return/abort trap.
       (set! exit-trap #f)
       (abort-handler frame))
@@ -453,12 +451,12 @@
     (new-enabled-trap
      current-frame
      (lambda (frame)
-       (add-hook! (vm-apply-hook) apply-hook))
+       (vm-add-apply-hook! apply-hook))
      (lambda (frame)
        (if exit-trap
            (abort-hook frame))
        (set! exit-trap #f)
-       (remove-hook! (vm-apply-hook) apply-hook)))))
+       (vm-remove-apply-hook! apply-hook)))))
 
 ;; Trapping all procedure calls within a dynamic extent, recording the
 ;; depth of the call stack relative to the original procedure.
@@ -469,28 +467,45 @@
   (arg-check proc procedure?)
   (arg-check apply-handler procedure?)
   (arg-check return-handler procedure?)
-  (let ((*call-depth* 0))
-    (define (trace-push frame)
-      (set! *call-depth* (1+ *call-depth*)))
-  
-    (define (trace-pop frame . values)
-      (apply return-handler frame *call-depth* values)
-      (set! *call-depth* (1- *call-depth*)))
+  (let ((*stack* '()))
+    (define (trace-return frame)
+      (let ((fp* (frame-address frame)))
+        (let lp ((stack *stack*))
+          (match stack
+            (() (values))
+            ((fp . stack)
+             (cond
+              ((> fp fp*)
+               (set! *stack* stack)
+               (lp stack))
+              ((= fp fp*) (set! *stack* stack))
+              ((< fp fp*) (values)))))))
+      (return-handler frame (1+ (length *stack*))))
   
     (define (trace-apply frame)
-      (apply-handler frame *call-depth*))
+      (let ((fp* (frame-address frame)))
+        (define (same-fp? fp) (= fp fp*))
+        (define (newer-fp? fp) (> fp fp*))
+        (let lp ((stack *stack*))
+          (match stack
+            (((? same-fp?) . stack)
+             ;; A tail call, nothing to do.
+             (values))
+            (((? newer-fp?) . stack)
+             ;; Unless there are continuations, we shouldn't get here.
+             (set! *stack* stack)
+             (lp stack))
+            (stack
+             (set! *stack* (cons fp* stack))))))
+      (apply-handler frame (length *stack*)))
   
-    ;; FIXME: recalc depth on abort
-
     (define (enter frame)
-      (add-hook! (vm-push-continuation-hook) trace-push)
-      (add-hook! (vm-pop-continuation-hook) trace-pop)
-      (add-hook! (vm-apply-hook) trace-apply))
+      (vm-add-return-hook! trace-return)
+      (vm-add-apply-hook! trace-apply))
   
     (define (leave frame)
-      (remove-hook! (vm-push-continuation-hook) trace-push)
-      (remove-hook! (vm-pop-continuation-hook) trace-pop)
-      (remove-hook! (vm-apply-hook) trace-apply))
+      (vm-remove-return-hook! trace-return)
+      (vm-remove-apply-hook! trace-apply))
   
     (define (return frame)
       (leave frame))
@@ -514,10 +529,10 @@
       (next-handler frame))
   
     (define (enter frame)
-      (add-hook! (vm-next-hook) trace-next))
+      (vm-add-next-hook! trace-next))
   
     (define (leave frame)
-      (remove-hook! (vm-next-hook) trace-next))
+      (vm-remove-next-hook! trace-next))
   
     (define (return frame)
       (leave frame))
@@ -550,12 +565,12 @@
                       (delq finish-trap pending-finish-traps))
                 (set! finish-trap #f))
               
-              (define (return-hook frame . values)
+              (define (return-hook frame)
                 (frame-finished frame)
-                (apply return-handler frame depth values))
+                (return-handler frame depth))
         
               ;; FIXME: abort handler?
-              (define (abort-hook frame . values)
+              (define (abort-hook frame)
                 (frame-finished frame))
         
               (set! finish-trap
@@ -603,6 +618,6 @@
     (new-enabled-trap
      #f
      (lambda (frame)
-       (add-hook! (vm-next-hook) next-hook))
+       (vm-add-next-hook! next-hook))
      (lambda (frame)
-       (remove-hook! (vm-next-hook) next-hook)))))
+       (vm-remove-next-hook! next-hook)))))
diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 527468414..91b862d20 100644
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM core
 
-;;; Copyright (C) 2001, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2001,2009-2010,2013-2014,2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -23,10 +23,10 @@
             call-with-stack-overflow-handler
             vm-trace-level set-vm-trace-level!
             vm-engine set-vm-engine! set-default-vm-engine!
-            vm-push-continuation-hook vm-pop-continuation-hook
-            vm-apply-hook
-            vm-next-hook
-            vm-abort-continuation-hook))
+            vm-add-apply-hook! vm-add-return-hook!
+            vm-add-next-hook! vm-add-abort-hook!
+            vm-remove-apply-hook! vm-remove-return-hook!
+            vm-remove-next-hook! vm-remove-abort-hook!))
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_vm")
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 2b943fdd9..e335f9481 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2013, 2018 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -56,6 +56,10 @@
   (fold (lambda (prog out)
           (fold-program-code
            (lambda (elt out)
+             ;; FIXME: Update for change to top-level variable
+             ;; resolution.  Need to build a per-program map of
+             ;; IP->SLOT->CONSTANT to be able to resolve operands to
+             ;; resolve-module and lookup intrinsic calls.
              (match elt
                (('toplevel-box dst var mod sym bound?)
                 (let ((var (or var (and mod (module-variable mod sym)))))
diff --git a/module/texinfo/reflection.scm b/module/texinfo/reflection.scm
index d85f61239..50cb2ab05 100644
--- a/module/texinfo/reflection.scm
+++ b/module/texinfo/reflection.scm
@@ -288,16 +288,11 @@
           (else (lp (cdr forms))))))
 
 (define* (module-stexi-documentation sym-name
-                                     #:optional %docs-resolver
                                      #:key (docs-resolver
-                                            (or %docs-resolver
-                                                (lambda (name def) def))))
+                                            (lambda (name def) def)))
   "Return documentation for the module named @var{sym-name}. The
 documentation will be formatted as @code{stexi}
  (@pxref{texinfo,texinfo})."
-  (if %docs-resolver
-      (issue-deprecation-warning
-       "module-stexi-documentation: use #:docs-resolver instead of a positional argument."))
   (let* ((commentary (and=> (module-commentary sym-name)
                             (lambda (x) (string-trim-both x #\newline))))
          (stexi (string->stexi commentary))
diff --git a/module/web/client.scm b/module/web/client.scm
index 6c542f981..75719e1d1 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -49,7 +49,6 @@
             open-socket-for-uri
             http-request
             http-get
-            http-get*
             http-head
             http-post
             http-put
@@ -403,21 +402,6 @@ true)."
                           (decode-response-body response body)
                           body))))))))))
 
-(define* (http-get* uri #:key
-                    (body #f)
-                    (port (open-socket-for-uri uri))
-                    (version '(1 . 1)) (keep-alive? #f)
-                    ;; #:headers is the new name of #:extra-headers.
-                    (extra-headers #f) (headers (or extra-headers '()))
-                    (decode-body? #t))
-  "Deprecated in favor of (http-get #:streaming? #t)."
-  (issue-deprecation-warning
-   "`http-get*' has been deprecated.  "
-   "Instead, use `http-get' with the #:streaming? #t keyword argument.")
-  (http-get uri #:body body
-            #:port port #:version version #:keep-alive? keep-alive?
-            #:headers headers #:decode-body? #t #:streaming? #t))
-
 (define-syntax-rule (define-http-verb http-verb method doc)
   (define* (http-verb uri #:key
                       (body #f)
diff --git a/module/web/uri.scm b/module/web/uri.scm
index f5291b80b..b4b89b9cc 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -75,14 +75,7 @@
 
 (define (uri? obj)
   (and (uri-reference? obj)
-       (if (include-deprecated-features)
-           (begin
-             (unless (uri-scheme obj)
-               (issue-deprecation-warning
-                "Use uri-reference? instead of uri?; in the future, uri?
-will require that the object not be a relative-ref."))
-             #t)
-           (uri-scheme obj))
+       (uri-scheme obj)
        #t))
 
 ;;; RFC 3986, #4.2.
diff --git a/test-suite/standalone/test-asmobs-lib.c b/test-suite/standalone/test-asmobs-lib.c
index 03ac76447..965843fa4 100644
--- a/test-suite/standalone/test-asmobs-lib.c
+++ b/test-suite/standalone/test-asmobs-lib.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2003,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c
index 700e5b3d4..6e3ec6cdd 100644
--- a/test-suite/standalone/test-conversion.c
+++ b/test-suite/standalone/test-conversion.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2003-2004,2006-2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 # include <config.h>
@@ -42,7 +43,7 @@
 
 
 static void
-test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
+test_1 (const char *str, intmax_t min, intmax_t max,
 	int result)
 {
   int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
@@ -59,57 +60,57 @@ static void
 test_is_signed_integer ()
 {
   test_1 ("'foo", 
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  0);
   test_1 ("3.0", 
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  0);
   test_1 ("(inexact->exact 3.0)", 
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  1);
   test_1 ("3.5",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  0);
   test_1 ("most-positive-fixnum",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  1);
   test_1 ("(+ most-positive-fixnum 1)",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  1);
   test_1 ("most-negative-fixnum",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  1);
   test_1 ("(- most-negative-fixnum 1)",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  1);
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
       test_1 ("(- (expt 2 63) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      1);
       test_1 ("(expt 2 63)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0);
       test_1 ("(- (expt 2 63))",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      1);
       test_1 ("(- (- (expt 2 63)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0);
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
       test_1 ("(- (expt 2 31) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      1);
       test_1 ("(expt 2 31)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0);
       test_1 ("(- (expt 2 31))",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      1);
       test_1 ("(- (- (expt 2 31)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0);
     }
   else
@@ -128,7 +129,7 @@ test_is_signed_integer ()
 }
 
 static void
-test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
+test_2 (const char *str, uintmax_t min, uintmax_t max,
 	int result)
 {
   int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
@@ -145,45 +146,45 @@ static void
 test_is_unsigned_integer ()
 {
   test_2 ("'foo", 
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0);
   test_2 ("3.0", 
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0);
   test_2 ("(inexact->exact 3.0)", 
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  1);
   test_2 ("3.5",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0);
   test_2 ("most-positive-fixnum",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  1);
   test_2 ("(+ most-positive-fixnum 1)",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  1);
   test_2 ("most-negative-fixnum",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0);
   test_2 ("(- most-negative-fixnum 1)",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0);
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
       test_2 ("(- (expt 2 64) 1)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      1);
       test_2 ("(expt 2 64)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      0);
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
       test_2 ("(- (expt 2 32) 1)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      1);
       test_2 ("(expt 2 32)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      0);
     }
   else
@@ -203,8 +204,8 @@ test_is_unsigned_integer ()
 
 typedef struct {
   SCM val;
-  scm_t_intmax min, max;
-  scm_t_intmax result;
+  intmax_t min, max;
+  intmax_t result;
 } to_signed_data;
 
 static SCM
@@ -240,8 +241,8 @@ to_signed_integer_body (void *data)
 }
 
 static void
-test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
-	scm_t_intmax result, int range_error, int type_error)
+test_3 (const char *str, intmax_t min, intmax_t max,
+	intmax_t result, int range_error, int type_error)
 {
   to_signed_data data;
   data.val = scm_c_eval_string (str);
@@ -294,13 +295,13 @@ static void
 test_to_signed_integer ()
 {
   test_3 ("'foo",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  0, 0, 1);
   test_3 ("3.5",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  0, 0, 1);
   test_3 ("12",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  12, 0, 0);
   test_3 ("1000",
 	  -999, 999,
@@ -309,51 +310,51 @@ test_to_signed_integer ()
 	  -999, 999,
 	  0, 1, 0);
   test_3 ("most-positive-fixnum",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  SCM_MOST_POSITIVE_FIXNUM, 0, 0);
   test_3 ("most-negative-fixnum",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  SCM_MOST_NEGATIVE_FIXNUM, 0, 0);
   test_3 ("(+ most-positive-fixnum 1)",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
   test_3 ("(- most-negative-fixnum 1)",
-	  SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	  INTMAX_MIN, INTMAX_MAX,
 	  SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0);
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
       test_3 ("(- (expt 2 63) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MAX, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MAX, 0, 0);
       test_3 ("(+ (- (expt 2 63)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MIN+1, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MIN+1, 0, 0);
       test_3 ("(- (expt 2 63))",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MIN, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MIN, 0, 0);
       test_3 ("(expt 2 63)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0, 1, 0);
       test_3 ("(- (- (expt 2 63)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0, 1, 0);
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
       test_3 ("(- (expt 2 31) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MAX, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MAX, 0, 0);
       test_3 ("(+ (- (expt 2 31)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MIN+1, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MIN+1, 0, 0);
       test_3 ("(- (expt 2 31))",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
-	      SCM_T_INTMAX_MIN, 0, 0);
+	      INTMAX_MIN, INTMAX_MAX,
+	      INTMAX_MIN, 0, 0);
       test_3 ("(expt 2 31)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0, 1, 0);
       test_3 ("(- (- (expt 2 31)) 1)",
-	      SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX,
+	      INTMAX_MIN, INTMAX_MAX,
 	      0, 1, 0);
     }
   else
@@ -362,8 +363,8 @@ test_to_signed_integer ()
 
 typedef struct {
   SCM val;
-  scm_t_uintmax min, max;
-  scm_t_uintmax result;
+  uintmax_t min, max;
+  uintmax_t result;
 } to_unsigned_data;
 
 static SCM
@@ -375,8 +376,8 @@ to_unsigned_integer_body (void *data)
 }
 
 static void
-test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
-	scm_t_uintmax result, int range_error, int type_error)
+test_4 (const char *str, uintmax_t min, uintmax_t max,
+	uintmax_t result, int range_error, int type_error)
 {
   to_unsigned_data data;
   data.val = scm_c_eval_string (str);
@@ -429,39 +430,39 @@ static void
 test_to_unsigned_integer ()
 {
   test_4 ("'foo",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0, 0, 1);
   test_4 ("3.5",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  0, 0, 1);
   test_4 ("12",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  12, 0, 0);
   test_4 ("1000",
 	  0, 999,
 	  0, 1, 0);
   test_4 ("most-positive-fixnum",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  SCM_MOST_POSITIVE_FIXNUM, 0, 0);
   test_4 ("(+ most-positive-fixnum 1)",
-	  0, SCM_T_UINTMAX_MAX,
+	  0, UINTMAX_MAX,
 	  SCM_MOST_POSITIVE_FIXNUM+1, 0, 0);
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
       test_4 ("(- (expt 2 64) 1)",
-	      0, SCM_T_UINTMAX_MAX,
-	      SCM_T_UINTMAX_MAX, 0, 0);
+	      0, UINTMAX_MAX,
+	      UINTMAX_MAX, 0, 0);
       test_4 ("(expt 2 64)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      0, 1, 0);
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
       test_4 ("(- (expt 2 32) 1)",
-	      0, SCM_T_UINTMAX_MAX,
-	      SCM_T_UINTMAX_MAX, 0, 0);
+	      0, UINTMAX_MAX,
+	      UINTMAX_MAX, 0, 0);
       test_4 ("(expt 2 32)",
-	      0, SCM_T_UINTMAX_MAX,
+	      0, UINTMAX_MAX,
 	      0, 1, 0);
     }
   else
@@ -469,7 +470,7 @@ test_to_unsigned_integer ()
 }
 
 static void
-test_5 (scm_t_intmax val, const char *result)
+test_5 (intmax_t val, const char *result)
 {
   SCM res = scm_c_eval_string (result);
   if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
@@ -484,15 +485,15 @@ static void
 test_from_signed_integer ()
 {
   test_5 (12, "12");
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
-      test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)");
-      test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))");
+      test_5 (INTMAX_MAX, "(- (expt 2 63) 1)");
+      test_5 (INTMAX_MIN, "(- (expt 2 63))");
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
-      test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)");
-      test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))");
+      test_5 (INTMAX_MAX, "(- (expt 2 31) 1)");
+      test_5 (INTMAX_MIN, "(- (expt 2 31))");
     }
   test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
   test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum");
@@ -501,7 +502,7 @@ test_from_signed_integer ()
 }
 
 static void
-test_6 (scm_t_uintmax val, const char *result)
+test_6 (uintmax_t val, const char *result)
 {
   SCM res = scm_c_eval_string (result);
   if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
@@ -517,20 +518,20 @@ static void
 test_from_unsigned_integer ()
 {
   test_6 (12, "12");
-  if (sizeof (scm_t_intmax) == 8)
+  if (sizeof (intmax_t) == 8)
     {
-      test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)");
+      test_6 (UINTMAX_MAX, "(- (expt 2 64) 1)");
     }
-  else if (sizeof (scm_t_intmax) == 4)
+  else if (sizeof (intmax_t) == 4)
     {
-      test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)");
+      test_6 (UINTMAX_MAX, "(- (expt 2 32) 1)");
     }
   test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum");
   test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)");
 }
 
 static void
-test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
+test_7s (SCM n, intmax_t c_n, const char *result, const char *func)
 {
   SCM r = scm_c_eval_string (result);
 
@@ -544,7 +545,7 @@ test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
 #define TEST_7S(func,arg,res) test_7s (func(arg), arg, res, #func)
 
 static void
-test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
+test_7u (SCM n, uintmax_t c_n, const char *result, const char *func)
 {
   SCM r = scm_c_eval_string (result);
 
@@ -559,8 +560,8 @@ test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
 
 typedef struct {
   SCM val;
-  scm_t_intmax (*func) (SCM);
-  scm_t_intmax result;
+  intmax_t (*func) (SCM);
+  intmax_t result;
 } to_signed_func_data;
 
 static SCM
@@ -572,8 +573,8 @@ to_signed_func_body (void *data)
 }
 
 static void
-test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
-	 scm_t_intmax result, int range_error, int type_error)
+test_8s (const char *str, intmax_t (*func) (SCM), const char *func_name,
+	 intmax_t result, int range_error, int type_error)
 {
   to_signed_func_data data;
   data.val = scm_c_eval_string (str);
@@ -617,8 +618,8 @@ test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
 
 typedef struct {
   SCM val;
-  scm_t_uintmax (*func) (SCM);
-  scm_t_uintmax result;
+  uintmax_t (*func) (SCM);
+  uintmax_t result;
 } to_unsigned_func_data;
 
 static SCM
@@ -630,8 +631,8 @@ to_unsigned_func_body (void *data)
 }
 
 static void
-test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
-	 scm_t_uintmax result, int range_error, int type_error)
+test_8u (const char *str, uintmax_t (*func) (SCM), const char *func_name,
+	 uintmax_t result, int range_error, int type_error)
 {
   to_unsigned_func_data data;
   data.val = scm_c_eval_string (str);
@@ -678,8 +679,8 @@ test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
    need to give them a common return type.
 */
 
-#define DEFSTST(f) static scm_t_intmax  tst_##f (SCM x) { return f(x); }
-#define DEFUTST(f) static scm_t_uintmax tst_##f (SCM x) { return f(x); }
+#define DEFSTST(f) static intmax_t  tst_##f (SCM x) { return f(x); }
+#define DEFUTST(f) static uintmax_t tst_##f (SCM x) { return f(x); }
 
 DEFSTST (scm_to_schar)
 DEFUTST (scm_to_uchar)
@@ -739,14 +740,14 @@ test_int_sizes ()
   TEST_7S (scm_from_int16,  32768, "-32768");
   TEST_7U (scm_from_uint16, 65535,  "65535");
 
-  TEST_7S (scm_from_int32,  SCM_T_INT32_MIN,     "-2147483648");
-  TEST_7S (scm_from_int32,  SCM_T_INT32_MAX,      "2147483647");
-  TEST_7S (scm_from_int32,  SCM_T_INT32_MAX+1LL, "-2147483648");
-  TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX,     "4294967295");
+  TEST_7S (scm_from_int32,  INT32_MIN,     "-2147483648");
+  TEST_7S (scm_from_int32,  INT32_MAX,      "2147483647");
+  TEST_7S (scm_from_int32,  INT32_MAX+1LL, "-2147483648");
+  TEST_7U (scm_from_uint32, UINT32_MAX,     "4294967295");
 
-  TEST_7S (scm_from_int64,  SCM_T_INT64_MIN,  "-9223372036854775808");
-  TEST_7S (scm_from_int64,  SCM_T_INT64_MAX,   "9223372036854775807");
-  TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
+  TEST_7S (scm_from_int64,  INT64_MIN,  "-9223372036854775808");
+  TEST_7S (scm_from_int64,  INT64_MAX,   "9223372036854775807");
+  TEST_7U (scm_from_uint64, UINT64_MAX, "18446744073709551615");
 
   TEST_8S ("91",   scm_to_schar,   91, 0, 0);
   TEST_8U ("91",   scm_to_uchar,   91, 0, 0);
@@ -764,38 +765,38 @@ test_int_sizes ()
   TEST_8U ("911",  scm_to_size_t,   911, 0, 0);
   TEST_8S ("911",  scm_to_ssize_t,  911, 0, 0);
 
-  TEST_8S ("-128", scm_to_int8,   SCM_T_INT8_MIN, 0, 0);
-  TEST_8S ("127",  scm_to_int8,   SCM_T_INT8_MAX, 0, 0);
+  TEST_8S ("-128", scm_to_int8,   INT8_MIN, 0, 0);
+  TEST_8S ("127",  scm_to_int8,   INT8_MAX, 0, 0);
   TEST_8S ("128",  scm_to_int8,                0, 1, 0);
   TEST_8S ("#f",   scm_to_int8,                0, 0, 1);
-  TEST_8U ("255",  scm_to_uint8, SCM_T_UINT8_MAX, 0, 0);
+  TEST_8U ("255",  scm_to_uint8, UINT8_MAX, 0, 0);
   TEST_8U ("256",  scm_to_uint8,               0, 1, 0);
   TEST_8U ("-1",   scm_to_uint8,               0, 1, 0);
   TEST_8U ("#f",   scm_to_uint8,               0, 0, 1);
 
-  TEST_8S ("-32768", scm_to_int16,   SCM_T_INT16_MIN, 0, 0);
-  TEST_8S ("32767",  scm_to_int16,   SCM_T_INT16_MAX, 0, 0);
+  TEST_8S ("-32768", scm_to_int16,   INT16_MIN, 0, 0);
+  TEST_8S ("32767",  scm_to_int16,   INT16_MAX, 0, 0);
   TEST_8S ("32768",  scm_to_int16,                 0, 1, 0);
   TEST_8S ("#f",     scm_to_int16,                 0, 0, 1);
-  TEST_8U ("65535",  scm_to_uint16, SCM_T_UINT16_MAX, 0, 0);
+  TEST_8U ("65535",  scm_to_uint16, UINT16_MAX, 0, 0);
   TEST_8U ("65536",  scm_to_uint16,                0, 1, 0);
   TEST_8U ("-1",     scm_to_uint16,                0, 1, 0);
   TEST_8U ("#f",     scm_to_uint16,                0, 0, 1);
 
-  TEST_8S ("-2147483648", scm_to_int32,   SCM_T_INT32_MIN, 0, 0);
-  TEST_8S ("2147483647",  scm_to_int32,   SCM_T_INT32_MAX, 0, 0);
+  TEST_8S ("-2147483648", scm_to_int32,   INT32_MIN, 0, 0);
+  TEST_8S ("2147483647",  scm_to_int32,   INT32_MAX, 0, 0);
   TEST_8S ("2147483648",  scm_to_int32,                 0, 1, 0);
   TEST_8S ("#f",          scm_to_int32,                 0, 0, 1);
-  TEST_8U ("4294967295",  scm_to_uint32, SCM_T_UINT32_MAX, 0, 0);
+  TEST_8U ("4294967295",  scm_to_uint32, UINT32_MAX, 0, 0);
   TEST_8U ("4294967296",  scm_to_uint32,                0, 1, 0);
   TEST_8U ("-1",          scm_to_uint32,                0, 1, 0);
   TEST_8U ("#f",          scm_to_uint32,                0, 0, 1);
 
-  TEST_8S ("-9223372036854775808", scm_to_int64,   SCM_T_INT64_MIN, 0, 0);
-  TEST_8S ("9223372036854775807",  scm_to_int64,   SCM_T_INT64_MAX, 0, 0);
+  TEST_8S ("-9223372036854775808", scm_to_int64,   INT64_MIN, 0, 0);
+  TEST_8S ("9223372036854775807",  scm_to_int64,   INT64_MAX, 0, 0);
   TEST_8S ("9223372036854775808",  scm_to_int64,                 0, 1, 0);
   TEST_8S ("#f",                   scm_to_int64,                 0, 0, 1);
-  TEST_8U ("18446744073709551615", scm_to_uint64, SCM_T_UINT64_MAX, 0, 0);
+  TEST_8U ("18446744073709551615", scm_to_uint64, UINT64_MAX, 0, 0);
   TEST_8U ("18446744073709551616", scm_to_uint64,                0, 1, 0);
   TEST_8U ("-1",                   scm_to_uint64,                0, 1, 0);
   TEST_8U ("#f",                   scm_to_uint64,                0, 0, 1);
diff --git a/test-suite/standalone/test-extensions-lib.c b/test-suite/standalone/test-extensions-lib.c
index cc03a9eba..84eb376b9 100644
--- a/test-suite/standalone/test-extensions-lib.c
+++ b/test-suite/standalone/test-extensions-lib.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2003,2006,2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-ffi-lib.c b/test-suite/standalone/test-ffi-lib.c
index f26533958..cdfefd84a 100644
--- a/test-suite/standalone/test-ffi-lib.c
+++ b/test-suite/standalone/test-ffi-lib.c
@@ -1,25 +1,28 @@
-/* Copyright (C) 2010, 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2010-2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
+#include <string.h>
+
 #include <libguile.h>
 
 void test_ffi_v_ (void);
@@ -28,184 +31,184 @@ void test_ffi_v_ (void)
   return;
 }
 
-void test_ffi_v_u8 (scm_t_uint8 a);
-void test_ffi_v_u8 (scm_t_uint8 a)
+void test_ffi_v_u8 (uint8_t a);
+void test_ffi_v_u8 (uint8_t a)
 {
   return;
 }
 
-void test_ffi_v_s64 (scm_t_int64 a);
-void test_ffi_v_s64 (scm_t_int64 a)
+void test_ffi_v_s64 (int64_t a);
+void test_ffi_v_s64 (int64_t a)
 {
   return;
 }
 
-scm_t_int8 test_ffi_s8_ (void);
-scm_t_int8 test_ffi_s8_ (void)
+int8_t test_ffi_s8_ (void);
+int8_t test_ffi_s8_ (void)
 {
   return -100;
 }
-scm_t_int8 test_ffi_s8_u8 (scm_t_uint8 a);
-scm_t_int8 test_ffi_s8_u8 (scm_t_uint8 a)
+int8_t test_ffi_s8_u8 (uint8_t a);
+int8_t test_ffi_s8_u8 (uint8_t a)
 {
   return -100 + a;
 }
 
-scm_t_int8 test_ffi_s8_s64 (scm_t_int64 a);
-scm_t_int8 test_ffi_s8_s64 (scm_t_int64 a)
+int8_t test_ffi_s8_s64 (int64_t a);
+int8_t test_ffi_s8_s64 (int64_t a)
 {
   return -100 + a;
 }
 
-scm_t_uint8 test_ffi_u8_ (void);
-scm_t_uint8 test_ffi_u8_ (void)
+uint8_t test_ffi_u8_ (void);
+uint8_t test_ffi_u8_ (void)
 {
   return 200;
 }
 
-scm_t_uint8 test_ffi_u8_u8 (scm_t_uint8 a);
-scm_t_uint8 test_ffi_u8_u8 (scm_t_uint8 a)
+uint8_t test_ffi_u8_u8 (uint8_t a);
+uint8_t test_ffi_u8_u8 (uint8_t a)
 {
   return 200 + a;
 }
 
-scm_t_uint8 test_ffi_u8_s64 (scm_t_int64 a);
-scm_t_uint8 test_ffi_u8_s64 (scm_t_int64 a)
+uint8_t test_ffi_u8_s64 (int64_t a);
+uint8_t test_ffi_u8_s64 (int64_t a)
 {
   return 200 + a;
 }
 
-scm_t_int16 test_ffi_s16_ (void);
-scm_t_int16 test_ffi_s16_ (void)
+int16_t test_ffi_s16_ (void);
+int16_t test_ffi_s16_ (void)
 {
   return -20000;
 }
 
-scm_t_int16 test_ffi_s16_u8 (scm_t_uint8 a);
-scm_t_int16 test_ffi_s16_u8 (scm_t_uint8 a)
+int16_t test_ffi_s16_u8 (uint8_t a);
+int16_t test_ffi_s16_u8 (uint8_t a)
 {
   return -20000 + a;
 }
 
-scm_t_int16 test_ffi_s16_s64 (scm_t_int64 a);
-scm_t_int16 test_ffi_s16_s64 (scm_t_int64 a)
+int16_t test_ffi_s16_s64 (int64_t a);
+int16_t test_ffi_s16_s64 (int64_t a)
 {
   return -20000 + a;
 }
 
-scm_t_uint16 test_ffi_u16_ (void);
-scm_t_uint16 test_ffi_u16_ (void)
+uint16_t test_ffi_u16_ (void);
+uint16_t test_ffi_u16_ (void)
 {
   return 40000;
 }
 
-scm_t_uint16 test_ffi_u16_u8 (scm_t_uint8 a);
-scm_t_uint16 test_ffi_u16_u8 (scm_t_uint8 a)
+uint16_t test_ffi_u16_u8 (uint8_t a);
+uint16_t test_ffi_u16_u8 (uint8_t a)
 {
   return 40000 + a;
 }
 
-scm_t_uint16 test_ffi_u16_s64 (scm_t_int64 a);
-scm_t_uint16 test_ffi_u16_s64 (scm_t_int64 a)
+uint16_t test_ffi_u16_s64 (int64_t a);
+uint16_t test_ffi_u16_s64 (int64_t a)
 {
   return 40000 + a;
 }
 
-scm_t_int32 test_ffi_s32_ (void);
-scm_t_int32 test_ffi_s32_ (void)
+int32_t test_ffi_s32_ (void);
+int32_t test_ffi_s32_ (void)
 {
   return -2000000000;
 }
 
-scm_t_int32 test_ffi_s32_u8 (scm_t_uint8 a);
-scm_t_int32 test_ffi_s32_u8 (scm_t_uint8 a)
+int32_t test_ffi_s32_u8 (uint8_t a);
+int32_t test_ffi_s32_u8 (uint8_t a)
 {
   return -2000000000 + a;
 }
 
-scm_t_int32 test_ffi_s32_s64 (scm_t_int64 a);
-scm_t_int32 test_ffi_s32_s64 (scm_t_int64 a)
+int32_t test_ffi_s32_s64 (int64_t a);
+int32_t test_ffi_s32_s64 (int64_t a)
 {
   return -2000000000 + a;
 }
 
-scm_t_uint32 test_ffi_u32_ (void);
-scm_t_uint32 test_ffi_u32_ (void)
+uint32_t test_ffi_u32_ (void);
+uint32_t test_ffi_u32_ (void)
 {
   return 4000000000U;
 }
 
-scm_t_uint32 test_ffi_u32_u8 (scm_t_uint8 a);
-scm_t_uint32 test_ffi_u32_u8 (scm_t_uint8 a)
+uint32_t test_ffi_u32_u8 (uint8_t a);
+uint32_t test_ffi_u32_u8 (uint8_t a)
 {
   return 4000000000U + a;
 }
 
-scm_t_uint32 test_ffi_u32_s64 (scm_t_int64 a);
-scm_t_uint32 test_ffi_u32_s64 (scm_t_int64 a)
+uint32_t test_ffi_u32_s64 (int64_t a);
+uint32_t test_ffi_u32_s64 (int64_t a)
 {
   return 4000000000U + a;
 }
 
 /* FIXME: use 64-bit literals */
-scm_t_int64 test_ffi_s64_ (void);
-scm_t_int64 test_ffi_s64_ (void)
+int64_t test_ffi_s64_ (void);
+int64_t test_ffi_s64_ (void)
 {
   return -2000000000;
 }
 
-scm_t_int64 test_ffi_s64_u8 (scm_t_uint8 a);
-scm_t_int64 test_ffi_s64_u8 (scm_t_uint8 a)
+int64_t test_ffi_s64_u8 (uint8_t a);
+int64_t test_ffi_s64_u8 (uint8_t a)
 {
   return -2000000000 + a;
 }
 
-scm_t_int64 test_ffi_s64_s64 (scm_t_int64 a);
-scm_t_int64 test_ffi_s64_s64 (scm_t_int64 a)
+int64_t test_ffi_s64_s64 (int64_t a);
+int64_t test_ffi_s64_s64 (int64_t a)
 {
   return -2000000000 + a;
 }
 
-scm_t_uint64 test_ffi_u64_ (void);
-scm_t_uint64 test_ffi_u64_ (void)
+uint64_t test_ffi_u64_ (void);
+uint64_t test_ffi_u64_ (void)
 {
   return 4000000000UL;
 }
 
-scm_t_uint64 test_ffi_u64_u8 (scm_t_uint8 a);
-scm_t_uint64 test_ffi_u64_u8 (scm_t_uint8 a)
+uint64_t test_ffi_u64_u8 (uint8_t a);
+uint64_t test_ffi_u64_u8 (uint8_t a)
 {
   return 4000000000UL + a;
 }
 
-scm_t_uint64 test_ffi_u64_s64 (scm_t_int64 a);
-scm_t_uint64 test_ffi_u64_s64 (scm_t_int64 a)
+uint64_t test_ffi_u64_s64 (int64_t a);
+uint64_t test_ffi_u64_s64 (int64_t a)
 {
   return 4000000000UL + a;
 }
 
 
-scm_t_int64 test_ffi_sum (scm_t_int8 a, scm_t_int16 b,
-                          scm_t_int32 c, scm_t_int64 d);
-scm_t_int64 test_ffi_sum (scm_t_int8 a, scm_t_int16 b,
-                          scm_t_int32 c, scm_t_int64 d)
+int64_t test_ffi_sum (int8_t a, int16_t b,
+                          int32_t c, int64_t d);
+int64_t test_ffi_sum (int8_t a, int16_t b,
+                          int32_t c, int64_t d)
 {
   return d + c + b + a;
 }
 
 
-scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
-                               scm_t_uint32 c, scm_t_uint64 d,
-                               scm_t_int8 e, scm_t_int16 f,
-                               scm_t_int32 g, scm_t_int64 h,
-                               scm_t_int8 i, scm_t_int16 j,
-                               scm_t_int32 k, scm_t_int64 l);
-scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
-                               scm_t_uint32 c, scm_t_uint64 d,
-                               scm_t_int8 e, scm_t_int16 f,
-                               scm_t_int32 g, scm_t_int64 h,
-                               scm_t_int8 i, scm_t_int16 j,
-                               scm_t_int32 k, scm_t_int64 l)
+int64_t test_ffi_sum_many (uint8_t a, uint16_t b,
+                           uint32_t c, uint64_t d,
+                           int8_t e, int16_t f,
+                           int32_t g, int64_t h,
+                           int8_t i, int16_t j,
+                           int32_t k, int64_t l);
+int64_t test_ffi_sum_many (uint8_t a, uint16_t b,
+                           uint32_t c, uint64_t d,
+                           int8_t e, int16_t f,
+                           int32_t g, int64_t h,
+                           int8_t i, int16_t j,
+                           int32_t k, int64_t l)
 {
   return l + k + j + i + h + g + f + e + d + c + b + a;
 }
@@ -213,20 +216,20 @@ scm_t_int64 test_ffi_sum_many (scm_t_uint8 a, scm_t_uint16 b,
 
 struct foo
 {
-  scm_t_int8 a;
-  scm_t_int16 b;
-  scm_t_int32 c;
-  scm_t_int64 d;
+  int8_t a;
+  int16_t b;
+  int32_t c;
+  int64_t d;
 };
-scm_t_int64 test_ffi_sum_struct (struct foo foo);
-scm_t_int64 test_ffi_sum_struct (struct foo foo)
+int64_t test_ffi_sum_struct (struct foo foo);
+int64_t test_ffi_sum_struct (struct foo foo)
 {
   return foo.d + foo.c + foo.b + foo.a;
 }
 
 
-void* test_ffi_memcpy (void *dest, void *src, scm_t_int32 n);
-void* test_ffi_memcpy (void *dest, void *src, scm_t_int32 n)
+void* test_ffi_memcpy (void *dest, void *src, int32_t n);
+void* test_ffi_memcpy (void *dest, void *src, int32_t n)
 {
   return memcpy (dest, src, n);
 }
diff --git a/test-suite/standalone/test-foreign-object-c.c b/test-suite/standalone/test-foreign-object-c.c
index 613c1f631..00c997a56 100644
--- a/test-suite/standalone/test-foreign-object-c.c
+++ b/test-suite/standalone/test-foreign-object-c.c
@@ -1,22 +1,23 @@
 /* test-foreign-object-c.c - exercise C foreign object interface */
 
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-list.c b/test-suite/standalone/test-list.c
index b51a2a18e..b0158b7c7 100644
--- a/test-suite/standalone/test-list.c
+++ b/test-suite/standalone/test-list.c
@@ -1,22 +1,23 @@
 /* test-list.c - exercise libguile/list.c functions */
 
-/* Copyright (C) 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2006,2008-2010,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c
index 40b358b99..40209ab75 100644
--- a/test-suite/standalone/test-loose-ends.c
+++ b/test-suite/standalone/test-loose-ends.c
@@ -3,23 +3,24 @@
  * Test items of the Guile C API that aren't covered by any other tests.
  */
 
-/* Copyright (C) 2009, 2012, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009,2012,2014,2018
+    Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c
index f5cd87938..25db4de62 100644
--- a/test-suite/standalone/test-num2integral.c
+++ b/test-suite/standalone/test-num2integral.c
@@ -1,21 +1,21 @@
-/* Copyright (C) 1999, 2000, 2001, 2003, 2004, 2006, 2008, 2010, 2011
- *   2012, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1999-2001,2003-2004,2006,2008,2010-2012,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-pthread-create-secondary.c b/test-suite/standalone/test-pthread-create-secondary.c
index 14ea240a4..a06668fcc 100644
--- a/test-suite/standalone/test-pthread-create-secondary.c
+++ b/test-suite/standalone/test-pthread-create-secondary.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2011, 2013 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011,2013,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Test whether threads created with `pthread_create' work, and whether
    a secondary thread can call `scm_with_guile'. (bug #32436).  */
diff --git a/test-suite/standalone/test-pthread-create.c b/test-suite/standalone/test-pthread-create.c
index cf3771f07..9fc7af158 100644
--- a/test-suite/standalone/test-pthread-create.c
+++ b/test-suite/standalone/test-pthread-create.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Test whether threads created with `pthread_create' work (bug #32436)
    when then main thread is the one that initializes Guile.  */
diff --git a/test-suite/standalone/test-round.c b/test-suite/standalone/test-round.c
index 2cd6fd54e..c9175b230 100644
--- a/test-suite/standalone/test-round.c
+++ b/test-suite/standalone/test-round.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2004, 2006, 2008, 2009, 2011, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2004,2006,2008-2009,2011,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
index 453c53ce8..cb6af7adc 100644
--- a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
+++ b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-scm-c-read.c b/test-suite/standalone/test-scm-c-read.c
index c4dbf6251..14a95a1d1 100644
--- a/test-suite/standalone/test-scm-c-read.c
+++ b/test-suite/standalone/test-scm-c-read.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2008, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2008,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Exercise `scm_c_read ()' and the port type API.  Verify assumptions that
    can be made by port type implementations.  */
@@ -25,8 +26,9 @@
 
 #undef NDEBUG
 
-#include <libguile.h>
 #include <assert.h>
+#include <string.h>
+#include <libguile.h>
 
 
 
diff --git a/test-suite/standalone/test-scm-spawn-thread.c b/test-suite/standalone/test-scm-spawn-thread.c
index f6d561aa1..620c9f8f1 100644
--- a/test-suite/standalone/test-scm-spawn-thread.c
+++ b/test-suite/standalone/test-scm-spawn-thread.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011-2012,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Test whether a thread created with `scm_spawn_thread' can be joined.
    See <http://thread.gmane.org/gmane.lisp.guile.devel/11804> for the
diff --git a/test-suite/standalone/test-scm-take-locale-symbol.c b/test-suite/standalone/test-scm-take-locale-symbol.c
index 808068fbf..55303fb01 100644
--- a/test-suite/standalone/test-scm-take-locale-symbol.c
+++ b/test-suite/standalone/test-scm-take-locale-symbol.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Exercise `scm_take_locale_symbol ()', making sure it returns an interned
    symbol.  See https://savannah.gnu.org/bugs/index.php?25865 .  */
diff --git a/test-suite/standalone/test-scm-take-u8vector.c b/test-suite/standalone/test-scm-take-u8vector.c
index fff3af47f..dc8bc11a1 100644
--- a/test-suite/standalone/test-scm-take-u8vector.c
+++ b/test-suite/standalone/test-scm-take-u8vector.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2009,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 /* Make sure `scm_take_u8vector ()' returns a u8vector that actually uses the
    provided storage.  */
@@ -34,7 +35,7 @@ do_test (void *result)
 {
 #define LEN 123
   SCM u8v;
-  scm_t_uint8 *data;
+  uint8_t *data;
   scm_t_array_handle handle;
 
   data = scm_malloc (LEN);
diff --git a/test-suite/standalone/test-scm-to-latin1-string.c b/test-suite/standalone/test-scm-to-latin1-string.c
index b8f012072..d39789533 100644
--- a/test-suite/standalone/test-scm-to-latin1-string.c
+++ b/test-suite/standalone/test-scm-to-latin1-string.c
@@ -1,28 +1,31 @@
-/* Copyright (C) 2011 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2011,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
 
-#include <libguile.h>
 #include <stdlib.h>
+#include <string.h>
+
+#include <libguile.h>
 
 /*
   This outputs:
diff --git a/test-suite/standalone/test-scm-values.c b/test-suite/standalone/test-scm-values.c
index 06f57bedd..70a53f16c 100644
--- a/test-suite/standalone/test-scm-values.c
+++ b/test-suite/standalone/test-scm-values.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2012, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2012,2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-scm-with-guile.c b/test-suite/standalone/test-scm-with-guile.c
index a78458e6c..332769114 100644
--- a/test-suite/standalone/test-scm-with-guile.c
+++ b/test-suite/standalone/test-scm-with-guile.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 
 /* Test whether `scm_with_guile ()' can be called several times from a given
diff --git a/test-suite/standalone/test-smob-mark-race.c b/test-suite/standalone/test-smob-mark-race.c
index eca0325d2..31aba8c30 100644
--- a/test-suite/standalone/test-smob-mark-race.c
+++ b/test-suite/standalone/test-smob-mark-race.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2016 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2016
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #include <config.h>
diff --git a/test-suite/standalone/test-smob-mark.c b/test-suite/standalone/test-smob-mark.c
index 86566af76..d0bb5336a 100644
--- a/test-suite/standalone/test-smob-mark.c
+++ b/test-suite/standalone/test-smob-mark.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2013, 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2013-2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 #include <config.h>
diff --git a/test-suite/standalone/test-srfi-4.c b/test-suite/standalone/test-srfi-4.c
index b49e666cc..82897df27 100644
--- a/test-suite/standalone/test-srfi-4.c
+++ b/test-suite/standalone/test-srfi-4.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2014 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2014,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -39,7 +40,7 @@ test_writable_elements ()
     size_t len;
     ssize_t inc;
     scm_t_array_handle h;
-    scm_t_uint32 *elts = scm_u32vector_writable_elements (v, &h, &len, &inc);
+    uint32_t *elts = scm_u32vector_writable_elements (v, &h, &len, &inc);
     assert (len == 4);
     assert (inc == 1);
     assert (elts[0] == 1);
diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c
index 2749af276..33752cd22 100644
--- a/test-suite/standalone/test-unwind.c
+++ b/test-suite/standalone/test-unwind.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2004, 2005, 2008, 2009, 2010, 2013, 2019 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2004-2005,2008-2010,2013,2018-2019
+    Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #if HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/standalone/test-with-guile-module.c b/test-suite/standalone/test-with-guile-module.c
index 4e22ff5da..36d1f287a 100644
--- a/test-suite/standalone/test-with-guile-module.c
+++ b/test-suite/standalone/test-with-guile-module.c
@@ -1,20 +1,21 @@
-/* Copyright (C) 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 2008,2018
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 5b73bdab3..b2cbb1faa 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -1,6 +1,6 @@
 ;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;   2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999-2001,2004,2006-2007,2009-2014,2018
+;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -39,7 +39,6 @@
  exception:string-contains-nul
  exception:read-error
  exception:null-pointer-error
- exception:vm-error
 
  ;; Reporting passes and failures.
  run-test
@@ -294,8 +293,6 @@
   (cons 'read-error "^.*$"))
 (define exception:null-pointer-error
   (cons 'null-pointer-error "^.*$"))
-(define exception:vm-error
-  (cons 'vm-error "^.*$"))
 
 ;; as per throw in scm_to_locale_stringn()
 (define exception:string-contains-nul
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 6c6660478..4536a468d 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,6 @@
 ;;;; goops.test --- test suite for GOOPS                      -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015, 2017 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -148,7 +148,7 @@
     ;; Previously, `class-of' would fail for nameless structs, i.e., structs
     ;; for which `struct-vtable-name' is #f.
     (is-a? (class-of (make-vtable
-                      (string-append standard-vtable-fields "prprpr")))
+                      (string-append standard-vtable-fields "pwpwpw")))
            <class>))
 
   ;; Two cases: one for structs created before goops, one after.
@@ -157,7 +157,7 @@
          (class-of (current-module))))
   (pass-if "late vtable class cached"
     (let ((vtable (make-vtable
-                   (string-append standard-vtable-fields "prprpr"))))
+                   (string-append standard-vtable-fields "pwpwpw"))))
       (eq? (class-of vtable)
            (class-of vtable)))))
 
@@ -337,25 +337,31 @@
 (with-test-prefix "object update"
   (pass-if "defining class"
     (eval '(define-class <foo> ()
-	     (x #:accessor x #:init-value 123)
-	     (z #:accessor z #:init-value 789))
-	  (current-module))
+             (x #:accessor x #:init-value 123)
+             (z #:accessor z #:init-value 789)
+             #:metaclass <redefinable-class>)
+          (current-module))
     (eval '(is-a? <foo> <class>) (current-module)))
   (pass-if "making instance"
     (eval '(define foo (make <foo>)) (current-module))
     (eval '(and (is-a? foo <foo>) (= (x foo) 123)) (current-module)))
   (pass-if "redefining class"
     (eval '(define-class <foo> ()
-	     (x #:accessor x #:init-value 123)
-	     (y #:accessor y #:init-value 456)
-	     (z #:accessor z #:init-value 789))
-	  (current-module))
+             (x #:accessor x #:init-value 123)
+             (y #:accessor y #:init-value 456)
+             (z #:accessor z #:init-value 789)
+             #:metaclass <redefinable-class>)
+          (current-module))
     (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))
 
   (pass-if "changing class"
-    (let* ((c1 (class () (the-slot #:init-keyword #:value)))
-           (c2 (class () (the-slot #:init-keyword #:value)
-                         (the-other-slot #:init-value 888)))
+    (let* ((c1 (class ()
+                      (the-slot #:init-keyword #:value)
+                      #:metaclass <redefinable-class>))
+           (c2 (class ()
+                      (the-slot #:init-keyword #:value)
+                      (the-other-slot #:init-value 888)
+                      #:metaclass <redefinable-class>))
            (o1 (make c1 #:value 777)))
       (and (is-a? o1 c1)
            (not (is-a? o1 c2))
@@ -373,7 +379,8 @@
     ;; array, leading to out-of-bounds accesses.
 
     (let* ((parent-class (class ()
-                           #:name '<class-that-will-be-redefined>))
+                                #:name '<class-that-will-be-redefined>
+                                #:metaclass <redefinable-class>))
            (classes
             (unfold (lambda (i) (>= i 20))
                     (lambda (i)
@@ -383,7 +390,8 @@
                                   #:name (string->symbol
                                           (string-append "<foo-to-redefine-"
                                                          (number->string i)
-                                                         ">"))))
+                                                         ">"))
+                                  #:metaclass <redefinable-class>))
                     (lambda (i)
                       (+ 1 i))
                     0))
@@ -393,7 +401,7 @@
                  classes)))
 
       (define-method (change-class (foo parent-class)
-                                   (new <class>))
+                                   (new <redefinable-class>))
         ;; Called by `scm_change_object_class ()', via `purgatory ()'.
         (if (null? classes)
             (next-method)
@@ -407,8 +415,9 @@
               ;; nested `scm_change_object_class ()' calls, which increases
               ;; the size of HELL and increments N_HELL.
               (class-redefinition class
-                                  (make-class '() (class-slots class)
-                                              #:name (class-name class)))
+                                  (make-class '() (class-direct-slots class)
+                                              #:name (class-name class)
+                                              #:metaclass <redefinable-class>))
 
               ;; Use `slot-ref' to trigger the `scm_change_object_class ()'
               ;; and `go_to_hell ()' calls.
diff --git a/test-suite/tests/linker.test b/test-suite/tests/linker.test
index dcfac1b81..e7ecc291e 100644
--- a/test-suite/tests/linker.test
+++ b/test-suite/tests/linker.test
@@ -1,6 +1,6 @@
 ;;;; linker.test                               -*- scheme -*-
 ;;;;
-;;;; Copyright 2013 Free Software Foundation, Inc.
+;;;; Copyright 2013, 2019 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -27,7 +27,8 @@
   (let ((strtab (make-string-table)))
     (define (make-object index name bv relocs . kwargs)
       (let ((name-idx (string-table-intern! strtab (symbol->string name))))
-        (make-linker-object (apply make-elf-section
+        (make-linker-object (symbol->string name)
+                            (apply make-elf-section
                                    #:index index
                                    #:name name-idx
                                    #:size (bytevector-length bv)
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 4e2ccf9c6..1b1eff9da 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1,7 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <wingo@pobox.com> --- May 2009
 ;;;;
-;;;; 	Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009-2014, 2017 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1145,7 +1145,7 @@
    (let (tmp tmp) (_ _) ((toplevel foo) (toplevel baz))
         (seq (seq (if (primcall thunk? (lexical tmp _))
                       (call (lexical tmp _))
-                      (primcall scm-error . _))
+                      (primcall throw . _))
                   (primcall wind (lexical tmp _) (lexical tmp _)))
              (let (tmp) (_) ((toplevel bar))
                   (seq (seq (primcall unwind)
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 87a0c704a..aa0dbc1b2 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,7 +1,7 @@
 ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2004, 2006, 2007, 2010, 2012,
-;;;;   2015, 2017, 2018, 2019 Free Software Foundation, Inc.
+;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019
+;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index 316f4557c..2e9317bbf 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -1,6 +1,6 @@
 ;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;; 	Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2010-2015, 2017-2019 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -39,9 +39,9 @@ a procedure."
 (define (return-constant val)
   (assemble-program `((begin-program foo
                                      ((name . foo)))
-                      (begin-standard-arity () 2 #f)
+                      (begin-standard-arity #t () 1 #f)
                       (load-constant 0 ,val)
-                      (return-values 2)
+                      (return-values)
                       (end-arity)
                       (end-program))))
 
@@ -91,16 +91,16 @@ a procedure."
   (assert-equal 42
                 (((assemble-program `((begin-program foo
                                                      ((name . foo)))
-                                      (begin-standard-arity () 2 #f)
+                                      (begin-standard-arity #t () 1 #f)
                                       (load-static-procedure 0 bar)
-                                      (return-values 2)
+                                      (return-values)
                                       (end-arity)
                                       (end-program)
                                       (begin-program bar
                                                      ((name . bar)))
-                                      (begin-standard-arity () 2 #f)
+                                      (begin-standard-arity #t () 1 #f)
                                       (load-constant 0 42)
-                                      (return-values 2)
+                                      (return-values)
                                       (end-arity)
                                       (end-program)))))))
 
@@ -113,75 +113,42 @@ a procedure."
                         ;; 2: accum
                         '((begin-program countdown
                                          ((name . countdown)))
-                          (begin-standard-arity (x) 4 #f)
+                          (begin-standard-arity #t (x) 4 #f)
                           (definition closure 0 scm)
                           (definition x 1 scm)
-                          (br fix-body)
+                          (j fix-body)
                           (label loop-head)
-                          (br-if-= 1 2 #f out)
+                          (=? 1 2)
+                          (je out)
                           (add 0 1 0)
                           (add/immediate 1 1 1)
-                          (br loop-head)
+                          (j loop-head)
                           (label fix-body)
                           (load-constant 1 0)
                           (load-constant 0 0)
-                          (br loop-head)
+                          (j loop-head)
                           (label out)
-                          (mov 2 0)
-                          (return-values 2)
+                          (mov 3 0)
+                          (reset-frame 1)
+                          (return-values)
                           (end-arity)
                           (end-program)))))
                   (sumto 1000))))
 
-(with-test-prefix "accum"
-  (assert-equal (+ 1 2 3)
-                (let ((make-accum
-                       (assemble-program
-                        ;; 0: elt
-                        ;; 1: tail
-                        ;; 2: head
-                        '((begin-program make-accum
-                                         ((name . make-accum)))
-                          (begin-standard-arity () 3 #f)
-                          (load-constant 1 0)
-                          (box 1 1)
-                          (make-closure 0 accum 1)
-                          (free-set! 0 1 0)
-                          (mov 1 0)
-                          (return-values 2)
-                          (end-arity)
-                          (end-program)
-                          (begin-program accum
-                                         ((name . accum)))
-                          (begin-standard-arity (x) 4 #f)
-                          (definition closure 0 scm)
-                          (definition x 1 scm)
-                          (free-ref 1 3 0)
-                          (box-ref 0 1)
-                          (add 0 0 2)
-                          (box-set! 1 0)
-                          (mov 2 0)
-                          (return-values 2)
-                          (end-arity)
-                          (end-program)))))
-                  (let ((accum (make-accum)))
-                    (accum 1)
-                    (accum 2)
-                    (accum 3)))))
-
 (with-test-prefix "call"
   (assert-equal 42
                 (let ((call ;; (lambda (x) (x))
                        (assemble-program
                         '((begin-program call
                                          ((name . call)))
-                          (begin-standard-arity (f) 7 #f)
+                          (begin-standard-arity #t (f) 7 #f)
                           (definition closure 0 scm)
                           (definition f 1 scm)
                           (mov 1 5)
                           (call 5 1)
-                          (receive 1 5 7)
-                          (return-values 2)
+                          (receive 0 5 7)
+                          (reset-frame 1)
+                          (return-values)
                           (end-arity)
                           (end-program)))))
                   (call (lambda () 42))))
@@ -191,14 +158,15 @@ a procedure."
                        (assemble-program
                         '((begin-program call-with-3
                                          ((name . call-with-3)))
-                          (begin-standard-arity (f) 7 #f)
+                          (begin-standard-arity #t (f) 7 #f)
                           (definition closure 0 scm)
                           (definition f 1 scm)
                           (mov 1 5)
                           (load-constant 0 3)
                           (call 5 2)
-                          (receive 1 5 7)
-                          (return-values 2)
+                          (receive 0 5 7)
+                          (reset-frame 1)
+                          (return-values)
                           (end-arity)
                           (end-program)))))
                   (call-with-3 (lambda (x) (* x 2))))))
@@ -209,11 +177,12 @@ a procedure."
                        (assemble-program
                         '((begin-program call
                                          ((name . call)))
-                          (begin-standard-arity (f) 2 #f)
+                          (begin-standard-arity #t (f) 2 #f)
                           (definition closure 0 scm)
                           (definition f 1 scm)
                           (mov 1 0)
-                          (tail-call 1)
+                          (reset-frame 1)
+                          (tail-call)
                           (end-arity)
                           (end-program)))))
                   (call (lambda () 3))))
@@ -223,129 +192,22 @@ a procedure."
                        (assemble-program
                         '((begin-program call-with-3
                                          ((name . call-with-3)))
-                          (begin-standard-arity (f) 2 #f)
+                          (begin-standard-arity #t (f) 2 #f)
                           (definition closure 0 scm)
                           (definition f 1 scm)
                           (mov 1 0) ;; R0 <- R1
                           (load-constant 0 3) ;; R1 <- 3
-                          (tail-call 2)
+                          (tail-call)
                           (end-arity)
                           (end-program)))))
                   (call-with-3 (lambda (x) (* x 2))))))
 
-(with-test-prefix "cached-toplevel-ref"
-  (assert-equal 5.0
-                (let ((get-sqrt-trampoline
-                       (assemble-program
-                        '((begin-program get-sqrt-trampoline
-                                         ((name . get-sqrt-trampoline)))
-                          (begin-standard-arity () 2 #f)
-                          (current-module 0)
-                          (cache-current-module! 0 sqrt-scope)
-                          (load-static-procedure 0 sqrt-trampoline)
-                          (return-values 2)
-                          (end-arity)
-                          (end-program)
-
-                          (begin-program sqrt-trampoline
-                                         ((name . sqrt-trampoline)))
-                          (begin-standard-arity (x) 3 #f)
-                          (definition closure 0 scm)
-                          (definition x 1 scm)
-                          (cached-toplevel-box 0 sqrt-scope sqrt #t)
-                          (box-ref 2 0)
-                          (tail-call 2)
-                          (end-arity)
-                          (end-program)))))
-                  ((get-sqrt-trampoline) 25.0))))
-
-(define *top-val* 0)
-
-(with-test-prefix "cached-toplevel-set!"
-  (let ((prev *top-val*))
-    (assert-equal (1+ prev)
-                  (let ((make-top-incrementor
-                         (assemble-program
-                          '((begin-program make-top-incrementor
-                                           ((name . make-top-incrementor)))
-                            (begin-standard-arity () 2 #f)
-                            (current-module 0)
-                            (cache-current-module! 0 top-incrementor)
-                            (load-static-procedure 0 top-incrementor)
-                            (return-values 2)
-                            (end-arity)
-                            (end-program)
-
-                            (begin-program top-incrementor
-                                           ((name . top-incrementor)))
-                            (begin-standard-arity () 3 #f)
-                            (cached-toplevel-box 1 top-incrementor *top-val* #t)
-                            (box-ref 0 1)
-                            (add/immediate 0 0 1)
-                            (box-set! 1 0)
-                            (return-values 1)
-                            (end-arity)
-                            (end-program)))))
-                    ((make-top-incrementor))
-                    *top-val*))))
-
-(with-test-prefix "cached-module-ref"
-  (assert-equal 5.0
-                (let ((get-sqrt-trampoline
-                       (assemble-program
-                        '((begin-program get-sqrt-trampoline
-                                         ((name . get-sqrt-trampoline)))
-                          (begin-standard-arity () 2 #f)
-                          (load-static-procedure 0 sqrt-trampoline)
-                          (return-values 2)
-                          (end-arity)
-                          (end-program)
-
-                          (begin-program sqrt-trampoline
-                                         ((name . sqrt-trampoline)))
-                          (begin-standard-arity (x) 3 #f)
-                          (definition closure 0 scm)
-                          (definition x 1 scm)
-                          (cached-module-box 0 (guile) sqrt #t #t)
-                          (box-ref 2 0)
-                          (tail-call 2)
-                          (end-arity)
-                          (end-program)))))
-                  ((get-sqrt-trampoline) 25.0))))
-
-(with-test-prefix "cached-module-set!"
-  (let ((prev *top-val*))
-    (assert-equal (1+ prev)
-                  (let ((make-top-incrementor
-                         (assemble-program
-                          '((begin-program make-top-incrementor
-                                           ((name . make-top-incrementor)))
-                            (begin-standard-arity () 2 #f)
-                            (load-static-procedure 0 top-incrementor)
-                            (return-values 2)
-                            (end-arity)
-                            (end-program)
-
-                            (begin-program top-incrementor
-                                           ((name . top-incrementor)))
-                            (begin-standard-arity () 3 #f)
-                            (cached-module-box 1 (tests bytecode) *top-val* #f #t)
-                            (box-ref 0 1)
-                            (add/immediate 0 0 1)
-                            (box-set! 1 0)
-                            (mov 1 0)
-                            (return-values 2)
-                            (end-arity)
-                            (end-program)))))
-                    ((make-top-incrementor))
-                    *top-val*))))
-
 (with-test-prefix "debug contexts"
   (let ((return-3 (assemble-program
                    '((begin-program return-3 ((name . return-3)))
-                     (begin-standard-arity () 2 #f)
+                     (begin-standard-arity #t () 1 #f)
                      (load-constant 0 3)
-                     (return-values 2)
+                     (return-values)
                      (end-arity)
                      (end-program)))))
     (pass-if "program name"
@@ -365,9 +227,9 @@ a procedure."
       (procedure-name
        (assemble-program
         '((begin-program foo ((name . foo)))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program))))))
 
@@ -376,22 +238,23 @@ a procedure."
       (object->string
        (assemble-program
         '((begin-program foo ((name . foo)))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (definition closure 0 scm)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program)))))
   (pass-if-equal "#<procedure foo (x y)>"
       (object->string
        (assemble-program
         '((begin-program foo ((name . foo)))
-          (begin-standard-arity (x y) 3 #f)
+          (begin-standard-arity #t (x y) 3 #f)
           (definition closure 0 scm)
           (definition x 1 scm)
           (definition y 2 scm)
-          (load-constant 1 42)
-          (return-values 2)
+          (load-constant 2 42)
+          (reset-frame 1)
+          (return-values)
           (end-arity)
           (end-program)))))
 
@@ -399,13 +262,14 @@ a procedure."
       (object->string
        (assemble-program
         '((begin-program foo ((name . foo)))
-          (begin-opt-arity (x) (y) z 4 #f)
+          (begin-opt-arity #t (x) (y) z 4 #f)
           (definition closure 0 scm)
           (definition x 1 scm)
           (definition y 2 scm)
           (definition z 3 scm)
-          (load-constant 2 42)
-          (return-values 2)
+          (load-constant 3 42)
+          (reset-frame 1)
+          (return-values)
           (end-arity)
           (end-program))))))
 
@@ -414,9 +278,9 @@ a procedure."
       (procedure-documentation
        (assemble-program
         '((begin-program foo ((name . foo) (documentation . "qux qux")))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program))))))
 
@@ -426,9 +290,9 @@ a procedure."
       (procedure-properties
        (assemble-program
         '((begin-program foo ())
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program)))))
 
@@ -438,9 +302,9 @@ a procedure."
       (procedure-properties
        (assemble-program
         '((begin-program foo ((name . foo) (documentation . "qux qux")))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program)))))
 
@@ -453,9 +317,9 @@ a procedure."
         '((begin-program foo ((name . foo)
                               (documentation . "qux qux")
                               (moo . "mooooooooooooo")))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program)))))
 
@@ -466,8 +330,8 @@ a procedure."
         '((begin-program foo ((name . foo)
                               (documentation . "qux qux")
                               (moo . "mooooooooooooo")))
-          (begin-standard-arity () 2 #f)
+          (begin-standard-arity #t () 1 #f)
           (load-constant 0 42)
-          (return-values 2)
+          (return-values)
           (end-arity)
           (end-program))))))
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 3258feb61..32c9b9ef3 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -1,8 +1,8 @@
 ;;;; strings.test --- test suite for Guile's string functions    -*- scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999
 ;;;;
-;;;; Copyright (C) 1999, 2001, 2004-2006, 2008-2011, 2013,
-;;;;   2015 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999,2001,2004-2006,2008-2011,2013,2015,2018
+;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -26,10 +26,6 @@
   (cons 'misc-error "^string is read-only"))
 (define exception:illegal-escape
   (cons 'read-error "illegal character in escape sequence"))
-;; Wrong types may have either the 'wrong-type-arg key when
-;; interpreted or 'vm-error when compiled.  This matches both.
-(define exception:wrong-type-arg
-  (cons #t "Wrong type"))
 
 ;; Create a string from integer char values, eg. (string-ints 65) => "A"
 (define (string-ints . args)
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index c18e42194..3cbc67db3 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -27,7 +27,7 @@
 ;;;
 
 (define ball-root
-  (make-vtable (string-append standard-vtable-fields "pr") 0))
+  (make-vtable (string-append standard-vtable-fields "pw") 0))
 
 (define (make-ball-type ball-color)
   (make-struct/no-tail ball-root
@@ -69,13 +69,7 @@
 	  ;; end of the vtable tower
 	  (eq? (struct-vtable <standard-vtable>) <standard-vtable>)))
 
-  (pass-if-exception "write-access denied"
-     exception:struct-set!-denied
-
-     ;; The first field of instances of BALL-ROOT is read-only.
-     (struct-set! red vtable-offset-user "blue"))
-
-  (pass-if "write-access granted"
+  (pass-if "write"
      (set-owner! (make-ball red "Bob") "Fred")
      #t)
 
@@ -98,7 +92,7 @@
 
   (pass-if-exception "struct-ref out-of-range"
      exception:out-of-range
-     (let* ((v (make-vtable "prpr"))
+     (let* ((v (make-vtable "pwpw"))
             (s (make-struct/no-tail v 'a 'b)))
        (struct-ref s 2)))
 
@@ -112,7 +106,7 @@
 (with-test-prefix "equal?"
 
   (pass-if "simple structs"
-     (let* ((vtable (make-vtable "pr"))
+     (let* ((vtable (make-vtable "pw"))
             (s1     (make-struct/no-tail vtable "hello"))
             (s2     (make-struct/no-tail vtable "hello")))
        (equal? s1 s2)))
@@ -130,21 +124,21 @@
 (with-test-prefix "hash"
 
   (pass-if "simple structs"
-    (let* ((v  (make-vtable "pr"))
+    (let* ((v  (make-vtable "pw"))
            (s1 (make-struct/no-tail v "hello"))
            (s2 (make-struct/no-tail v "hello")))
       (= (hash s1 7777) (hash s2 7777))))
 
   (pass-if "different structs"
-    (let* ((v  (make-vtable "pr"))
+    (let* ((v  (make-vtable "pw"))
            (s1 (make-struct/no-tail v "hello"))
            (s2 (make-struct/no-tail v "world")))
       (or (not (= (hash s1 7777) (hash s2 7777)))
           (throw 'unresolved))))
 
   (pass-if "different struct types"
-    (let* ((v1 (make-vtable "pr"))
-           (v2 (make-vtable "pr"))
+    (let* ((v1 (make-vtable "pw"))
+           (v2 (make-vtable "pw"))
            (s1 (make-struct/no-tail v1 "hello"))
            (s2 (make-struct/no-tail v2 "hello")))
       (or (not (= (hash s1 7777) (hash s2 7777)))
@@ -156,7 +150,7 @@
       (= (hash s1 7777) (hash s2 7777))))
 
   (pass-if "struct with weird fields"
-    (let* ((v  (make-vtable "prurph"))
+    (let* ((v  (make-vtable "pwuwph"))
            (s1 (make-struct/no-tail v "hello" 123 "invisible-secret1"))
            (s2 (make-struct/no-tail v "hello" 123 "invisible-secret2")))
       (= (hash s1 7777) (hash s2 7777))))
@@ -191,7 +185,7 @@
 (with-test-prefix "make-vtable"
 
   (pass-if "without printer"
-    (let* ((vtable (make-vtable "pwpr"))
+    (let* ((vtable (make-vtable "pwpw"))
 	   (struct (make-struct/no-tail vtable 'x 'y)))
       (and (eq? 'x (struct-ref struct 0))
 	   (eq? 'y (struct-ref struct 1)))))
@@ -201,7 +195,7 @@
       (define (print struct port)
 	(display "hello" port))
 	
-      (let* ((vtable (make-vtable "pwpr" print))
+      (let* ((vtable (make-vtable "pwpw" print))
 	     (struct (make-struct/no-tail vtable 'x 'y))
 	     (str    (call-with-output-string
 		      (lambda (port)