diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
new file mode 100644
index 0000000..1308836
--- /dev/null
+++ b/.github/workflows/test.yml
@@ -0,0 +1,66 @@
+name: Test
+
+on:
+  workflow_dispatch:
+  push:
+    branches: [ main ]
+  pull_request:
+
+jobs:
+  test:
+    name: ${{ matrix.host }} / ${{ matrix.mode }}
+
+    defaults:
+      run:
+        shell: bash -l {0}
+
+    strategy:
+      fail-fast: false
+      matrix:
+        host:
+        - sbcl # non-sbcl hosts would require more changes below
+        mode:
+        - native
+        - cross
+
+    runs-on: ubuntu-22.04
+
+    steps:
+    - name: Install SBCL
+      if: matrix.host == 'sbcl'
+      run: |
+        sudo apt-get update
+        sudo apt install -y sbcl
+
+    - name: Install Quicklisp
+      run: |
+        curl -kLO https://beta.quicklisp.org/quicklisp.lisp
+        sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))"
+    
+    - name: Checkout repository
+      uses: actions/checkout@v4
+      with:
+        path: cvm
+
+# Clostrum is not in Quicklisp as of now, so get it from github.
+
+    - name: Checkout Clostrum
+      uses: actions/checkout@v4
+      with:
+        repository: s-expressionists/Clostrum
+        path: Clostrum
+
+    - name: Configure ASDF to find everything
+      run: |
+        mkdir -p $HOME/.config/common-lisp/source-registry.conf.d
+        echo "(:TREE #P\"${{ github.workspace }}/\")" > $HOME/.config/common-lisp/source-registry.conf.d/cvm.conf
+
+    - name: Run native client tests
+      if: matrix.mode == 'native'
+      run: |
+        sbcl --load "${{ github.workspace }}/cvm/test/script.lisp"
+
+    - name: Run cross client tests
+      if: matrix.mode == 'cross'
+      run: |
+        sbcl --load "${{ github.workspace }}/cvm/test/cross/script.lisp"
diff --git a/Cross/vm.lisp b/Cross/vm.lisp
index b704597..a54d0cb 100644
--- a/Cross/vm.lisp
+++ b/Cross/vm.lisp
@@ -1,6 +1,7 @@
 (defpackage #:cvm.cross.vm
   (:use #:cl)
-  (:local-nicknames (#:m #:cvm.machine))
+  (:local-nicknames (#:m #:cvm.machine)
+                    (#:arg #:cvm.argparse))
   (:export #:initialize-vm)
   (:export #:*trace*)
   (:export #:symbol-cell))
@@ -106,13 +107,24 @@
   (let ((cell (symbol-cell symbol global-cell)))
     (setf (car cell) new)))
 
-(defvar *dynenv* nil)
+(define-condition out-of-extent-unwind (control-error)
+  ())
+
+(defun exit-to (vm entry-dynenv new-ip)
+  ;; Make sure the entry is still on the DE stack.
+  ;; If it is, reset the DE stack, and throw.
+  ;; Otherwise complain.
+  (let ((old-de-stack (member entry-dynenv (vm-dynenv-stack vm))))
+    (when (null old-de-stack)
+      (error 'out-of-extent-unwind))
+    (setf (vm-dynenv-stack vm) old-de-stack)
+    (throw (entry-dynenv-tag entry-dynenv) new-ip)))
 
 (defun instruction-trace (bytecode stack ip bp sp frame-size)
   (fresh-line *trace-output*)
   (let ((frame-end (+ bp frame-size))
         ;; skip package prefixes on inst names.
-        (*package* (find-package "CVM/MACHINE")))
+        (*package* (find-package "CVM.MACHINE")))
     (prin1 (list (m:disassemble-instruction bytecode ip)
                  bp
                  sp
@@ -184,6 +196,13 @@
            (error "Invalid bytecode: Reached end"))
          (when trace
            (instruction-trace bytecode stack ip bp sp frame-size))
+         ;; The catch is for NLX. Without NLX, a (go loop) at the
+         ;; bottom skips back up to the loop without setting IP.
+         ;; When something NLXs to this frame, we throw the new IP
+         ;; to the tag, set the IP, and then jump up to the loop.
+         ;; We use CATCH instead of BLOCK on the theory that BLOCK
+         ;; will have to allocate each loop, but well, I suspect
+         ;; CATCH will too generally.
          (setf ip
                (catch tag
                  (ecase (code)
@@ -272,20 +291,23 @@
                    ((#.m:check-arg-count-<=)
                     (let ((n (next-code)))
                       (unless (<= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need at most ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :max-nargs n)))
                     (incf ip))
                    ((#.m:check-arg-count->=)
                     (let ((n (next-code)))
                       (unless (>= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need at least ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :min-nargs n)))
                     (incf ip))
                    ((#.m:check-arg-count-=)
                     (let ((n (next-code)))
                       (unless (= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need exactly ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :min-nargs n :max-nargs n)))
                     (incf ip))
                    ((#.m:jump-if-supplied-8)
                     (incf ip (if (typep (stack (+ bp (next-code))) 'unbound-marker)
@@ -343,7 +365,7 @@
                            (key-literal-start (next-code))
                            (key-literal-end (+ key-literal-start key-count))
                            (key-frame-start (+ bp (next-code)))
-                           (unknown-key-p nil)
+                           (unknown-keys nil)
                            (allow-other-keys-p nil))
                       ;; Initialize all key values to #<unbound-marker>
                       (loop for index from key-frame-start below (+ key-frame-start key-count)
@@ -353,30 +375,35 @@
                             ((< arg-index more-start)
                              (cond ((= arg-index (1- more-start)))
                                    ((= arg-index (- more-start 2))
-                                    (error "Passed odd number of &KEY args!"))
+                                    (error 'arg:odd-keywords))
                                    (t
                                     (error "BUG! This can't happen!"))))
                           (let ((key (stack (1- arg-index))))
-                            (if (eq key :allow-other-keys)
-                                (setf allow-other-keys-p (stack arg-index))
-                                (loop for key-index from key-literal-start
-                                        below key-literal-end
-                                      for offset of-type (unsigned-byte 16)
-                                      from key-frame-start
-                                      do (when (eq (constant key-index) key)
-                                           (setf (stack offset) (stack arg-index))
-                                           (return))
-                                      finally (setf unknown-key-p key))))))
+                            (when (eq key :allow-other-keys)
+                              (setf allow-other-keys-p (stack arg-index)))
+                            (loop for key-index from key-literal-start
+                                    below key-literal-end
+                                  for offset of-type (unsigned-byte 16)
+                                  from key-frame-start
+                                  do (when (eq (constant key-index) key)
+                                       (setf (stack offset) (stack arg-index))
+                                       (return))
+                                  finally (unless (or allow-other-keys-p
+                                                      (eq key :allow-other-keys))
+                                            (push key unknown-keys))))))
                       (when (and (not (or (logbitp 7 key-count-info)
                                           allow-other-keys-p))
-                                 unknown-key-p)
-                        (error "Unknown key arg ~a!" unknown-key-p)))
+                                 unknown-keys)
+                        (error 'arg:unrecognized-keyword-argument
+                               :unrecognized-keywords unknown-keys)))
                     (incf ip))
                    ((#.m:save-sp)
-                    (setf (stack (+ bp (next-code))) sp)
+                    (setf (stack (+ bp (next-code)))
+                          (list sp (vm-dynenv-stack vm)))
                     (incf ip))
                    ((#.m:restore-sp)
-                    (setf sp (stack (+ bp (next-code))))
+                    (setf (values sp (vm-dynenv-stack vm))
+                          (values-list (stack (+ bp (next-code)))))
                     (incf ip))
                    ((#.m:entry)
                     (let ((de (make-entry-dynenv tag)))
@@ -415,13 +442,13 @@
                     (return))
                    ((#.m:exit-8)
                     (incf ip (next-code-signed))
-                    (throw (entry-dynenv-tag (spop)) ip))
+                    (exit-to vm (spop) ip))
                    ((#.m:exit-16)
                     (incf ip (next-code-signed-16))
-                    (throw (entry-dynenv-tag (spop)) ip))
+                    (exit-to vm (spop) ip))
                    ((#.m:exit-24)
                     (incf ip (next-code-signed-24))
-                    (throw (entry-dynenv-tag (spop)) ip))
+                    (exit-to vm (spop) ip))
                    ((#.m:entry-close)
                     (pop (vm-dynenv-stack vm))
                     (incf ip))
@@ -495,7 +522,8 @@
                       (#.m:const
                        (spush (constant (+ (next-code) (ash (next-code) 8))))
                        (incf ip)))))
-                 (go loop)))))))
+                 (go loop)))
+         (go loop)))))
 
 (defmethod m:compute-instance-function ((client cvm.cross:client)
                                         (closure m:bytecode-closure))
diff --git a/arg-conditions.lisp b/arg-conditions.lisp
new file mode 100644
index 0000000..4d2cffe
--- /dev/null
+++ b/arg-conditions.lisp
@@ -0,0 +1,50 @@
+(defpackage #:cvm.argparse
+  (:use #:cl)
+  (:export #:argument-error
+           #:wrong-number-of-arguments #:odd-keywords
+           #:unrecognized-keyword-argument)
+  (:export #:parse-macro))
+
+(in-package #:cvm.argparse)
+
+;;; abstract parent type for errors signaled by lambda list processing
+(define-condition argument-error (program-error)
+  ((%called-function :initform nil :initarg :called-function
+                     :reader called-function)))
+
+;;; nabbed from clasp
+(define-condition wrong-number-of-arguments (argument-error)
+  ((%given-nargs :initarg :given-nargs :reader given-nargs)
+   (%min-nargs :initarg :min-nargs :reader min-nargs :initform nil)
+   (%max-nargs :initarg :max-nargs :reader max-nargs :initform nil))
+  (:report (lambda (condition stream)
+             (let* ((min (min-nargs condition))
+                    (max (max-nargs condition))
+                    ;; FIXME: get an actual name if possible
+                    (dname nil))
+               (format stream "~@[Calling ~a - ~]Got ~d arguments, but expected ~@?"
+                       dname (given-nargs condition)
+                       (cond ((null max)  "at least ~d")
+                             ((null min)  "at most ~*~d")
+                             ;; I think "exactly 0" is better than "at most 0", thus duplication
+                             ((= min max) "exactly ~d")
+                             ((zerop min) "at most ~*~d")
+                             (t           "between ~d and ~d"))
+                       min max)))))
+
+(define-condition odd-keywords (argument-error)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "Odd number of keyword arguments~:[~; for ~s~]."
+                     (called-function condition)
+                     ;; FIXME: again, get an actual name somehow.
+                     nil))))
+
+(define-condition unrecognized-keyword-argument (argument-error)
+  ((%unrecognized-keywords :initarg :unrecognized-keywords
+                           :reader unrecognized-keywords))
+  (:report (lambda (condition stream)
+             (format stream "Unrecognized keyword arguments ~S~:[~; for ~S~]."
+                     (unrecognized-keywords condition)
+                     (called-function condition) ; FIXME: name
+                     nil))))
diff --git a/cmpltv.lisp b/cmpltv.lisp
index 1d2a2b2..ff40670 100644
--- a/cmpltv.lisp
+++ b/cmpltv.lisp
@@ -1,6 +1,7 @@
 (defpackage #:cvm.compile-file
   (:use #:cl)
-  (:local-nicknames (#:cmp #:cvm.compile))
+  (:local-nicknames (#:cmp #:cvm.compile)
+                    (#:arg #:cvm.argparse))
   (:shadow #:compile-file #:macroexpand-1 #:macroexpand)
   (:export #:with-constants
            #:ensure-constant #:add-constant #:find-constant-index)
@@ -1263,13 +1264,13 @@
       (bytecode-compile-toplevel-progn body new-env))))
 
 (defun bytecode-compile-toplevel-macrolet (bindings body env)
-  (let ((macros nil))
+  (let ((macros nil)
+        (aenv (cmp:lexenv-for-macrolet env)))
     (dolist (binding bindings)
       (let* ((name (car binding)) (lambda-list (cadr binding))
              (body (cddr binding))
-             (eform (trivial-cltl2:parse-macro name lambda-list body env))
-             (aenv (cmp:lexenv-for-macrolet env))
-             (expander (cmp:compile eform aenv))
+             (expander (cmp:compute-macroexpander
+                        name lambda-list body aenv))
              (info (cmp:make-local-macro name expander)))
         (push (cons name info) macros)))
     (bytecode-compile-toplevel-locally
diff --git a/compile.lisp b/compile.lisp
index 4eb3777..b5440c8 100644
--- a/compile.lisp
+++ b/compile.lisp
@@ -1,12 +1,14 @@
 (defpackage #:cvm.compile
   (:use #:cl)
-  (:local-nicknames (#:m #:cvm.machine))
+  (:local-nicknames (#:m #:cvm.machine)
+                    (#:arg #:cvm.argparse))
   (:shadow #:compile #:eval #:constantp)
   (:export #:compile-into #:compile #:eval)
   ;; Compiler guts - used in cmpltv
   (:export #:add-specials #:extract-specials #:lexenv-for-macrolet
            #:make-lexical-environment #:make-local-macro #:make-symbol-macro
-           #:coerce-to-lexenv #:funs #:vars)
+           #:coerce-to-lexenv #:funs #:vars
+           #:compute-macroexpander)
   (:export #:var-info #:fun-info #:expand #:symbol-macro-expansion)
   (:export #:load-literal-info)
   (:export #:ltv-info #:ltv-info-form #:ltv-info-read-only-p)
@@ -492,12 +494,36 @@
 ;;; environments are necessarily ours (they include bytecode-specific
 ;;; information, etc.)
 ;;; But we do fall back to it when we hit the global environment.
+;;; And we define the methods, to be nice to macros, so maybe we
+;;; should use it internally after all.
+;;; TODO: Once trucler actually implements augmentation we should
+;;; maybe use that and not have our own environments at all.
+
+(defmethod trucler:describe-variable
+    (client (env lexical-environment) name)
+  (or (cdr (assoc name (vars env)))
+      (trucler:describe-variable client
+                                 (global-environment env) name)))
+
+(defmethod trucler:describe-function
+    (client (env lexical-environment) name)
+  (or (cdr (assoc name (funs env) :test #'equal))
+      (trucler:describe-variable client
+                                 (global-environment env) name)))
+
+(defmethod trucler:describe-block
+    (client (env lexical-environment) name)
+  (cdr (assoc name (blocks env))))
+
+(defmethod trucler:describe-tag
+    (client (env lexical-environment) name)
+  (cdr (assoc name (tags env))))
 
 (defun var-info (name env)
   (or (cdr (assoc name (vars env)))
       (trucler:describe-variable m:*client* (global-environment env) name)))
 (defun fun-info (name env)
-  (or (cdr (assoc name (funs env)))
+  (or (cdr (assoc name (funs env) :test #'equal))
       (trucler:describe-function m:*client* (global-environment env) name)))
 
 ;; never actually called
@@ -557,9 +583,6 @@
 (defun constantp (symbol env)
   (typep (var-info symbol env) 'trucler:constant-variable-description))
 
-(defun specialp (symbol env)
-  (typep (var-info symbol env) 'trucler:special-variable-description))
-
 (defun globally-special-p (symbol env)
   (typep (var-info symbol env) 'trucler:global-special-variable-description))
 
@@ -641,7 +664,10 @@
 
 ;;; As CL:COMPILE, but doesn't mess with function bindings.
 (defun compile (lambda-expression &optional env (m:*client* m:*client*))
-  (link-function (compile-into (make-cmodule) lambda-expression env) env))
+  (link-function (compile-into (make-cmodule) lambda-expression env)
+                 (if (lexical-environment-p env)
+                     (global-environment env)
+                     env)))
 
 ;;; As CL:EVAL.
 (defun eval (form &optional env (m:*client* m:*client*))
@@ -688,6 +714,7 @@
           (t
            (setf (closed-over-p info) t)
            (assemble context m:closure (closure-index info context))))
+    (maybe-emit-cell-ref info context)
     (when (eql (context-receiving context) 't)
       (assemble context m:pop))))
 
@@ -797,23 +824,20 @@
 
 ;;; Add VARS as specials in ENV.
 (defun add-specials (vars env)
-  (do* ((evars (vars env))
-        (ivars vars (rest ivars))
-        (new-vars
-         evars
-         (let* ((var (first ivars))
-                (desc (trucler:describe-variable m:*client* env var))
-                (specialp (typep desc 'trucler:special-variable-description)))
-           (if specialp
-               new-vars ; already present
-               (acons var (make-instance
-                              'trucler:local-special-variable-description
-                            :name var)
-                      new-vars)))))
-       ((endp ivars)
-        (if (eq new-vars evars) ; nothing added
-            env           
-            (make-lexical-environment env :vars new-vars)))))
+  (let* ((existing (vars env))
+         (new-vars existing))
+    (loop for var in vars
+          for desc = (trucler:describe-variable m:*client* env var)
+          for specialp
+            = (typep desc 'trucler:special-variable-description)
+          unless specialp ; already covered
+            do (push (cons var (make-instance
+                                   'trucler:local-special-variable-description
+                                 :name var))
+                     new-vars))
+    (if (eq new-vars existing) ; nothing added
+        env
+        (make-lexical-environment env :vars new-vars))))
 
 (defun extract-specials (declarations)
   (let ((specials '()))
@@ -897,10 +921,13 @@
 (defmethod compile-special ((operator (eql 'flet)) form env context)
   (destructuring-bind (definitions . body) (rest form)
     (loop for (name lambda-list . body) in definitions
-          do (compile-lambda-expression
-              `(lambda ,lambda-list
-                 (block ,(fun-name-block-name name) (locally ,@body)))
-              env context))
+          do (multiple-value-bind (body decls)
+                 (alexandria:parse-body body :documentation t)
+               (compile-lambda-expression
+                `(lambda ,lambda-list
+                   ,@decls
+                   (block ,(fun-name-block-name name) ,@body))
+                env context)))
     (emit-bind context (length definitions) (context-frame-end context))
     (multiple-value-call #'compile-locally body
       (bind-fvars (mapcar #'car definitions) env context))))
@@ -912,7 +939,13 @@
       (let* ((module (context-module context))
              (closures
                (loop for (name lambda-list . body) in definitions
-                     for fun = (compile-lambda lambda-list body new-env
+                     for bname = (fun-name-block-name name)
+                     for rbody
+                       = (multiple-value-bind (body decls)
+                             (alexandria:parse-body body
+                                                    :documentation t)
+                           `(,@decls (block ,bname ,@body)))
+                     for fun = (compile-lambda lambda-list rbody new-env
                                                module)
                      for literal-index = (cfunction-literal-index fun context)
                      if (zerop (length (cfunction-closed fun)))
@@ -1208,14 +1241,25 @@
                  collect pair)
    :tags nil :blocks nil))
 
+;;; Given the arguments to parse-macro, return a macroexpander,
+;;; i.e. an actual function. The environment must already be
+;;; stripped by lexenv-for-macrolet (so that this can be done once
+;;; for multiple definitions).
+;;; Also used in cmpltv.
+(defun compute-macroexpander (name lambda-list body env)
+  ;; see comment in parse-macro for explanation
+  ;; as to how we're using the host here
+  (cl:compile nil (arg:parse-macro name lambda-list body env
+                                   #'compile)))
+
 (defmethod compile-special ((op (eql 'macrolet)) form env context)
   (let* ((bindings (second form)) (body (cddr form))
          (macros
            (loop with env = (lexenv-for-macrolet env)
                  for (name lambda-list . body) in bindings
-                 for macro-lexpr
-                   = (trivial-cltl2:parse-macro name lambda-list body)
-                 for info = (make-local-macro name (compile macro-lexpr env))
+                 for macrof = (compute-macroexpander
+                               name lambda-list body env)
+                 for info = (make-local-macro name macrof)
                  collect (cons name info))))
     (compile-locally body (make-lexical-environment
                            env :funs (append macros (funs env)))
@@ -1236,9 +1280,17 @@
      (compile-form `(fdefinition ,form) env (new-context context :receiving 1)))
     (t
      (let* ((fsym (gensym "FUNCTION-DESIGNATOR"))
-            (form `(etypecase ,fsym
-                     (function ,fsym)
-                     (symbol (fdefinition ,fsym)))))
+            ;; Try to avoid using macros (etypecase) for the sake of
+            ;; compatibility with a native client. For example, SBCL's
+            ;; COND cannot be macroexpanded in our environments.
+            ;; TODO: Newer VM version makes this a VM operation.
+            (form `(let ((,fsym ,form))
+                     (if (functionp ,fsym)
+                         ,fsym
+                         (if (symbolp ,fsym)
+                             (fdefinition ,fsym)
+                             (error 'type-error :datum ,fsym
+                                    :expected-type '(or symbol function)))))))
        (compile-form form env (new-context context :receiving 1))))))
 
 (defmethod compile-special ((op (eql 'multiple-value-call)) form env context)
@@ -1289,7 +1341,7 @@
 ;;; corresponding suppliedp var for each optional/key.
 (defun compile-with-lambda-list (lambda-list body env context)
   (multiple-value-bind (body decls)
-      (alexandria:parse-body body)
+      (alexandria:parse-body body :documentation t)
     (multiple-value-bind (required optionals rest keys aok-p aux key-p)
         (alexandria:parse-ordinary-lambda-list lambda-list)
       (let* ((function (context-function context))
@@ -1299,7 +1351,9 @@
              (max-count (+ min-count optional-count))
              (key-count (length keys))
              (more-p (or rest key-p))
-             new-env (context context)
+             new-env ; will be the body environment
+             default-env ; environment for compiling default forms
+             (context context)
              (specials (extract-specials decls))
              (special-binding-count 0)
              ;; An alist from optional and key variables to their local indices.
@@ -1322,7 +1376,8 @@
           (dolist (var required)
             ;; We account for special declarations in outer environments/globally
             ;; by checking the original environment - not our new one - for info.
-            (cond ((or (member var specials) (specialp var env))
+            (cond ((or (member var specials)
+                       (globally-special-p var env))
                    (let ((info (var-info var new-env)))
                      (assemble-maybe-long context m:ref (frame-offset info))
                      (emit-special-bind context var))
@@ -1330,6 +1385,9 @@
                   (t
                    (maybe-emit-encage (var-info var new-env) context))))
           (setq new-env (add-specials (intersection specials required) new-env)))
+        ;; set the default env to have all the requireds bound,
+        ;; but don't put in the optionals (yet).
+        (setq default-env new-env)
         (unless (zerop optional-count)
           ;; Generate code to bind the provided optional args; unprovided args will
           ;; be initialized with the unbound marker.
@@ -1343,21 +1401,14 @@
             ;; Add everything to opt-key-indices.
             (dolist (var optvars)
               (push (cons var (frame-offset (var-info var new-env)))
-                    opt-key-indices))
-            ;; Re-mark anything that's special in the outer context as such,
-            ;; so that default initforms properly treat them as special.
-            (let ((specials
-                    (remove-if-not
-                     (lambda (sym) (specialp sym env))
-                     optvars)))
-              (when specials
-                (setq new-env (add-specials specials new-env))))))
+                    opt-key-indices))))
         (when rest
           (assemble-maybe-long context m:listify-rest-args max-count)
           (assemble-maybe-long context m:set (context-frame-end context))
           (setf (values new-env context)
                 (bind-vars (list rest) new-env context))
-          (cond ((or (member rest specials) (specialp rest env))
+          (cond ((or (member rest specials)
+                     (globally-special-p rest env))
                  (assemble-maybe-long
                   context m:ref (frame-offset (var-info rest new-env)))
                  (emit-special-bind context rest)
@@ -1379,11 +1430,7 @@
                   (bind-vars keyvars new-env context))
             (dolist (var keyvars)
               (let ((info (var-info var new-env)))
-                (push (cons var (frame-offset info)) opt-key-indices)))
-            (let ((specials (remove-if-not (lambda (sym) (specialp sym env))
-                                           keyvars)))
-              (when specials
-                (setq new-env (add-specials specials new-env))))))
+                (push (cons var (frame-offset info)) opt-key-indices)))))
         ;; Generate defaulting code for optional args, and special-bind them
         ;; if necessary.
         (unless (zerop optional-count)
@@ -1396,22 +1443,42 @@
             (destructuring-bind (optional-var defaulting-form supplied-var)
                 (first optionals)
               (let ((optional-special-p (or (member optional-var specials)
-                                            (specialp optional-var env)))
+                                            (globally-special-p optional-var env)))
                     (index (cdr (assoc optional-var opt-key-indices)))
                     (supplied-special-p
                       (and supplied-var
                            (or (member supplied-var specials)
-                               (specialp supplied-var env)))))
+                               (globally-special-p supplied-var env)))))
                 (setf (values new-env context)
                       (compile-optional/key-item optional-var defaulting-form
                                                  index
                                                  supplied-var next-optional-label
                                                  optional-special-p supplied-special-p
-                                                 context new-env))
+                                                 context new-env
+                                                 default-env))
+                ;; set the default env for later bindings.
+                (let* ((ovar (cons optional-var
+                                   (var-info optional-var new-env)))
+                       (svar (when supplied-var
+                               (cons supplied-var
+                                     (var-info supplied-var new-env))))
+                       (newvars
+                         (if svar (list svar ovar) (list ovar))))
+                  (setf default-env
+                        (make-lexical-environment
+                         default-env
+                         :vars (append newvars (vars default-env)))))
                 (when optional-special-p (incf special-binding-count))
                 (when supplied-special-p (incf special-binding-count))))))
         ;; Generate defaulting code for key args, and special-bind them if necessary.
         (when key-p
+          ;; Bind the rest parameter in the default env, if existent.
+          (when rest
+            (let ((rvar (cons rest (var-info rest new-env)))
+                  (old (vars default-env)))
+              (setf default-env
+                    (make-lexical-environment
+                     default-env :vars (cons rvar old)))))
           (do ((keys keys (rest keys))
                (key-label (make-label) next-key-label)
                (next-key-label (make-label) (make-label)))
@@ -1422,28 +1489,41 @@
               (declare (ignore key-name))
               (let ((index (cdr (assoc key-var opt-key-indices)))
                     (key-special-p (or (member key-var specials)
-                                       (specialp key-var env)))
+                                       (globally-special-p key-var env)))
                     (supplied-special-p
                       (and supplied-var
                            (or (member supplied-var specials)
-                               (specialp supplied-var env)))))
+                               (globally-special-p supplied-var env)))))
                 (setf (values new-env context)
                       (compile-optional/key-item key-var defaulting-form index
                                                  supplied-var next-key-label
                                                  key-special-p supplied-special-p
-                                                 context new-env))
+                                                 context new-env
+                                                 default-env))
+                ;; set the default env for later bindings.
+                (let* ((ovar (cons key-var
+                                   (var-info key-var new-env)))
+                       (svar (when supplied-var
+                               (cons supplied-var
+                                     (var-info supplied-var new-env))))
+                       (newvars
+                         (if svar (list svar ovar) (list ovar))))
+                  (setf default-env
+                        (make-lexical-environment
+                         default-env
+                         :vars (append newvars (vars default-env)))))
                 (when key-special-p (incf special-binding-count))
                 (when supplied-special-p (incf special-binding-count))))))
         ;; Generate aux and the body as a let*.
         ;; We repeat the special declarations so that let* will know the auxs
         ;; are special, and so that any free special declarations are processed.
-        (compile-let* aux `((special ,@specials)) body new-env context)
+        (compile-let* aux `((declare (special ,@specials))) body new-env context)
         (emit-unbind context special-binding-count)))))
 
 ;;; Compile an optional/key item and return the resulting environment
 ;;; and context.
 (defun compile-optional/key-item (var defaulting-form var-index supplied-var next-label
-                                  var-specialp supplied-specialp context env)
+                                  var-specialp supplied-specialp context env default-env)
   (flet ((default (suppliedp specialp var info)
            (cond (suppliedp
                   (cond (specialp
@@ -1452,7 +1532,12 @@
                         (t
                          (maybe-emit-encage info context))))
                  (t
-                  (compile-form defaulting-form env
+                  ;; We compile in default-env but also context.
+                  ;; The context already has space allocated for all
+                  ;; the later lexical parameters, which have already
+                  ;; been bound. Thus, we ensure that no bindings
+                  ;; in the default form clobber later parameters.
+                  (compile-form defaulting-form default-env
                                 (new-context context :receiving 1))
                   (cond (specialp
                          (emit-special-bind context var))
@@ -1651,10 +1736,13 @@
     ;; Now replace the cfunctions in the cmodule literal vector with
     ;; real bytecode functions.
     ;; Also replace the load-time-value infos with the evaluated forms.
-    (map-into literals (lambda (info) (load-literal-info client info env))
+    (map-into literals
+              (lambda (info) (load-literal-info client info env))
               cmodule-literals))
   (values))
 
+;;; Given a cfunction, link constants and return an actual function.
+;;; ENV must be a global environment.
 (defun link-function (cfunction env)
   (link-load (cfunction-cmodule cfunction) env)
   (cfunction-info cfunction))
diff --git a/cvm.asd b/cvm.asd
index 1bfb6c3..437a140 100644
--- a/cvm.asd
+++ b/cvm.asd
@@ -6,11 +6,68 @@
   :maintainer "Bike <aeshtaer@gmail.com>"
   :version "0.5.0"
   :depends-on (:closer-mop ; machine
-               :alexandria :trucler :trivial-cltl2 ; compiler
+               :alexandria :trucler :ecclesia ; compiler
                :ieee-floats) ; compile-file
   :components ((:file "machine")
+               (:file "arg-conditions")
+               (:file "parse-macro" :depends-on ("arg-conditions"))
                (:file "structures" :depends-on ("machine"))
                (:file "disassemble" :depends-on ("structures" "machine"))
-               (:file "compile" :depends-on ("structures" "machine"))
+               (:file "compile" :depends-on ("parse-macro"
+                                             "structures" "machine"))
                (:file "cmpltv" :depends-on ("compile"))
-               (:file "vm" :depends-on ("disassemble" "structures" "machine"))))
+               (:file "vm" :depends-on ("arg-conditions" "disassemble"
+                                        "structures" "machine"))))
+
+(asdf:defsystem #:cvm/test
+  :author ("Bike <aeshtaer@gmail.com>")
+  :maintainer "Bike <aeshtaer@gmail.com>"
+  :depends-on (:cvm :fiveam)
+  :components
+  ((:module "test"
+    :components ((:file "packages")
+                 (:file "suites" :depends-on ("packages"))
+                 (:file "rt" :depends-on ("packages"))
+                 (:file "native-sham" :depends-on ("rt" "packages"))
+                 (:module "ansi"
+                  :depends-on ("suites" "rt" "packages")
+                  ;; These can be loaded in any order.
+                  :components (;; eval-and-compile
+                               (:file "compile")
+                               (:file "dynamic-extent")
+                               (:file "eval")
+                               (:file "eval-when")
+                               (:file "ignorable")
+                               (:file "ignore")
+                               (:file "lambda")
+                               (:file "locally")
+                               (:file "optimize")
+                               (:file "special")
+                               (:file "symbol-macrolet")
+                               (:file "the")
+                               (:file "type")
+                               ;; data-and-control-flow
+                               (:file "block")
+                               (:file "flet")
+                               (:file "if")
+                               (:file "labels")
+                               (:file "let")
+                               (:file "letstar")
+                               (:file "macrolet")
+                               (:file "multiple-value-call")
+                               (:file "multiple-value-prog1")
+                               (:file "progn")
+                               (:file "return-from")
+                               (:file "tagbody")))))))
+
+(asdf:defsystem #:cvm/test/cross
+  :author ("Bike <aeshtaer@gmail.com>")
+  :maintainer "Bike <aeshtaer@gmail.com>"
+  :depends-on (:cvm/test :cvm-cross :clostrum)
+  :components
+  ((:module "test"
+    :components ((:module "cross"
+                  :components ((:file "packages")
+                               (:file "sham" :depends-on ("packages"))
+                               (:file "rt" :depends-on ("sham"
+                                                        "packages"))))))))
diff --git a/parse-macro.lisp b/parse-macro.lisp
new file mode 100644
index 0000000..98a8b6b
--- /dev/null
+++ b/parse-macro.lisp
@@ -0,0 +1,216 @@
+(in-package #:cvm.argparse)
+
+#|
+Here's the skinny.
+Any lisp compiler needs to handle MACROLET. To handle macrolet, a compiler needs to be able to take the code for the local macro definitions, evaluate them _at compile time_, and get an _actual function it can call_ for macroexpansion. Furthermore the local macro definitions must be evaluated in the environment a compiler is working with - because for example macrolet definitions can refer to macros defined in outer macrolets.
+Plus, the local macro definitions have macro lambda lists, which can be quite complicated. When the macro runs it performs a complex destructuring operation that will in general involve complex loops and many function calls.
+Traditionally, this all is accomplished with a function called PARSE-MACRO. PARSE-MACRO takes as input the macro definition (lambda-list, body, etc.). It returns a lambda expression. The compiler then evaluates this lambda expression in its environment to get the function.
+This does not work for us. The reason lies in first class global environments. We want to support compilation in _any_ environment. If the environment contains MACROLET, compilation in it should work even if standard functions, macros, or even special operators are not available in that environment, or have different names, etc. Therefore, with the usual PARSE-MACRO approach, the form returned by PARSE-MACRO cannot contain any operators not intrinsic to evaluation, which means all you get is lambda forms - obviously not enough.
+Instead, what we do is use a _host_ function as our macroexpander. The compiler calls PARSE-MACRO and gets back a lambda expression. This lambda expression is then evaluated in a null lexical environment _in the host_ (e.g., by CL:COMPILE or CL:EVAL, rather than anything necessarily CVM related). The resulting function parses the macro arguments _with host code_, and therefore it doesn't matter what environment the compiler is working with.
+Of course, the actual macro body, as well as any default forms in the lambda list, must still be compiled by our compiler in the appropriate environment, rather than by the host. To accomplish this, PARSE-MACRO receives a callback, called COMPILER below. This is a function of two arguments, a lambda expression and a compiler environment. The function must compile the lambda in the environment and return a callable function.
+And here's the really funky part: PARSE-MACRO then includes this function as a literal object in the expression it returns. So the expression will have code looking something like `(funcall #<BYTECODE-FUNCTION ...> a b c)`. This lets the host function call our bytecode-compiled function even though they were compiled by completely different means in completely different kinds of environments. Literal functions are quite unusual in code, but since the macroexpander only needs to go through CL:COMPILE or CL:EVAL, and not CL:COMPILE-FILE (as macroexpanders are not dumped), this works out.
+End result: a callable host function that does lambda list processing independently of bytecode anything, but still calls into the bytecode when semantics demand it.
+
+FIXME: Currently PARSE-MACRO still expects CL:BLOCK to be defined standardly.
+|#
+
+;;; returns four values:
+;;; 1) a list of bindings in the host
+;;; 2) a list of variables to declare ignorable after those bindings
+;;; 3) a list of arguments in the host to the cross function
+;;; 4) a list of parameters for the cross function
+(defun process-lambda-list (lambda-list compiler environment
+                            target etarget toplevelp
+                            &optional arguments parameters)
+  (let* ((bindings nil) (ignorables nil)
+         (arguments arguments) (parameters parameters)
+         (whole (ecclesia:whole lambda-list))
+         (required (ecclesia:required lambda-list))
+         (nreq (length required))
+         (%optionals (ecclesia:optionals lambda-list))
+         ;; we treat () and (&optional) the same.
+         (optionals (if (eq %optionals :none) nil %optionals))
+         (nopt (length optionals))
+         (rest (ecclesia:rest-body lambda-list))
+         (restp (not (eq rest :none)))
+         (%keys (ecclesia:keys lambda-list))
+         (keysp (not (eq %keys :none)))
+         (keys (if keysp %keys nil))
+         (aokp (ecclesia:allow-other-keys lambda-list))
+         (nmax (if (or keysp restp) nil (+ nreq nopt)))
+         (nargs (gensym "NARGS"))
+         (%aux (ecclesia:aux lambda-list))
+         ;; and () and (&aux) the same
+         (aux (if (eq %aux :none) () %aux))
+         (eparam (ecclesia:environment lambda-list)))
+    (labels
+        ((destructure (sub-lambda-list new-target-form)
+           (let ((targ (gensym "SUBARGS"))
+                 ;; ecclesia sometimes returns lists
+                 ;; and other times returns a LAMBDA-LIST object.
+                 (sub-lambda-list
+                   (etypecase sub-lambda-list
+                     (list (ecclesia:parse-macro-lambda-list
+                            sub-lambda-list))
+                     (ecclesia:lambda-list sub-lambda-list))))
+             (push `(,targ ,new-target-form) bindings)
+             (push targ ignorables)
+             (multiple-value-bind (%binds %ign %args %params)
+                 (process-lambda-list sub-lambda-list
+                                      compiler environment
+                                      targ etarget nil
+                                      arguments parameters)
+               (setf bindings (append (reverse %binds) bindings)
+                     ignorables (append %ign ignorables)
+                     arguments (reverse %args)
+                     parameters (reverse %params)))))
+         (bind-presentp (listparam testf)
+           (if (null listparam)
+               ;; no -p provided: make one
+               (let ((-p (gensym "PRESENTP")))
+                 (push `(,-p ,testf) bindings)
+                 -p)
+               ;; provided: use it and add to args etc
+               (let* ((-p (first listparam))
+                      (s-p (gensym (symbol-name -p))))
+                 (push `(,s-p ,testf) bindings)
+                 (push s-p arguments)
+                 (push -p parameters)
+                 s-p)))
+         (bind (thing valuef)
+           (etypecase thing
+             ((or list ecclesia:lambda-list)
+              (destructure thing valuef))
+             (symbol (let ((arg (gensym (symbol-name thing))))
+                       (push `(,arg ,valuef) bindings)
+                       (push arg arguments)
+                       (push thing parameters)))))
+         (default (form)
+           (let* ((rparams (reverse parameters))
+                  (rargs (reverse arguments))
+                  (lexpr `(lambda (,@rparams)
+                            (declare (ignorable ,@rparams))
+                            ,form))
+                  (thunk (funcall compiler lexpr environment)))
+             `(funcall ,thunk ,@rargs))))
+      ;; Environment parameter
+      (unless (eq eparam :none) (bind eparam etarget))
+      ;; Whole parameter
+      (unless (eq whole :none) (bind whole target))
+      ;; If we're at toplevel, take the rest
+      (when toplevelp
+        (let ((new-target (gensym "ARGS")))
+          (push `(,new-target (rest ,target)) bindings)
+          (push new-target ignorables)
+          (setf target new-target)))
+      ;; Argument count
+      (push `(,nargs (length ,target)) bindings)
+      (push nargs ignorables)
+      ;; Push arg count checks if needed
+      ;; do this before evaluating any default forms, to be nice
+      (when (or (> nreq 0) nmax)
+        (let ((s (gensym "ARGCOUNT-CHECK")))
+          (push `(,s
+                  (unless (<= ,nreq ,nargs ,@(when nmax `(,nmax)))
+                    (error 'wrong-number-of-arguments
+                           :given-nargs ,nargs
+                           :min-nargs ,nreq
+                           ,@(when nmax `(:max-nargs ,nmax)))))
+                bindings)
+          (push s ignorables)))
+      (when keysp
+        (let ((s (gensym "EVEN-KEYS-CHECK")))
+          (push `(,s (unless (evenp (- ,nargs ,(+ nreq nopt)))
+                       (error 'odd-keywords)))
+                bindings)
+          (push s ignorables)))
+      ;; Required parameters
+      (loop for r in required
+            for i from 0
+            do (bind r `(nth ,i ,target)))
+      ;; Optional parameters
+      (loop for (o dform . -p) in optionals
+            for i from nreq
+            for def = (default dform)
+            for s-p = (bind-presentp -p `(> ,nargs ,i))
+            do (bind o `(if ,s-p (nth ,i ,target) ,def)))
+      ;; Rest parameter
+      (when restp (bind rest `(nthcdr ,(+ nreq nopt) ,target)))
+      ;; Key parameters
+      (when keysp
+        (let ((keytarg (gensym "KEYS")))
+          (push `(,keytarg (nthcdr ,(+ nreq nopt) ,target)) bindings)
+          (push keytarg ignorables)
+          ;; check for unknown keys
+          (unless aokp
+            (let ((key-check (gensym "UNKNOWN-KEYS-CHECK"))
+                  (valid-keys (mapcar #'caar keys)))
+              (push `(,key-check
+                      (check-keywords ',valid-keys ,keytarg))
+                    bindings)
+              (push key-check ignorables)))
+          ;; Bind keys
+          (loop for ((kw var) dform . -p) in keys
+                for def = (default dform)
+                for s-p = (bind-presentp -p `(keyword-presentp ',kw ,keytarg))
+                do (bind var `(if ,s-p (keyword-find ',kw ,keytarg) ,def)))))
+      ;; Aux parameters
+      (loop for (a dform) in aux
+            do (bind a (default dform))))
+    (values (reverse bindings) ignorables
+            (reverse arguments) (reverse parameters))))
+
+;;; Given the list of valid keys and a plist, signal an error if the
+;;; plist contains an invalid keyword, while respecting
+;;; that most fun of party tricks, :allow-other-keys.
+;;; It is guaranteed that plist is a list with an even length.
+;;; This function is only called when &allow-other-keys is
+;;; not present.
+;;; Return value undefined.
+(defun check-keywords (valid-keys plist)
+  (loop with seen-aok = nil ; see 3.4.1.4.1.1
+        for (key val) on plist by #'cddr
+        when (and (not seen-aok) (eq key :allow-other-keys))
+          do (when val
+               ;; we're not doing anything else with the keywords,
+               ;; so just leave
+               (return-from check-keywords))
+             (setf seen-aok t)
+        unless (or (member key valid-keys)
+                   (eq key :allow-other-keys)) ; always valid
+          collect key into unknown-keys
+        finally (when unknown-keys
+                  (error 'unrecognized-keyword-argument
+                         :unrecognized-keywords unknown-keys))))
+
+;;; Check if a keyword is in the plist. The plist is valid and has
+;;; even length.
+;;; Obviously it would be more efficient to check for presence and
+;;; get the value in one go, but this file is messy enough as-is.
+(defun keyword-presentp (key plist)
+  (loop for (pkey) on plist by #'cddr
+        when (eq key pkey)
+          return t
+        finally (return nil)))
+
+;;; Get the value associated with a keyword in the plist.
+;;; The plist is valid and has even length.
+(defun keyword-find (key plist) (getf plist key))
+
+(defun parse-macro (name lambda-list body environment compiler)
+  (multiple-value-bind (bindings ignorables arguments parameters)
+      (process-lambda-list
+       (ecclesia:parse-macro-lambda-list lambda-list)
+       compiler environment 'form 'environment t)
+    (multiple-value-bind (body decls)
+        (alexandria:parse-body body :documentation t)
+      (let ((bodyf (funcall compiler
+                            `(lambda (,@parameters)
+                               ,@decls
+                               (block ,name ,@body))
+                            environment)))
+        `(lambda (form environment)
+           (declare (ignorable environment))
+           (let* (,@bindings)
+             (declare (ignorable ,@ignorables))
+             (funcall ,bodyf ,@arguments)))))))
diff --git a/test/README b/test/README
new file mode 100644
index 0000000..2531301
--- /dev/null
+++ b/test/README
@@ -0,0 +1,7 @@
+This system runs a small subset of the ANSI tests directly related to evaluation semantics on the VM with a client and environment of your choice. This client and environment are passed through to cvm.compile functions and otherwise arbitrary.
+
+For example, to use the basic native client on SBCL, you could do:
+
+(run! nil (make-instance 'trucler-native-sbcl:client))
+
+Eventually there will be more tests, hopefully.
diff --git a/test/ansi/LICENSE b/test/ansi/LICENSE
new file mode 100644
index 0000000..6004d1c
--- /dev/null
+++ b/test/ansi/LICENSE
@@ -0,0 +1,20 @@
+Copyright 2004 Paul F. Dietz
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/test/ansi/block.lisp b/test/ansi/block.lisp
new file mode 100644
index 0000000..3960f7b
--- /dev/null
+++ b/test/ansi/block.lisp
@@ -0,0 +1,96 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Oct 12 12:30:46 2002
+;;;; Contains: Tests of BLOCK
+
+(in-package #:cvm.test)
+
+(5am:def-suite block :in data-and-control-flow)
+(5am:in-suite block)
+
+(deftest block.1
+  (block foo
+    (return-from foo 1))
+  1)
+
+(deftest block.2
+  (block nil
+    (block foo
+      (return 'good))
+    'bad)
+  good)
+
+(deftest block.3
+  (block done
+    (flet ((%f (x) (return-from done x)))
+      (%f 'good))
+    'bad)
+  good)
+
+(deftest block.4
+  (block foo
+    (block foo
+      (return-from foo 'bad))
+    'good)
+  good)
+
+(deftest block.5
+  (block done
+    (flet ((%f (x) (return-from done x)))
+      (mapcar #'%f '(good bad bad)))
+    'bad)
+  good)
+
+(deftest block.6
+  (block b1
+    (return-from b1 (values))
+    1))
+
+(deftest block.7
+  (block b1
+    (return-from b1 (values 1 2 3 4))
+    1)
+  1 2 3 4)
+
+(deftest block.8
+  (block foo)
+  nil)
+
+(deftest block.9
+  (block foo (values 'a 'b) (values 'c 'd))
+  c d)
+
+(deftest block.10
+  (block done
+    (flet ((%f (x) (return-from done x)))
+      (block done (mapcar #'%f '(good bad bad))))
+    'bad)
+  good)
+
+;;; Block has no tagbody
+(deftest block.11
+  (block done
+    (tagbody
+     (block nil
+       (go 10)
+       10
+       (return-from done 'bad))
+     10
+     (return-from done 'good)))
+  good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest block.12
+  (macrolet ((%m (z) z))
+    (block foo (s:expand-in-current-env (%m :good))))
+  :good)
+
+#|
+(deftest return.error.1
+  (signals-error
+   (block nil
+     (return 'a 'b))
+   program-error)
+  t)
+|#
diff --git a/test/ansi/compile.lisp b/test/ansi/compile.lisp
new file mode 100644
index 0000000..c437c93
--- /dev/null
+++ b/test/ansi/compile.lisp
@@ -0,0 +1,97 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Oct 10 20:54:20 2002
+;;;; Contains: Tests for COMPILE, COMPILED-FUNCTION-P, COMPILED-FUNCTION
+
+(in-package #:cvm.test)
+
+(5am:def-suite compile :in eval-and-compile)
+(5am:in-suite compile)
+
+#+(or)
+(deftest compile.1
+  (progn
+    (fmakunbound 'compile.1-fn)
+    (values
+     (eval '(defun compile.1-fn (x) x))
+     (compiled-function-p 'compile.1-fn)
+     (let ((x (compile 'compile.1-fn)))
+       (or (eqt x 'compile.1-fn)
+           (notnot (compiled-function-p x))))
+     (compiled-function-p 'compile.1-fn)
+     (not (compiled-function-p #'compile.1-fn))
+     (fmakunbound 'compile.1-fn)))
+  compile.1-fn
+  nil
+  t
+  nil
+  nil
+  compile.1-fn)
+
+;;; COMPILE returns three values (function, warnings-p, failure-p)
+#+(or)
+(deftest compile.2
+  (let* ((results (multiple-value-list
+                   (compile nil '(lambda (x y) (cons y x)))))
+         (fn (car results)))
+    (values (length results)
+            (funcall fn 'a 'b)
+            (second results)
+            (third results)))
+  3
+  (b . a)
+  nil
+  nil)
+
+;;; Compile does not coalesce literal constants
+(5am:test compile.3
+  (5am:is-false
+   (let ((x (list 'a 'b))
+         (y (list 'a 'b)))
+     (funcall (ccompile nil `(lambda () (eq ',x ',y)))))))
+
+(5am:test compile.4
+  (5am:is-false
+   (let ((x (copy-seq "abc"))
+         (y (copy-seq "abc")))
+     (funcall (ccompile nil `(lambda () (eq ,x ,y)))))))
+
+(5am:test compile.5
+  (5am:is-true
+   (let ((x (copy-seq "abc")))
+     (funcall (ccompile nil `(lambda () (eq ,x ,x)))))))
+
+(5am:test compile.6
+  (5am:is-true
+   (let ((x (copy-seq "abc")))
+     (funcall (ccompile nil `(lambda () (eq ',x ',x)))))))
+
+(5am:test compile.7
+  (let ((x (copy-seq "abc")))
+    (5am:is (eq x (funcall (ccompile nil `(lambda () ,x)))))))
+
+(5am:test compile.8
+  (let ((x (list 'a 'b)))
+    (5am:is (eq x (funcall (ccompile nil `(lambda () ',x)))))))
+
+#+(or)
+(deftest compile.9
+  (let ((i 0) a b)
+    (values
+     (funcall (compile (progn (setf a (incf i)) nil)
+                       (progn (setf b (incf i)) '(lambda () 'z))))
+     i a b))
+  z 2 1 2)
+
+;;; Error tests
+
+#+(or)
+(deftest compile.error.1
+  (signals-error (compile) program-error)
+  t)
+
+#+(or)
+(deftest compile.error.2
+  (signals-error (compile nil '(lambda () nil) 'garbage)
+                 program-error)
+  t)
diff --git a/test/ansi/dynamic-extent.lisp b/test/ansi/dynamic-extent.lisp
new file mode 100644
index 0000000..48b2e86
--- /dev/null
+++ b/test/ansi/dynamic-extent.lisp
@@ -0,0 +1,131 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat May 21 09:10:52 2005
+;;;; Contains: Tests of DYNAMIC-EXTENT
+
+(in-package #:cvm.test)
+
+(5am:def-suite dynamic-extent :in eval-and-compile)
+(5am:in-suite dynamic-extent)
+
+(deftest dynamic-extent.1
+  (let () (declare (dynamic-extent)))
+  nil)
+
+(deftest dynamic-extent.2
+  (let ((x 'a))
+    (declare (dynamic-extent x) (optimize speed (safety 0)))
+    x)
+  a)
+
+(deftest dynamic-extent.3
+  (let ((x (list 'a 'b 'c)))
+    (declare (dynamic-extent x) (optimize speed (safety 0)))
+    (length x))
+  3)
+
+(deftest dynamic-extent.4
+  (let ((x (vector 'a 'b 'c)))
+    (declare (dynamic-extent x) (optimize speed (safety 0)))
+    (length x))
+  3)
+
+(deftest dynamic-extent.5
+  (flet ((%f (x) (list 'a x)))
+    (declare (dynamic-extent (function %f))
+             (optimize speed (safety 0)))
+    (mapcar #'%f '(1 2 3)))
+  ((a 1) (a 2) (a 3)))
+
+(deftest dynamic-extent.6
+  (labels ((%f (x) (list 'a x)))
+    (declare (dynamic-extent (function %f))
+             (optimize speed (safety 0)))
+    (mapcar #'%f '(1 2 3)))
+  ((a 1) (a 2) (a 3)))
+
+(deftest dynamic-extent.7
+  (labels ((%f (x) (if (consp x)
+                       (cons (%f (car x)) (%f (cdr x)))
+                     '*)))
+    (declare (dynamic-extent (function %f))
+             (optimize speed (safety 0)))
+    (mapcar #'%f '((1) 2 (3 4 5))))
+  ((* . *) * (* * * . *)))
+
+(deftest dynamic-extent.8
+  (let ((x (+ most-positive-fixnum 2)))
+    (declare (dynamic-extent x)
+             (optimize speed (safety 0)))
+    (1- x))
+  #.(1+ most-positive-fixnum))
+
+(deftest dynamic-extent.9
+  (flet ((f () (list 'a 'b)))
+    (let ((f (list 'c 'd)))
+      (declare (dynamic-extent (function f))
+               (optimize speed (safety 0)))
+      f))
+  (c d))
+
+(deftest dynamic-extent.10
+  (let ((x nil))
+    (values
+     x
+     (locally (declare (dynamic-extent x) (notinline length)
+                       (optimize speed (safety 0)))
+       (setq x (list 'a 'b 'c 'd 'e))
+       (prog1 (length x) (setq x t)))
+     x))
+  nil 5 t)
+
+(deftest dynamic-extent.11
+  (let* ((x (list 'a 'b))
+         (y (cons 'c x)))
+    (declare (dynamic-extent y)
+             (optimize speed (safety 0)))
+    (cdr y))
+  (a b))
+
+(5am:test dynamic-extent.12
+  (5am:is-false
+   (let* ((contents '(1 0 0 1 1 0 1 1 0 1))
+          (n (length contents)))
+     (loop for i from 1 to 32
+           for type = `(unsigned-byte ,i)
+           for form1 = `(make-array '(,n) :initial-contents ',contents
+                                          :element-type ',type)
+           for form2 = `(let ((a ,form1))
+                          (declare (dynamic-extent a))
+                          (declare (type (simple-array ,type (,n))))
+                          (declare (notinline coerce))
+                          (declare (optimize speed (safety 0)))
+                          (equal (coerce a 'list) ',contents))
+           unless (ceval form2)
+             collect i)))
+  nil)
+
+(5am:test dynamic-extent.13
+  (is-true-eval
+   (let ((s (make-string 10 :initial-element #\a)))
+     (declare (dynamic-extent s) (optimize speed (safety 0)))
+     (every #'(lambda (c) (eql c #\a)) s))))
+
+(5am:test dynamic-extent.14
+  (is-true-eval
+   (let ((s (make-string 10 :initial-element #\a
+                            :element-type 'base-char)))
+     (declare (dynamic-extent s) (notinline every) (optimize speed (safety 0)))
+     (every #'(lambda (c) (eql c #\a)) s))))
+
+(deftest dynamic-extent.15
+  (flet (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (dynamic-extent #'(setf %f)))
+    :good)
+  :good)
+
+(deftest dynamic-extent.16
+  (labels (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (dynamic-extent #'(setf %f)))
+    :good)
+  :good)
diff --git a/test/ansi/eval-when.lisp b/test/ansi/eval-when.lisp
new file mode 100644
index 0000000..bc1fd10
--- /dev/null
+++ b/test/ansi/eval-when.lisp
@@ -0,0 +1,146 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Apr  6 17:00:30 2003
+;;;; Contains: Tests for EVAL-WHEN
+
+;;; The following test was suggested by Sam Steingold,
+;;; so I've created this file to hold it.
+
+(in-package #:cvm.test)
+
+(5am:def-suite eval-when :in eval-and-compile)
+(5am:in-suite eval-when)
+
+#+(or)
+(defvar *eval-when.1-collector*)
+
+#+(or)
+(deftest eval-when.1
+
+  (let ((forms nil) all (ff "generated-eval-when-test-file.lisp"))
+    (dolist (c '(nil (:compile-toplevel)))
+      (dolist (l '(nil (:load-toplevel)))
+        (dolist (x '(nil (:execute)))
+          (push `(eval-when (,@c ,@l ,@x)
+                   (push '(,@c ,@l ,@x) *eval-when.1-collector*))
+                forms))))
+    (dolist (c '(nil (:compile-toplevel)))
+      (dolist (l '(nil (:load-toplevel)))
+        (dolist (x '(nil (:execute)))
+          (push `(let () (eval-when (,@c ,@l ,@x)
+                           (push '(let ,@c ,@l ,@x) *eval-when.1-collector*)))
+                forms))))
+    (with-open-file (o ff :direction :output :if-exists :supersede)
+                    (dolist (f forms)
+                      (prin1 f o)
+                      (terpri o)))
+    (let ((*eval-when.1-collector* nil))
+      (load ff)
+      (push (cons "load source" *eval-when.1-collector*) all))
+    (let ((*eval-when.1-collector* nil))
+      (compile-file ff)
+      (push (cons "compile source" *eval-when.1-collector*) all))
+    (let ((*eval-when.1-collector* nil))
+      (load (compile-file-pathname ff))
+      (push (cons "load compiled" *eval-when.1-collector*) all))
+    (delete-file ff)
+    (delete-file (compile-file-pathname ff))
+    #+clisp (delete-file (make-pathname :type "lib" :defaults ff))
+    (nreverse all))
+
+  (("load source"
+    (:execute) (:load-toplevel :execute) (:compile-toplevel :execute)
+    (:compile-toplevel :load-toplevel :execute)
+    (let :execute) (let :load-toplevel :execute)
+    (let :compile-toplevel :execute)
+    (let :compile-toplevel :load-toplevel :execute))
+   ("compile source"
+    (:compile-toplevel) (:compile-toplevel :execute)
+    (:compile-toplevel :load-toplevel)
+    (:compile-toplevel :load-toplevel :execute))
+   ("load compiled"
+    (:load-toplevel) (:load-toplevel :execute)
+    (:compile-toplevel :load-toplevel)
+    (:compile-toplevel :load-toplevel :execute)
+    (let :execute) (let :load-toplevel :execute)
+    (let :compile-toplevel :execute)
+    (let :compile-toplevel :load-toplevel :execute))))
+
+;;; More EVAL-WHEN tests to go here
+
+(deftest eval-when.2
+  (eval-when () :bad)
+  nil)
+
+(deftest eval-when.3
+  (eval-when (:execute))
+  nil)
+
+(deftest eval-when.4
+  (eval-when (:execute) :good)
+  :good)
+
+(deftest eval-when.5
+  (eval-when (:compile-toplevel) :bad)
+  nil)
+
+(deftest eval-when.6
+  (eval-when (:load-toplevel) :bad)
+  nil)
+
+(deftest eval-when.7
+  (eval-when (:compile-toplevel :execute) :good)
+  :good)
+
+(deftest eval-when.8
+  (eval-when (:load-toplevel :execute) :good)
+  :good)
+
+(deftest eval-when.9
+  (eval-when (:load-toplevel :compile-toplevel) :bad)
+  nil)
+
+(deftest eval-when.10
+  (eval-when (:load-toplevel :compile-toplevel :execute) :good)
+  :good)
+
+(deftest eval-when.11
+  (eval-when (:execute) (values 'a 'b 'c 'd))
+  a b c d)
+
+(deftest eval-when.12
+  (let ((x :good))
+    (values (eval-when (:load-toplevel) (setq x :bad)) x))
+  nil :good)
+
+(deftest eval-when.13
+  (let ((x :good))
+    (values (eval-when (:compile-toplevel) (setq x :bad)) x))
+  nil :good)
+
+(deftest eval-when.14
+  (let ((x :bad))
+    (values (eval-when (:execute) (setq x :good)) x))
+  :good :good)
+
+(deftest eval-when.15
+  (let ((x :good))
+    (values (eval-when (load) (setq x :bad)) x))
+  nil :good)
+
+(deftest eval-when.16
+  (let ((x :good))
+    (values (eval-when (compile) (setq x :bad)) x))
+  nil :good)
+
+(deftest eval-when.17
+  (let ((x :bad))
+    (values (eval-when (cl:eval) (setq x :good)) x))
+  :good :good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest eval-when.18
+  (macrolet ((%m (z) z))
+    (eval-when (:execute) (s:expand-in-current-env (%m :good))))
+  :good)
diff --git a/test/ansi/eval.lisp b/test/ansi/eval.lisp
new file mode 100644
index 0000000..3984a0d
--- /dev/null
+++ b/test/ansi/eval.lisp
@@ -0,0 +1,57 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Thu Nov 21 10:43:15 2002
+;;;; Contains: Tests of EVAL
+
+(in-package #:cvm.test)
+
+(5am:def-suite eval :in eval-and-compile)
+(5am:in-suite eval)
+
+(deftest eval.1
+    1
+  1)
+
+#+(or)
+(deftest eval.2
+  (loop for x being the symbols of "KEYWORD"
+        always (eq (eval x) x))
+  t)
+
+(5am:test eval.3
+  (5am:is-true (let ((s "abcd"))
+                 (eql (ceval s) s))))
+
+#+(or)
+(deftest eval.4
+  (eval '(car '(a . b)))
+  a)
+
+(deftest eval.5
+  (let ((x 0)) x)
+  0)
+
+(5am:test eval.6
+  (5am:is (eql 1 (funcall #'ceval 1))))
+
+#+(or)
+(deftest eval.order.1
+  (let ((i 0))
+    (values (eval (progn (incf i) 10)) i))
+  10 1)
+
+;;; Error cases
+
+(5am:test eval.error.1
+  (5am:signals program-error (ceval)))
+
+#+(or)
+(deftest eval.error.2
+  (signals-error (eval nil nil) program-error)
+  t)
+
+(5am:test eval.error.3
+  (5am:signals undefined-function (ceval (list (gensym)))))
+
+(5am:test eval.error.4
+  (5am:signals unbound-variable (ceval (gensym))))
diff --git a/test/ansi/flet.lisp b/test/ansi/flet.lisp
new file mode 100644
index 0000000..8468096
--- /dev/null
+++ b/test/ansi/flet.lisp
@@ -0,0 +1,591 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Oct  8 22:55:02 2002
+;;;; Contains: Tests of FLET
+
+(in-package #:cvm.test)
+
+(5am:def-suite flet :in data-and-control-flow)
+(5am:in-suite flet)
+
+(deftest flet.1
+  (flet ((%f () 1))
+    (%f))
+  1)
+
+(deftest flet.2
+  (flet ((%f (x) x))
+    (%f 2))
+  2)
+
+(deftest flet.3
+  (flet ((%f (&rest args) args))
+    (%f 'a 'b 'c))
+  (a b c))
+
+;;; The optional arguments are not in the block defined by
+;;; the local function declaration
+(deftest flet.4
+  (block %f
+    (flet ((%f (&optional (x (return-from %f :good)))
+             nil))
+      (%f)
+      :bad))
+  :good)
+
+;;; Key arguments are not in the block defined by
+;;; the local function declaration
+(deftest flet.4a
+  (block %f
+    (flet ((%f (&key (x (return-from %f :good)))
+             nil))
+      (%f)
+      :bad))
+  :good)
+
+(deftest flet.5
+  (flet ((%f () (return-from %f 15) 35))
+    (%f))
+  15)
+
+;;; The aux parameters are not in the block defined by
+;;; the local function declaration
+(deftest flet.6
+  (block %f
+    (flet ((%f (&aux (x (return-from %f 10)))
+             20))
+      (%f)))
+  10)
+
+;;; The function is not visible inside itself
+(deftest flet.7
+  (flet ((%f (x) (+ x 5)))
+    (flet ((%f (y) (if (eql y 20) 30 (%f 20))))
+      (%f 15)))
+  25)
+
+;;; Keyword arguments
+(deftest flet.8
+  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f))
+  nil 0 nil)
+
+(deftest flet.9
+  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :a 1))
+  1 0 nil)
+
+(deftest flet.10
+  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :b 2))
+  nil 2 t)
+
+(deftest flet.11
+  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :b 2 :a 3))
+  3 2 t)
+
+;;; Unknown keyword parameter should throw a program-error in safe code
+;;; (section 3.5.1.4)
+(5am:test flet.12
+  (signals-eval
+   program-error
+   (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))))
+
+;;; Odd # of keyword args should throw a program-error in safe code
+;;; (section 3.5.1.6)
+(5am:test flet.13
+  (signals-eval
+   program-error
+   (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))))
+
+;;; Too few arguments (section 3.5.1.2)
+(5am:test flet.14
+  (signals-eval program-error (flet ((%f (a) a)) (%f))))
+
+;;; Too many arguments (section 3.5.1.3)
+(5am:test flet.15
+  (signals-eval program-error (flet ((%f (a) a)) (%f 1 2))))
+
+;;; Invalid keyword argument (section 3.5.1.5)
+(5am:test flet.16
+  (signals-eval program-error (flet ((%f (&key a) a)) (%f '(foo)))))
+
+
+;;; Definition of a (setf ...) function
+
+(deftest flet.17
+  (flet (((setf %f) (x y) (s:setf (car y) x)))
+    (let ((z (list 1 2)))
+      (s:setf (%f z) 'a)
+      z))
+  (a 2))
+
+;;; Body is an implicit progn
+(deftest flet.18
+  (flet ((%f (x) (s:incf x) (+ x x)))
+    (%f 10))
+  22)
+
+;;; Can handle at least 50 lambda parameters
+(deftest flet.19
+  (flet ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
+              b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
+              c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
+              d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
+              e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)
+             (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
+                b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
+                c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
+                d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
+                e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)))
+    (%f 1 2 3 4 5 6 7 8 9 10
+        11 12 13 14 15 16 17 18 19 20
+        21 22 23 24 25 26 27 28 29 30
+        31 32 33 34 35 36 37 38 39 40
+        41 42 43 44 45 46 47 48 49 50))
+  1275)
+
+;;; flet works with a large (maximal?) number of arguments
+#+(or) ; figure out lambda-parameters-limit
+(deftest flet.20
+  (let* ((n (min (1- lambda-parameters-limit) 1024))
+         (vars (loop repeat n collect (gensym))))
+    (eval
+     `(eqlt ,n
+            (flet ((%f ,vars (+ ,@ vars)))
+              (%f ,@(loop for e in vars collect 1))))))
+  t)
+
+;;; Declarations and documentation strings are ok
+(deftest flet.21
+  (flet ((%f (x)
+           (declare (type fixnum x))
+           "Add one to the fixnum x."
+           (1+ x)))
+    (declare (ftype (function (fixnum) integer) %f))
+    (%f 10))
+  11)
+
+(deftest flet.22
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p))
+             (list x y (not (not y-p)) z (not (not z-p)))))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)))
+  (10 1 nil 2 nil)
+  (20 40 t 2 nil)
+  (a b t c t))
+
+(deftest flet.23
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r)
+             (list x y (not (not y-p)) z (not (not z-p)) r)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c) (%f 'd 'e 'f 'g 'h)))
+  (10 1 nil 2 nil nil)
+  (20 40 t 2 nil nil)
+  (a b t c t nil)
+  (d e t f t (g h)))
+
+(deftest flet.24
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
+             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h)
+            (%f 'd 'e 'f :bar 'i) ))
+  (10 1 nil 2 nil nil nil nil)
+  (20 40 t 2 nil nil nil nil)
+  (a b t c t nil nil nil)
+  (d e t f t (:foo h) h nil)
+  (d e t f t (:bar i) nil i))
+
+(deftest flet.25
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar
+                &allow-other-keys)
+             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h :whatever nil)
+            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z) ))
+  (10 1 nil 2 nil nil nil nil)
+  (20 40 t 2 nil nil nil nil)
+  (a b t c t nil nil nil)
+  (d e t f t (:foo h :whatever nil) h nil)
+  (d e t f t (:bar i :illegal t :foo z) z i))
+
+(deftest flet.26
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
+             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys t)
+            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys t) ))
+  (10 1 nil 2 nil nil nil nil)
+  (20 40 t 2 nil nil nil nil)
+  (a b t c t nil nil nil)
+  (d e t f t (:foo h :whatever nil :allow-other-keys t) h nil)
+  (d e t f t (:bar i :illegal t :foo z :allow-other-keys t) z i))
+
+;;; Section 3.4.1.4.1: "The :allow-other-keys argument is permissible
+;;; in all situations involving keyword[2] arguments, even when its
+;;; associated value is false."
+(deftest flet.27
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
+             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h :allow-other-keys nil)
+            (%f 'd 'e 'f :bar 'i :allow-other-keys nil) ))
+  (10 1 nil 2 nil nil nil nil)
+  (20 40 t 2 nil nil nil nil)
+  (a b t c t nil nil nil)
+  (d e t f t (:foo h :allow-other-keys nil) h nil)
+  (d e t f t (:bar i :allow-other-keys nil) nil i))
+
+(deftest flet.28
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r
+                &key foo bar allow-other-keys)
+             (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys
+                   r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys 100)
+            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys 200) ))
+  (10 1 nil 2 nil nil nil nil nil)
+  (20 40 t 2 nil nil nil nil nil)
+  (a b t c t nil nil nil nil)
+  (d e t f t 100 (:foo h :whatever nil :allow-other-keys 100) h nil)
+  (d e t f t 200 (:bar i :illegal t :foo z :allow-other-keys 200) z i))
+
+(deftest flet.29
+  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r
+                &key foo bar allow-other-keys &allow-other-keys)
+             (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys
+                   r foo bar)))
+    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
+            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys nil :blah t)
+            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z
+                :allow-other-keys nil :zzz 10) ))
+  (10 1 nil 2 nil nil nil nil nil)
+  (20 40 t 2 nil nil nil nil nil)
+  (a b t c t nil nil nil nil)
+  (d e t f t nil (:foo h :whatever nil :allow-other-keys nil :blah t) h nil)
+  (d e t f t nil (:bar i :illegal t :foo z :allow-other-keys nil :zzz 10) z i))
+
+;;; Tests of non-keyword keywords (see section 3.4.1.4, paragrph 2).
+(deftest flet.30
+  (flet ((%f (&key ((foo bar) nil)) bar))
+    (values (%f) (%f 'foo 10)))
+  nil 10)
+
+(deftest flet.31
+  (flet ((%f (&key ((:foo bar) nil)) bar))
+    (values (%f) (%f :foo 10)))
+  nil 10)
+
+;;; Multiple keyword actual parameters
+(deftest flet.32
+  (flet ((%f (&key a b c) (list a b c)))
+    (%f :a 10 :b 20 :c 30 :a 40 :b 50 :c 60))
+  (10 20 30))
+
+;;; More aux parameters
+(deftest flet.33
+  (flet ((%f (x y &aux (a (1+ x)) (b (+ x y a)) (c (list x y a b)))
+           c))
+    (%f 5 9))
+  (5 9 6 20))
+
+(deftest flet.34
+  (flet ((%f (x y &rest r &key foo bar &aux (c (list x y r foo bar)))
+           c))
+    (values
+     (%f 1 2)
+     (%f 1 2 :foo 'a)
+     (%f 1 2 :bar 'b)
+     (%f 1 2 :foo 'a :bar 'b)
+     (%f 1 2 :bar 'b :foo 'a)))
+  (1 2 nil nil nil)
+  (1 2 (:foo a) a nil)
+  (1 2 (:bar b) nil b)
+  (1 2 (:foo a :bar b) a b)
+  (1 2 (:bar b :foo a) a b))
+
+;;; Binding of formal parameters that are also special variables
+(deftest flet.35
+  (let ((x 'bad))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (x)
+               (declare (special x))
+               (%f)))
+        (%g 'good))))
+  good)
+
+(deftest flet.36
+  (let ((x 'bad))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (&aux (x 'good))
+               (declare (special x))
+               (%f)))
+         (%g))))
+  good)
+
+(deftest flet.37
+  (let ((x 'bad))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (&rest x)
+               (declare (special x))
+               (%f)))
+         (%g 'good))))
+  (good))
+
+(deftest flet.38
+  (let ((x 'bad))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (&key (x 'good))
+               (declare (special x))
+               (%f)))
+         (%g))))
+  good)
+
+(deftest flet.39
+  (let ((x 'bad))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (&key (x 'bad))
+               (declare (special x))
+               (%f)))
+         (%g :x 'good))))
+  good)
+
+(deftest flet.40
+  (let ((x 'good))
+    (declare (special x))
+    (flet ((%f () x))
+      (flet ((%g (&key (x 'bad))
+               (%f)))
+         (%g :x 'worse))))
+  good)
+
+
+(deftest flet.45
+  (flet ((nil () 'a)) (nil))
+  a)
+
+(deftest flet.46
+  (flet ((t () 'b)) (t))
+  b)
+
+;;; Keywords can be function names
+(deftest flet.47
+  (flet ((:foo () 'bar)) (:foo))
+  bar)
+
+(deftest flet.48
+  (flet ((:foo () 'bar)) (funcall #':foo))
+  bar)
+
+#+(or)
+(deftest flet.49
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors (flet ((,s () 'a)) (,s)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+#+(or)
+(deftest flet.50
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors (flet ((,s () 'a))
+                                      (declare (ftype (function () symbol)
+                                                      ,s))
+                                      (,s)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+;;; Binding SETF functions of certain COMMON-LISP symbols
+#+(or)
+(deftest flet.51
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors
+                     (flet (((setf ,s) (&rest args)
+                             (declare (ignore args))
+                             'a))
+                       (setf (,s) 10)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+;;; Check that FLET does not have a tagbody
+(deftest flet.52
+  (block done
+    (tagbody
+     (flet ((%f () (go 10) 10 (return-from done 'bad)))
+       (%f))
+     10
+     (return-from done 'good)))
+  good)
+
+;;; Check that nil keyword arguments do not enable the default values
+
+(deftest flet.53
+  (flet ((%f (&key (a 'wrong)) a)) (%f :a nil))
+  nil)
+
+(deftest flet.54
+  (flet ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
+  (nil nil))
+
+(deftest flet.55
+  (flet ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
+  nil)
+
+(deftest flet.56
+  (flet ((%f (&key ((:a b) 'wrong present?)) (list b (not present?)))) (%f :a nil))
+  (nil nil))
+
+(deftest flet.57
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys nil))
+  good)
+
+(deftest flet.58
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys t))
+  good)
+
+(deftest flet.59
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys t :a 1 :b 2))
+  good)
+
+(deftest flet.60
+  (flet ((%f (&key &allow-other-keys) 'good))
+    (%f :a 1 :b 2))
+  good)
+
+;;; NIL as a disallowed keyword argument
+(5am:test flet.61
+  (signals-eval
+   program-error
+   (flet ((%f (&key) :bad)) (%f nil nil))))
+
+;;; Free declarations do not affect argument forms
+
+(deftest flet.62
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f (&optional (y x))
+               (declare (special x))
+               y))
+        (%f))))
+  :good)
+
+(deftest flet.63
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f (&key (y x))
+               (declare (special x))
+               y))
+        (%f))))
+  :good)
+
+(deftest flet.64
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet () (declare (special x)))
+      x))
+  :good)
+
+(deftest flet.65
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f () (declare (special x)))))
+      x))
+  :good)
+
+(deftest flet.66
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f () (declare (special x))))
+        x)))
+  :good)
+
+(deftest flet.67
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f (&aux (y x))
+               (declare (special x))
+               y))
+        (%f))))
+  :good)
+
+(deftest flet.68
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (flet ((%f () x))
+        (declare (special x))
+        (%f))))
+  :good)
+
+(deftest flet.69
+  (let ((*x* 0))
+    (declare (special *x*))
+    (flet ((%f (i)
+             #'(lambda (arg)
+                 (declare (ignore arg))
+                 (s:incf *x* i))))
+      (values
+       (mapcar (%f 1) '(a b c))
+       (mapcar (%f 2) '(a b c)))))
+  (1 2 3)
+  (5 7 9))
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest flet.70
+  (macrolet ((%m (z) z))
+    (flet () (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest flet.71
+  (macrolet ((%m (z) z))
+    (flet ((%f () (s:expand-in-current-env (%m :good))))
+      (%f)))
+  :good)
+
+;;; local function bindings shadow global functions, macros
+;;; and compiler-macros
+
+#+(or)
+(defun flet.72 () :bad)
+
+#+(or)
+(deftest flet.72
+   (flet ((flet.72 () :good))
+     (flet.72))
+   :good)
+
+#+(or)
+(defmacro flet.73 () :bad)
+
+#+(or)
+(deftest flet.73
+   (flet ((flet.73 () :good))
+     (flet.73))
+   :good)
+
+#+(or)
+(define-compiler-macro flet.74 (&whole form)
+   :bad)
+
+#+(or)
+(deftest flet.74
+   (flet ((flet.74 () :good))
+     (flet.74))
+   :good)
diff --git a/test/ansi/if.lisp b/test/ansi/if.lisp
new file mode 100644
index 0000000..8e51356
--- /dev/null
+++ b/test/ansi/if.lisp
@@ -0,0 +1,76 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Oct 18 08:21:29 2002
+;;;; Contains: Tests for IF
+
+(in-package #:cvm.test)
+
+(5am:def-suite if :in data-and-control-flow)
+(5am:in-suite if)
+
+(deftest if.1
+  (if t 1 2)
+  1)
+
+(deftest if.2
+  (if nil 1 2)
+  2)
+
+(deftest if.3 (if t (values) 'a))
+
+(deftest if.4
+  (if nil 'a)
+  nil)
+
+(deftest if.5
+  (if t (values 'a 'b 'c) 'd)
+  a b c)
+
+(deftest if.6
+  (if nil 'a (values 'b 'c 'd))
+  b c d)
+
+(deftest if.7 (if nil 'a (values)))
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest if.8
+  (macrolet ((%m (z) z))
+    (if (s:expand-in-current-env (%m t)) :good :bad))
+  :good)
+
+(deftest if.9
+  (macrolet ((%m (z) z))
+    (if (s:expand-in-current-env (%m nil)) :bad))
+  nil)
+
+(deftest if.10
+  (macrolet ((%m (z) z))
+    (if (s:expand-in-current-env (%m t)) :good))
+  :good)
+
+(deftest if.11
+  (macrolet ((%m (z) z))
+    (if (s:expand-in-current-env (%m nil)) :bad :good))
+  :good)
+
+(deftest if.12
+  (macrolet
+   ((%m (z) z))
+   (flet ((%f (x y) (if x (s:expand-in-current-env (%m y)))))
+     (declare (notinline %f))
+     (values (%f t :good) (%f nil :bad))))
+  :good nil)
+
+(deftest if.13
+  (macrolet
+   ((%m (z) z))
+   (flet ((%f (x y z) (if x y (s:expand-in-current-env (%m z)))))
+     (declare (notinline %f))
+     (values (%f t :good :bad) (%f nil :bad :good))))
+  :good :good)
+
+(deftest if.order.1
+  (let ((i 0))
+    (values (if (= (s:incf i) 1) 't nil) i))
+  t 1)
diff --git a/test/ansi/ignorable.lisp b/test/ansi/ignorable.lisp
new file mode 100644
index 0000000..a1e29e8
--- /dev/null
+++ b/test/ansi/ignorable.lisp
@@ -0,0 +1,56 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat May 21 08:16:27 2005
+;;;; Contains: Tests of the IGNORABLE declaration
+
+(in-package #:cvm.test)
+
+(5am:def-suite ignorable :in eval-and-compile)
+(5am:in-suite ignorable)
+
+(deftest ignorable.1
+  (let ((x 'foo)) (declare (ignorable x)))
+  nil)
+
+(deftest ignorable.2
+  (let ((x 'foo)) (declare (ignorable x)) x)
+  foo)
+
+(deftest ignorable.3
+  (flet ((%f () 'foo))
+    (declare (ignorable (function %f))))
+  nil)
+
+(deftest ignorable.4
+  (flet ((%f () 'foo))
+    (declare (ignorable (function %f)))
+    (%f))
+  foo)
+
+;;; TODO: add a test for (function (setf foo))
+
+(deftest ignorable.5
+  (flet (((setf %f) (x y) nil))
+    (declare (ignorable (function (setf %f))))
+    :good)
+  :good)
+
+(deftest ignorable.6
+  (flet (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (ignorable (function (setf %f))))
+    (let ((z (cons 'a 'b)))
+      (values (s:setf (%f z) 'c) z)))
+  c (c . b))
+
+(deftest ignorable.7
+  (labels (((setf %f) (x y) nil))
+    (declare (ignorable (function (setf %f))))
+    :good)
+  :good)
+
+(deftest ignorable.8
+  (labels (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (ignorable (function (setf %f))))
+    (let ((z (cons 'a 'b)))
+      (values (s:setf (%f z) 'c) z)))
+  c (c . b))
diff --git a/test/ansi/ignore.lisp b/test/ansi/ignore.lisp
new file mode 100644
index 0000000..4de2049
--- /dev/null
+++ b/test/ansi/ignore.lisp
@@ -0,0 +1,40 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat May 21 07:59:24 2005
+;;;; Contains: Tests of the IGNORE declarations
+
+(in-package #:cvm.test)
+
+(5am:def-suite ignore :in eval-and-compile)
+(5am:in-suite ignore)
+
+(deftest ignore.1
+  (let ((x 'foo)) (declare (ignore x)))
+  nil)
+
+(deftest ignore.2
+  (let ((x 'foo)) (declare (ignore x)) x)
+  foo)
+
+(deftest ignore.3
+  (flet ((%f () 'foo))
+    (declare (ignore (function %f))))
+  nil)
+
+(deftest ignore.4
+  (flet ((%f () 'foo))
+    (declare (ignore (function %f)))
+    (%f))
+  foo)
+
+(deftest ignore.5
+  (flet (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (ignore (function (setf %f))))
+    :good)
+  :good)
+
+(deftest ignore.6
+  (labels (((setf %f) (x y) (s:setf (car y) x)))
+    (declare (ignore (function (setf %f))))
+    :good)
+  :good)
diff --git a/test/ansi/labels.lisp b/test/ansi/labels.lisp
new file mode 100644
index 0000000..1b76105
--- /dev/null
+++ b/test/ansi/labels.lisp
@@ -0,0 +1,439 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Wed Oct  9 19:06:33 2002
+;;;; Contains: Tests of LABELS
+
+(in-package #:cvm.test)
+
+(5am:def-suite labels :in data-and-control-flow)
+(5am:in-suite labels)
+
+(deftest labels.1
+  (labels ((%f () 1))
+    (%f))
+  1)
+
+(deftest labels.2
+  (labels ((%f (x) x))
+    (%f 2))
+  2)
+
+(deftest labels.3
+  (labels ((%f (&rest args) args))
+    (%f 'a 'b 'c))
+  (a b c))
+
+;;; The optional arguments are not in the block defined by
+;;; the local function declaration
+(deftest labels.4
+  (block %f
+    (labels ((%f (&optional (x (return-from %f :good)))
+               nil))
+      (%f)
+      :bad))
+  :good)
+
+;;; Keyword parameter initializers are not in the blocked defined
+;;; by the local function declaration
+
+(deftest labels.4a
+  (block %f
+    (labels ((%f (&key (x (return-from %f :good)))
+               nil))
+      (%f)
+      :bad))
+  :good)
+
+(deftest labels.5
+  (labels ((%f () (return-from %f 15) 35))
+    (%f))
+  15)
+
+;;; The aux parameters are not in the block defined by
+;;; the local function declaration
+(deftest labels.6
+  (block %f
+    (labels ((%f (&aux (x (return-from %f 10)))
+               20))
+      (%f)
+      :bad))
+  10)
+
+;;; The function is visible inside itself
+(deftest labels.7
+  (labels ((%f (x n) (if (eql n 0) x (%f (+ x n) (1- n)))))
+    (%f 0 10))
+  55)
+
+;;; Scope of defined function names includes &AUX parameters
+
+(deftest labels.7b
+  (labels ((%f (x &aux (b (%g x))) b)
+           (%g (y) (+ y y)))
+    (%f 10))
+  20)
+
+;;; Scope of defined function names includes &OPTIONAL parameters
+
+(deftest labels.7c
+  (labels ((%f (x &optional (b (%g x))) b)
+           (%g (y) (+ y y)))
+    (%f 10))
+  20)
+
+;;; Scope of defined function names includes &KEY parameters
+
+(deftest labels.7d
+  (labels ((%f (x &key (b (%g x))) b)
+           (%g (y) (+ y y)))
+    (%f 10))
+  20)
+
+;;; Keyword arguments
+(deftest labels.8
+  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f))
+  nil 0 nil)
+
+(deftest labels.9
+  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :a 1))
+  1 0 nil)
+
+(deftest labels.10
+  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :b 2))
+  nil 2 t)
+
+(deftest labels.11
+  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
+    (%f :b 2 :a 3))
+  3 2 t)
+
+;;; Unknown keyword parameter should throw a program-error in safe code
+;;; (section 3.5.1.4)
+(5am:test labels.12
+  (signals-eval
+   program-error
+   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))))
+
+;;; Odd # of keyword args should throw a program-error in safe code
+;;; (section 3.5.1.6)
+(5am:test labels.13
+  (signals-eval
+   program-error
+   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))))
+
+;;; Too few arguments (section 3.5.1.2)
+(5am:test labels.14
+  (signals-eval program-error
+                (labels ((%f (a) a)) (%f))))
+
+;;; Too many arguments (section 3.5.1.3)
+(5am:test labels.15
+  (signals-eval program-error
+                 (labels ((%f (a) a)) (%f 1 2))))
+
+;;; Invalid keyword argument (section 3.5.1.5)
+(5am:test labels.16
+  (signals-eval program-error
+                (labels ((%f (&key a) a)) (%f '(foo)))))
+
+;;; Definition of a (setf ...) function
+
+(deftest labels.17
+  (labels (((setf %f) (x y) (s:setf (car y) x)))
+    (let ((z (list 1 2)))
+      (s:setf (%f z) 'a)
+      z))
+  (a 2))
+
+;;; Body is an implicit progn
+(deftest labels.18
+  (labels ((%f (x) (s:incf x) (+ x x)))
+    (%f 10))
+  22)
+
+;;; Can handle at least 50 lambda parameters
+(deftest labels.19
+  (labels ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
+                b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
+                c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
+                d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
+                e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)
+               (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
+                  b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
+                  c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
+                  d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
+                  e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)))
+    (%f 1 2 3 4 5 6 7 8 9 10
+        11 12 13 14 15 16 17 18 19 20
+        21 22 23 24 25 26 27 28 29 30
+        31 32 33 34 35 36 37 38 39 40
+        41 42 43 44 45 46 47 48 49 50))
+  1275)
+
+;;; labels works with the maximum number of arguments (if
+;;; not too many.)
+#+(or)
+(deftest labels.20
+  (let* ((n (min (1- lambda-parameters-limit) 1024))
+         (vars (loop repeat n collect (gensym))))
+    (eval
+     `(eqlt ,n
+            (labels ((%f ,vars (+ ,@ vars)))
+              (%f ,@(loop for e in vars collect 1))))))
+  t)
+
+;;; Declarations and documentation strings are ok
+(deftest labels.21
+  (labels ((%f (x)
+             (declare (type fixnum x))
+             "Add one to the fixnum x."
+             (1+ x)))
+    (declare (ftype (function (fixnum) integer) %f))
+    (%f 10))
+  11)
+
+;;; Keywords can be function names
+(deftest labels.22
+  (labels ((:foo () 10)
+           (:bar () (1+ (:foo))))
+    (:bar))
+  11)
+
+(deftest labels.23
+  (labels ((:foo () 10)
+           (:bar () (1+ (funcall #':foo))))
+    (funcall #':bar))
+  11)
+
+#+(or)
+(deftest labels.24
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors (labels ((,s (x) (foo (1- x)))
+                                            (foo (y)
+                                                 (if (<= y 0) 'a
+                                                   (,s (1- y)))))
+                                     (,s 10)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+#+(or)
+(deftest labels.25
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors
+                     (labels ((,s (x) (foo (1- x)))
+                              (foo (y)
+                                   (if (<= y 0) 'a
+                                     (,s (1- y)))))
+                       (declare (ftype (function (integer) symbol)
+                                       foo ,s))
+                       (,s 10)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+#+(or)
+(deftest labels.26
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors
+                     (labels (((setf ,s) (&rest args)
+                               (declare (ignore args))
+                               'a))
+                       (setf (,s) 10)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+;;; Check that LABELS does not have a tagbody
+(deftest labels.27
+  (block done
+    (tagbody
+     (labels ((%f () (go 10) 10 (return-from done 'bad)))
+       (%f))
+     10
+     (return-from done 'good)))
+  good)
+
+;;; Check that nil keyword arguments do not enable the default values
+
+(deftest labels.28
+  (labels ((%f (&key (a 'wrong)) a)) (%f :a nil))
+  nil)
+
+(deftest labels.29
+  (labels ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
+  (nil nil))
+
+(deftest labels.30
+  (labels ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
+  nil)
+
+(deftest labels.31
+  (labels ((%f (&key ((:a b) 'wrong present?)) (list b (not present?))))
+    (%f :a nil))
+  (nil nil))
+
+(deftest labels.32
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys nil))
+  good)
+
+(deftest labels.33
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys t))
+  good)
+
+(deftest labels.34
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys t :a 1 :b 2))
+  good)
+
+(deftest labels.35
+  (labels ((%f (&key &allow-other-keys) 'good))
+    (%f :a 1 :b 2))
+  good)
+
+;;; NIL as a disallowed keyword argument
+(5am:test labels.36
+  (signals-eval
+   program-error
+   (labels ((%f (&key) :bad)) (%f nil nil))))
+
+;;; Identity of function objects
+;;; Since (FUNCTION <name>) returns *the* functional value, it
+;;; should be the case that different invocations of this form
+;;; in the same lexical environment return the same value.
+
+(5am:test labels.37
+  (is-true-eval (labels ((f () 'foo))
+                  (eq #'f #'f))))
+
+#+(or)
+(deftest labels.38
+  (labels ((f () 'foo))
+    (destructuring-bind (x y) (loop repeat 2 collect #'f) (eqlt x y)))
+  t)
+
+(5am:test labels.39
+  (is-true-eval (labels ((f () #'f))
+                  (eql (f) #'f))))
+
+(5am:test labels.40
+  (is-true-eval (let ((x (labels ((f () #'f)) #'f)))
+                  (eql x (funcall x)))))
+
+;;; Test that free declarations do not affect argument forms
+
+(deftest labels.41
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f (&optional (y x))
+                 (declare (special x))
+                 y))
+        (%f))))
+  :good)
+
+(deftest labels.42
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f (&key (y x))
+                 (declare (special x))
+                 y))
+        (%f))))
+  :good)
+
+(deftest labels.43
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels () (declare (special x)))
+      x))
+  :good)
+
+(deftest labels.44
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f () (declare (special x)))))
+      x))
+  :good)
+
+(deftest labels.45
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f () (declare (special x))))
+        x)))
+  :good)
+
+(deftest labels.46
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f (&aux (y x))
+                 (declare (special x))
+                 y))
+        (%f))))
+  :good)
+
+(deftest labels.47
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      (labels ((%f () x))
+        (declare (special x))
+        (%f))))
+  :good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest labels.48
+  (macrolet ((%m (z) z))
+    (labels () (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest labels.49
+  (macrolet ((%m (z) z))
+    (labels ((%f () (s:expand-in-current-env (%m :good))))
+      (%f)))
+  :good)
+
+
+;;; local function bindings shadow global functions, macros
+;;; and compiler-macros
+
+
+#+(or)
+(defun labels.50 () :bad)
+
+#+(or)
+(deftest labels.50
+   (labels ((labels.50 () :good))
+     (labels.50))
+   :good)
+
+#+(or)
+(defmacro labels.51 () :bad)
+
+#+(or)
+(deftest labels.51
+   (labels ((labels.51 () :good))
+      (labels.51))
+   :good)
+
+#+(or)
+(define-compiler-macro labels.52 (&whole form)
+   :bad)
+
+#+(or)
+(deftest labels.52
+   (labels ((labels.52 () :good))
+     (labels.52))
+   :good)
+
+   
diff --git a/test/ansi/lambda.lisp b/test/ansi/lambda.lisp
new file mode 100644
index 0000000..74ad817
--- /dev/null
+++ b/test/ansi/lambda.lisp
@@ -0,0 +1,380 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Wed Nov 27 06:43:21 2002
+;;;; Contains: Tests of LAMBDA forms
+
+(in-package #:cvm.test)
+
+(5am:def-suite lambda :in eval-and-compile)
+(5am:in-suite lambda)
+
+(deftest lambda.1
+  ((lambda (x) x) 'a)
+  a)
+
+(deftest lambda.2
+  ((lambda () 'a))
+  a)
+
+(deftest lambda.3
+  ((lambda () "documentation" 'a))
+  a)
+
+(deftest lambda.4
+  ((lambda (x) (declare (type symbol x)) x) 'z)
+  z)
+
+(deftest lambda.5
+  ((lambda (&aux (x 'a)) x))
+  a)
+
+(deftest lambda.6
+  ((lambda (&aux (x 'a)) (declare (type symbol x)) x))
+  a)
+
+(deftest lambda.7
+  ((lambda () "foo"))
+  "foo")
+
+(deftest lambda.8
+  ((lambda () "foo" "bar"))
+  "bar")
+
+(deftest lambda.9
+  ((lambda (x y) (declare (ignore x)) "foo" (declare (ignore y)) "bar") 1 2)
+  "bar")
+
+(deftest lambda.10
+  ((lambda (x) (declare (type symbol x) (ignorable x))) 'z)
+  nil)
+
+(deftest lambda.11
+  ((lambda (x &optional y z) (list x y z)) 1 2)
+  (1 2 nil))
+
+(deftest lambda.12
+  ((lambda (&optional (x 'a) (y 'b) (z 'c)) (list x y z)) 1 nil)
+  (1 nil c))
+
+(deftest lambda.13
+  ((lambda (&optional (x 'a x-p) (y 'b y-p) (z 'c z-p))
+     (list* x y z (mapcar #'s:notnot (list x-p y-p z-p)))) 1 nil)
+  (1 nil c t t nil))
+
+(deftest lambda.14
+  (let ((x 1))
+    ((lambda (&optional (x (1+ x))) x)))
+  2)
+
+(deftest lambda.15
+  ((lambda (y &optional (x (1+ y))) (list y x)) 10)
+  (10 11))
+
+(deftest lambda.16
+  ((lambda (y &optional (x (1+ y))) (list y x)) 10 14)
+  (10 14))
+
+(deftest lambda.17
+  ((lambda (&rest x) x) 1 2 3)
+  (1 2 3))
+
+(deftest lambda.18
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3 7))
+  (3 7))
+
+(deftest lambda.19
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3))
+  (3 4))
+
+(deftest lambda.20
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b))))
+  (10 11))
+
+(deftest lambda.21
+  (flet ((%f () (locally (declare (special *x*)) (s:incf *x*))))
+    ((lambda (*x*)
+       (declare (special *x*))
+       (%f)
+       *x*)
+     10))
+  11)
+
+(deftest lambda.22
+  (flet ((%f () (locally (declare (special *x*)) (1+ *x*))))
+    ((lambda (*x*)
+       (declare (special *x*))
+       (%f))
+     15))
+  16)
+
+(deftest lambda.23
+  ((lambda (&key a) a))
+  nil)
+
+(deftest lambda.24
+  ((lambda (&key a b c) (list a b c)))
+  (nil nil nil))
+
+(deftest lambda.25
+  ((lambda (&key (a 1) (b 2) (c 3)) (list a b c)))
+  (1 2 3))
+
+(deftest lambda.26
+  ((lambda (&key)))
+  nil)
+
+(deftest lambda.27
+  ((lambda (&key) 'good) :allow-other-keys nil)
+  good)
+
+(deftest lambda.28
+  ((lambda (&key) 'good) :allow-other-keys t :foo t)
+  good)
+
+(deftest lambda.29
+  ((lambda (&key) 'good) :allow-other-keys t :allow-other-keys nil :foo t)
+  good)
+
+(deftest lambda.30
+  ((lambda (&key x) x) :allow-other-keys t :x 10
+   :allow-other-keys nil :foo t)
+  10)
+
+(deftest lambda.31
+  ((lambda (&rest x &key) x))
+  nil)
+
+(deftest lambda.32
+  ((lambda (&rest x &key) x) :allow-other-keys nil)
+  (:allow-other-keys nil))
+
+(deftest lambda.33
+  ((lambda (&rest x &key) x) :w 5 :allow-other-keys t :x 10)
+  (:w 5 :allow-other-keys t :x 10))
+
+(deftest lambda.34
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (s:notnot a-p)
+                                                      b (s:notnot b-p)
+                                                      c (s:notnot c-p)))
+   :c 5 :a 0)
+  (0 t 2 nil 5 t))
+
+(deftest lambda.35
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (s:notnot a-p)
+                                                      b (s:notnot b-p)
+                                                      c (s:notnot c-p)))
+   :c 5 :a nil :a 17 :c 100)
+  (nil t 2 nil 5 t))
+
+(deftest lambda.36
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (s:notnot a-p)
+                                                      b (s:notnot b-p)
+                                                      c (s:notnot c-p)))
+   :c 5 :a 0 :allow-other-keys t 'b 100)
+  (0 t 2 nil 5 t))
+
+(deftest lambda.37
+  (let ((b 1))
+    ((lambda (&key (a b) b) (list a b)) :b 'x))
+  (1 x))
+
+(deftest lambda.38
+  (let ((b 1))
+    ((lambda (&key (a b) b) (list a b)) :b 'x :a nil))
+  (nil x))
+
+(deftest lambda.39
+  (let ((a-p :bad))
+    (declare (ignorable a-p))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (s:notnot a-p) (s:notnot b)))))
+  (nil nil nil))
+
+(deftest lambda.40
+  (let ((a-p :bad))
+    (declare (ignorable a-p))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (s:notnot a-p) (s:notnot b)))
+     :a 1))
+  (1 t t))
+
+(deftest lambda.41
+  (let ((a-p :bad))
+    (declare (ignorable a-p))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (s:notnot a-p) (s:notnot b)))
+     :a nil))
+  (nil t t))
+
+(deftest lambda.42
+  ((lambda (&key a b &allow-other-keys) (list a b)) :a 1 :b 2)
+  (1 2))
+
+(deftest lambda.43
+  ((lambda (&key a b &allow-other-keys) (list a b)) :b 2 :a 1)
+  (1 2))
+
+(deftest lambda.44
+  ((lambda (&key a b &allow-other-keys) (list a b)) :z 10 :b 2 :b nil :a 1
+   :a 2 'x 100)
+  (1 2))
+
+(deftest lambda.45
+  ((lambda (&key a b &allow-other-keys) (list a b)) :allow-other-keys nil
+   :z 10 :b 2 :b nil :a 1 :a 2 'x 100)
+  (1 2))
+
+(deftest lambda.46
+  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
+   :allow-other-keys nil :a 1 :b 2)
+  (nil 1 2))
+
+(deftest lambda.47
+  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
+   :c 10 :allow-other-keys t :a 1 :b 2 :d 20)
+  (t 1 2))
+
+(deftest lambda.48
+  ((lambda (&key a b allow-other-keys &allow-other-keys)
+     (list allow-other-keys a b))
+   :d 40 :allow-other-keys nil :a 1 :b 2 :c 20)
+  (nil 1 2))
+
+(deftest lambda.49
+  ((lambda (&key a b allow-other-keys &allow-other-keys)
+     (list allow-other-keys a b))
+   :d 40 :a 1 :b 2 :c 20)
+  (nil 1 2))
+
+(deftest lambda.50
+  ((lambda (&key a b ((:allow-other-keys aok)))
+     (list aok a b))
+   :d 40 :a 1 :allow-other-keys t :b 2 :c 20)
+  (t 1 2))
+
+(deftest lambda.51
+  ((lambda (&key &allow-other-keys)) :a 1 :b 2 :c 3)
+  nil)
+
+;;; Free declaration scope
+
+(deftest lambda.52
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      ((lambda (&optional (y x)) (declare (special x)) y))))
+  :good)
+
+(deftest lambda.53
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      ((lambda (&key (y x)) (declare (special x)) y))))
+  :good)
+
+(deftest lambda.54
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good))
+      ((lambda (&aux (y x)) (declare (special x)) y))))
+  :good)
+
+(5am:test lambda.55
+  (5am:is (equal '("LMB55" "LMB55")
+                 (let* ((doc "LMB55")
+                        (fn (ceval `#'(lambda () ,doc nil)))
+                        (cfn (ccompile nil fn)))
+                   (list
+                    (or (documentation fn t) doc)
+                    (or (documentation cfn t) doc))))))
+
+(5am:test lambda.56
+  (5am:is (equal '("LMB56" "LMB56")
+                 (let* ((doc "LMB56")
+                        (fn (ceval `#'(lambda () ,doc nil)))
+                        (cfn (ccompile nil fn)))
+                   (list
+                    (or (documentation fn 'function) doc)
+                    (or (documentation cfn 'function) doc))))))
+
+;;; Uninterned symbols as lambda variables
+
+(deftest lambda.57
+  ((lambda (#1=#:foo) #1#) 17)
+  17)
+
+(deftest lambda.58
+  ((lambda (&rest #1=#:foo) #1#) 'a 'b 'c)
+  (a b c))
+
+(deftest lambda.59
+  ((lambda (&optional #1=#:foo) #1#))
+  nil)
+
+(deftest lambda.60
+  ((lambda (&optional (#1=#:foo t)) #1#))
+  t)
+
+(deftest lambda.61
+  ((lambda (&optional (#1=#:foo t)) #1#) 'bar)
+  bar)
+
+(deftest lambda.62
+  ((lambda (&key #1=#:foo) #1#) :foo 12)
+  12)
+
+;;; Test that declarations for aux variables are handled properly
+
+(deftest lambda.63
+  (let ((y :bad1))
+    (declare (ignore y))
+    (let ((y :bad2))
+      (declare (special y))
+      (flet ((%f () y))
+        ((lambda (x &aux (y :good))
+           (declare (special y) (ignore x))
+           (%f))
+         nil))))
+  :good)
+
+(deftest lambda.64
+  (let ((x :bad))
+    (declare (special x))
+    (flet ((%f () x))
+      ((lambda (x &aux (y (%f)))
+         (declare (type t y) (special x))
+         y)
+       :good)))
+  :good)
+
+;;; Tests of lambda as a macro
+
+#+(or)
+(deftest lambda.macro.1
+  (s:notnot (macro-function 'lambda))
+  t)
+
+#+(or)
+(deftest lambda.macro.2
+  (funcall (eval (macroexpand '(lambda () 10))))
+  10)
+
+;;; Error tests
+
+#+(or)
+(deftest lambda.error.1
+  (signals-error (funcall (macro-function 'lambda))
+                 program-error)
+  t)
+
+#+(or)
+(deftest lambda.error.2
+  (signals-error (funcall (macro-function 'lambda) '(lambda ()))
+                 program-error)
+  t)
+
+#+(or)
+(deftest lambda.error.3
+  (signals-error (funcall (macro-function 'lambda) '(lambda ()) nil nil)
+                 program-error)
+  t)
diff --git a/test/ansi/let.lisp b/test/ansi/let.lisp
new file mode 100644
index 0000000..6ce7f57
--- /dev/null
+++ b/test/ansi/let.lisp
@@ -0,0 +1,173 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Oct 12 09:24:36 2002
+;;;; Contains: Tests for LET, LET*
+
+(in-package #:cvm.test)
+
+(5am:def-suite let :in data-and-control-flow)
+(5am:in-suite let)
+
+;;; LET and LET* are also heavily exercised in the many other tests.
+
+;;; NOTE!  Some of these tests bind a variable with the same name
+;;; more than once.  This apparently has underdetermined semantics that
+;;; varies in different Lisps.
+
+(deftest let.1
+  (let ((x 0)) x)
+  0)
+
+(deftest let.2
+  (let ((x 0) (y 1)) (values x y))
+  0 1)
+
+(deftest let.3
+  (let ((x 0) (y 1)) (declare (special x y)) (values x y))
+  0 1)
+
+(deftest let.4
+  (let ((x 0))
+    (let ((x 1))
+      x))
+  1)
+
+(deftest let.5
+  (let ((x 0))
+    (let ((#:x 1))
+      x))
+  0)
+
+(deftest let.6
+  (let ((x 0))
+    (declare (special x))
+    (let ((x 1))
+      (values x (locally (declare (special x)) x))))
+  1 0)
+
+(deftest let.7
+  (let ((x '(a b c)))
+    (declare (dynamic-extent x))
+    x)
+  (a b c))
+
+;;;(deftest let.8
+;;;  (let ((x 0) (x 1)) x)
+;;;  1)
+
+(deftest let.9
+  (let (x y z) (values x y z))
+  nil nil nil)
+
+;;; (deftest let.10
+;;;  (let ((x 1) x) x)
+;;;  nil)
+
+(deftest let.11
+  (let ((x 1))
+    (list x
+          (let (x)
+            (declare (special x))
+            x)
+          x))
+  (1 nil 1))
+
+;;; (deftest let.12
+;;;  (let ((x 0))
+;;;    (values
+;;;     (let ((x 20)
+;;;        (x (1+ x)))
+;;;       x)
+;;;     x))
+;;;   1 0)
+
+;;; (deftest let.13
+;;;  (flet ((%f () (declare (special x))
+;;;          (if (boundp 'x) x 10)))
+;;;    (let ((x 1)
+;;;       (x (1+ (%f))))
+;;;      (declare (special x))
+;;;      x))
+;;;  11)
+
+;;; Tests of large number of LET variables
+(5am:test let.14
+  (let* ((n 100)
+         (vars (mapcar #'gensym (make-list n :initial-element "G")))
+         (expr `(let ,(let ((i 0))
+                        (mapcar #'(lambda (v) (list v (incf i))) vars))
+                  ,(let ((sumexpr 0))
+                     (dolist (v vars)
+                       (setq sumexpr `(+ ,v ,sumexpr)))
+                     sumexpr)))
+         (val (ceval expr)))
+    (5am:is (eql (/ (* n (1+ n)) 2) val))))
+
+;;; Test that all non-variables exported from COMMON-LISP can be bound
+;;; in LET forms.
+#+(or)
+(deftest let.15
+  (loop for s in *cl-non-variable-constant-symbols*
+        for form = `(ignore-errors (let ((,s 17)) ,s))
+        unless (eql (eval form) 17)
+        collect s)
+  nil)
+
+;;; Check that LET does not have a tagbody
+(deftest let.16
+  (block done
+    (tagbody
+     (let () (go 10) 10 (return-from done 'bad))
+     10
+     (return-from done 'good)))
+  good)
+
+;;; Check that free declarations do not apply to the init forms
+
+(deftest let.17
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good)) ;; lexical binding
+      (let ((y x))
+        (declare (special x)) ;; free declaration
+        y)))
+  :good)
+
+(5am:test let.17a
+  (5am:is (eql :good (funcall
+                      (ccompile
+                       nil
+                       '(lambda ()
+                         (let ((x :bad))
+                           (declare (special x))
+                           (let ((x :good)) ;; lexical binding
+                             (let ((y x))
+                               (declare (special x)) ;; free declaration
+                               y)))))))))
+
+(deftest let.18
+  (let ((foo 'special))
+    (declare (special foo))
+    (let ((foo 'lexical))
+      (locally (declare (special foo)))
+      foo))
+  lexical)
+
+#+(or)
+(deftest let.19
+  (loop for k in lambda-list-keywords
+        unless (eql (eval `(let ((,k :foo)) ,k)) :foo)
+        collect k)
+  nil)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest let.20
+  (macrolet ((%m (z) z))
+    (let () (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest let.21
+  (macrolet ((%m (z) z))
+    (let ((x (s:expand-in-current-env (%m 1)))) (+ x x x)))
+  3)
diff --git a/test/ansi/letstar.lisp b/test/ansi/letstar.lisp
new file mode 100644
index 0000000..6ac5708
--- /dev/null
+++ b/test/ansi/letstar.lisp
@@ -0,0 +1,185 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Jun 24 20:53:36 2005
+;;;; Contains: Tests for LET*
+
+(in-package #:cvm.test)
+
+(5am:def-suite let* :in data-and-control-flow)
+(5am:in-suite let*)
+
+(deftest let*.1
+  (let* ((x 0)) x)
+  0)
+
+(deftest let*.2
+  (let* ((x 0) (y 1)) (values x y))
+  0 1)
+
+(deftest let*.3
+  (let* ((x 0) (y 1)) (declare (special x y)) (values x y))
+  0 1)
+
+(deftest let*.4
+  (let* ((x 0))
+    (let* ((x 1))
+      x))
+  1)
+
+(deftest let*.5
+  (let* ((x 0))
+    (let* ((#:x 1))
+      x))
+  0)
+
+(deftest let*.6
+  (let* ((x 0))
+    (declare (special x))
+    (let* ((x 1))
+      (values x (locally (declare (special x)) x))))
+  1 0)
+
+(deftest let*.7
+  (let* ((x '(a b c)))
+    (declare (dynamic-extent x))
+    x)
+  (a b c))
+
+(deftest let*.8
+  (let* ((x 0) (x 1)) x)
+  1)
+
+(deftest let*.9
+  (let* (x y z) (values x y z))
+  nil nil nil)
+
+(deftest let*.10
+  (let* ((x 1) x) x)
+  nil)
+
+(deftest let*.11
+  (let* ((x 1))
+    (list x
+          (let* (x x x)
+            (declare (special x))
+            x)
+          x))
+  (1 nil 1))
+
+(deftest let*.12
+  (let* ((x 1)
+         (y (1+ x))
+         (x (1+ y))
+         (z (+ x y)))
+    (values x y z))
+  3 2 5)
+
+;;; (deftest let*.13
+;;;  (flet ((%f () (declare (special x)) x))
+;;;    (let* ((x 1)
+;;;        (x (1+ (%f))))
+;;;      (declare (special x))
+;;;      x))
+;;;  2)
+
+;;; Tests of large number of LET* variables
+(5am:test let*.14
+  (let* ((n 100)
+         (vars (mapcar #'gensym (make-list n :initial-element "G")))
+         (expr `(let* ,(let ((i 0))
+                         (mapcar #'(lambda (v) (list v (incf i))) vars))
+                  ,(let ((sumexpr 0))
+                     (dolist (v vars)
+                       (setq sumexpr `(+ ,v ,sumexpr)))
+                     sumexpr)))
+         (val (ceval expr)))
+    (5am:is (eql (/ (* n (1+ n)) 2) val))))
+
+;;; Test that all non-variables exported from COMMON-LISP can be bound
+;;; in LET* forms.
+#+(or)
+(deftest let*.15
+  (loop for s in *cl-non-variable-constant-symbols*
+        for form = `(ignore-errors (let* ((,s 17)) ,s))
+        unless (eql (eval form) 17)
+        collect s)
+  nil)
+
+;;; Check that LET* does not have a tagbody
+(deftest let*.16
+  (block done
+    (tagbody
+     (let () (go 10) 10 (return-from done 'bad))
+     10
+     (return-from done 'good)))
+  good)
+
+;;; Check that free declarations do not apply to the init forms
+
+(deftest let*.17
+  (let ((x :bad))
+    (declare (special x))
+    (let ((x :good)) ;; lexical binding
+      (let* ((y x))
+        (declare (special x)) ;; free declaration
+        y)))
+  :good)
+
+(5am:test let*.17a
+  (5am:is (eql :good (funcall
+                      (ccompile
+                       nil
+                       '(lambda ()
+                         (let ((x :bad))
+                           (declare (special x))
+                           (let ((x :good)) ;; lexical binding
+                             (let* ((y x))
+                               (declare (special x)) ;; free declaration
+                               y)))))))))
+
+(deftest let*.18
+  (let ((x :bad1)
+        (z :bad2))
+    (declare (special x z))
+    (let ((x :good)
+          (z :good)) ;; lexical bindings
+      (let* ((y x)
+             (w z))
+        (declare (special x)) ;; free declaration
+        (values y w))))
+  :good
+  :good)
+
+(deftest let*.19
+  (let ((foo 'special))
+    (declare (special foo))
+    (let* ((foo 'lexical))
+      (locally (declare (special foo)))
+      foo))
+  lexical)
+
+#+(or)
+(deftest let*.20
+  (loop for k in lambda-list-keywords
+        unless (eql (eval `(let* ((,k :foo)) ,k)) :foo)
+        collect k)
+  nil)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest let*.21
+  (macrolet ((%m (z) z))
+    (let* () (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest let*.22
+  (macrolet ((%m (z) z))
+    (let* ((x (s:expand-in-current-env (%m 1)))) (+ x x x)))
+  3)
+
+(deftest let*.23
+  (macrolet ((%m (z) z))
+    (let* ((x (s:expand-in-current-env (%m 1)))
+           (y (s:expand-in-current-env (%m 2))))
+      (+ x y)))
+  3)
diff --git a/test/ansi/locally.lisp b/test/ansi/locally.lisp
new file mode 100644
index 0000000..b045520
--- /dev/null
+++ b/test/ansi/locally.lisp
@@ -0,0 +1,49 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Jan  8 06:02:47 2005
+;;;; Contains: Tests of LOCALLY
+
+(in-package #:cvm.test)
+
+(5am:def-suite locally :in eval-and-compile)
+(5am:in-suite locally)
+
+(deftest locally.1
+  (locally)
+  nil)
+
+(deftest locally.2
+  (locally (values)))
+
+(deftest locally.3
+  (locally (values 1 2 3 4))
+  1 2 3 4)
+
+(deftest locally.4
+  (locally (declare) t)
+  t)
+
+(deftest locally.5
+  (locally (declare) (declare) (declare) t)
+  t)
+
+(deftest locally.6
+  (let ((x 'a))
+    (declare (special x))
+    (let ((x 'b))
+      (values
+       x
+       (locally (declare (special x)) x)
+       x)))
+  b a b)
+
+(deftest locally.7
+  (locally (declare))
+  nil)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest locally.8
+  (macrolet ((%m (z) z))
+    (locally (s:expand-in-current-env (%m :good))))
+  :good)
diff --git a/test/ansi/macrolet.lisp b/test/ansi/macrolet.lisp
new file mode 100644
index 0000000..48a0b90
--- /dev/null
+++ b/test/ansi/macrolet.lisp
@@ -0,0 +1,531 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Wed Oct  9 19:41:24 2002
+;;;; Contains: Tests of MACROLET
+
+(in-package #:cvm.test)
+
+(5am:def-suite macrolet :in data-and-control-flow)
+(5am:in-suite macrolet)
+
+;;;; WARNING: Do not use backquote in any code that will be passed
+;;;; to CVM. It is read implementation-specifically, and these tests
+;;;; are designed to run in limited first-class environments.
+
+(deftest macrolet.1
+  (let ((z (list 3 4)))
+    (macrolet ((%m (x) (list 'car x)))
+      (let ((y (list 1 2)))
+        (values (%m y) (%m z)))))
+  1 3)
+
+(deftest macrolet.2
+  (let ((z (list 3 4)))
+    (macrolet ((%m (x) (list 'car x)))
+      (let ((y (list 1 2)))
+        (values
+         (s:setf (%m y) 6)
+         (s:setf (%m z) 'a)
+         y z))))
+  6 a (6 2) (a 4))
+
+;;; Inner definitions shadow outer ones
+(deftest macrolet.3
+  (macrolet ((%m (w) (list 'cadr w)))
+    (let ((z (list 3 4)))
+      (macrolet ((%m (x) (list 'car x)))
+        (let ((y (list 1 2)))
+          (values
+           (%m y) (%m z)
+           (s:setf (%m y) 6)
+           (s:setf (%m z) 'a)
+           y z)))))
+  1 3 6 a (6 2) (a 4))
+
+;;; &whole parameter
+(deftest macrolet.4
+  (let ((x nil))
+    (macrolet ((%m (&whole w arg)
+                 (list 'progn (list 'setq 'x (list 'quote w)) arg)
+                 #+(or)
+                 `(progn (setq x (quote ,w))
+                         ,arg)))
+      (values (%m 1) x)))
+  1 (%m 1))
+
+;;; &whole parameter (nested, destructuring; see section 3.4.4)
+(deftest macrolet.5
+  (let ((x nil))
+    (macrolet ((%m ((&whole w arg))
+                 (list 'progn (list 'setq 'x (list 'quote w)) arg)
+                 #+(or)
+                 `(progn (setq x (quote ,w))
+                         ,arg)))
+      (values (%m (1)) x)))
+  1 (1))
+
+;;; key parameter
+(deftest macrolet.6
+  (let ((x nil))
+    (macrolet ((%m (&key (a 'xxx) b)
+                 (list 'setq 'x (list 'quote a))
+                 #+(or)
+                 `(setq x (quote ,a))))
+      (values (%m :a foo) x
+              (%m :b bar) x)))
+  foo foo xxx xxx)
+
+;;; nested key parameters
+(deftest macrolet.7
+  (let ((x nil))
+    (macrolet ((%m ((&key a b))
+                 (list 'setq 'x (list 'quote a))
+                 #+(or)
+                 `(setq x (quote ,a))))
+      (values (%m (:a foo)) x
+              (%m (:b bar)) x)))
+  foo foo nil nil)
+
+;;; nested key parameters
+(deftest macrolet.8
+  (let ((x nil))
+    (macrolet ((%m ((&key (a 10) b))
+                 (list 'setq 'x (list 'quote a))
+                 #+(or)
+                 `(setq x (quote ,a))))
+      (values (%m (:a foo)) x
+              (%m (:b bar)) x)))
+  foo foo 10 10)
+
+;;; keyword parameter with supplied-p parameter
+(deftest macrolet.9
+  (let ((x nil))
+    (macrolet ((%m (&key (a 'xxx a-p) b)
+                 (list 'setq 'x (list 'quote (list a (not (not a-p)))))
+                 #+(or)
+                 `(setq x (quote ,(list a (not (not a-p)))))))
+      (values (%m :a foo) x
+              (%m :b bar) x)))
+  (foo t) (foo t) (xxx nil) (xxx nil))
+
+
+;;; rest parameter
+(deftest macrolet.10
+  (let ((x nil))
+    (macrolet ((%m (b &rest a)
+                 (list 'setq 'x (list 'quote a))
+                 #+(or)
+                 `(setq x (quote ,a))))
+      (values (%m a1 a2) x)))
+  (a2) (a2))
+
+;;; rest parameter w. destructuring
+(deftest macrolet.11
+  (let ((x nil))
+    (macrolet ((%m ((b &rest a))
+                 (list 'setq 'x (list 'quote a))
+                 #+(or)
+                 `(setq x (quote ,a))))
+      (values (%m (a1 a2)) x)))
+  (a2) (a2))
+
+;;; rest parameter w. whole
+(deftest macrolet.12
+  (let ((x nil))
+    (macrolet ((%m (&whole w b &rest a)
+                 (list 'setq 'x (list 'quote (list a w)))
+                 #+(or)
+                 `(setq x (quote ,(list a w)))))
+      (values (%m a1 a2) x)))
+  ((a2) (%m a1 a2))
+  ((a2) (%m a1 a2)))
+
+;;; Interaction with symbol-macrolet
+
+(deftest macrolet.13
+  (symbol-macrolet ((a b))
+    (macrolet ((foo (x &environment env)
+                 (let ((y (s:macroexpand x env)))
+                   (if (eq y 'a) 1 2))))
+      (foo a)))
+  2)
+
+(deftest macrolet.14
+  (symbol-macrolet ((a b))
+    (macrolet ((foo (x &environment env)
+                 (let ((y (s:macroexpand-1 x env)))
+                   (if (eq y 'a) 1 2))))
+      (foo a)))
+  2)
+
+(deftest macrolet.15
+  (macrolet ((nil () ''a))
+    (nil))
+  a)
+
+#+(or)
+(deftest macrolet.16
+  (loop for s in *cl-non-function-macro-special-operator-symbols*
+        for form = `(ignore-errors (macrolet ((,s () ''a)) (,s)))
+        unless (eq (eval form) 'a)
+        collect s)
+  nil)
+
+(deftest macrolet.17
+  (macrolet ((%m (&key (a t)) (list 'quote a)))
+    (%m :a nil))
+  nil)
+
+(deftest macrolet.18
+  (macrolet ((%m (&key (a t a-p))
+               (list 'quote (list a (s:notnot a-p)))
+               #+(or) `(quote (,a ,(s:notnot a-p)))))
+    (%m :a nil))
+  (nil t))
+
+(deftest macrolet.19
+  (macrolet ((%m (x &optional y)
+               (list 'quote (list x y))
+               #+(or) `(quote (,x ,y))))
+    (values (%m 1) (%m 2 3)))
+  (1 nil)
+  (2 3))
+
+(deftest macrolet.20
+  (macrolet ((%m (x &optional (y 'a))
+               (list 'quote (list x y))
+               #+(or) `(quote (,x ,y))))
+    (values (%m 1) (%m 2 3)))
+  (1 a)
+  (2 3))
+
+;;; Note -- the supplied-p parameter in a macrolet &optional
+;;; is required to be T (not just true) if the parameter is present.
+;;; See section 3.4.4.1.2
+(deftest macrolet.21
+  (macrolet ((%m (x &optional (y 'a y-p))
+               (list 'quote (list x y y-p))
+               #+(or) `(quote (,x ,y ,y-p))))
+    (values (%m 1) (%m 2 3)))
+  (1 a nil)
+  (2 3 t))
+
+(deftest macrolet.22
+  (macrolet ((%m (x &optional ((y z) '(2 3)))
+               (list 'quote (list x y z))
+               #+(or) `(quote (,x ,y ,z))))
+    (values
+     (%m a)
+     (%m a (b c))))
+  (a 2 3)
+  (a b c))
+
+(deftest macrolet.22a
+  (macrolet ((%m (x &optional ((y z) '(2 3) y-z-p))
+               (list 'quote (list x y z y-z-p))
+               #+(or)`(quote (,x ,y ,z ,y-z-p))))
+    (values
+     (%m a)
+     (%m a (b c))))
+  (a 2 3 nil)
+  (a b c t))
+
+(deftest macrolet.23
+  (macrolet ((%m (&rest y) (list 'quote y) #+(or) `(quote ,y)))
+    (%m 1 2 3))
+  (1 2 3))
+
+;;; According to 3.4.4.1.2, the entity following &rest is
+;;; 'a destructuring pattern that matches the rest of the list.'
+
+(5am:test macrolet.24
+  (5am:skip "Ecclesia considers this invalid syntax")
+  #+(or)
+  (is-values-eval (macrolet ((%m (&rest (x y z))
+                               (list 'quote (list x y z))
+                               #+(or) `(quote (,x ,y ,z))))
+                    (%m 1 2 3))
+                  (1 2 3)))
+
+(5am:test macrolet.25
+  (5am:skip "Ecclesia considers this invalid syntax")
+  #+(or)
+  (is-values-eval (macrolet ((%m (&body (x y z))
+                               (list 'quote (list x y z))
+                               #+(or) `(quote (,x ,y ,z))))
+                    (%m 1 2 3))
+                  (1 2 3)))
+
+;;; More key parameters
+
+(deftest macrolet.26
+  (macrolet ((%m (&key ((:a b))) (list 'quote b)))
+    (values (%m)
+            (%m :a x)))
+  nil
+  x)
+
+(deftest macrolet.27
+  (macrolet ((%m (&key ((:a (b c)))) (list 'quote (list c b))))
+    (%m :a (1 2)))
+  (2 1))
+
+(deftest macrolet.28
+  (macrolet ((%m (&key ((:a (b c)) '(3 4)))
+               (list 'quote (list c b))))
+    (values (%m :a (1 2))
+            (%m :a (1 2) :a (10 11))
+            (%m)))
+  (2 1)
+  (2 1)
+  (4 3))
+
+(deftest macrolet.29
+  (macrolet ((%m (&key a (b a)) (list 'quote (list a b))))
+    (values (%m)
+            (%m :a 1)
+            (%m :b 2)
+            (%m :a 3 :b 4)
+            (%m :b 5 :a 6)
+            (%m :a 7 :a 8)
+            (%m :a 9 :b nil)
+            (%m :a 10 :b nil :b 11)))
+  (nil nil)
+  (1 1)
+  (nil 2)
+  (3 4)
+  (6 5)
+  (7 7)
+  (9 nil)
+  (10 nil))
+
+(deftest macrolet.30
+  (macrolet ((%m ((&key a) &key (b a))
+               (list 'quote (list a b))
+               #+(or) `(quote (,a ,b))))
+    (values (%m ())
+            (%m (:a 1))
+            (%m () :b 2)
+            (%m (:a 3) :b 4)
+            (%m (:a 7 :a 8))
+            (%m (:a 9) :b nil)
+            (%m (:a 10) :b nil :b 11)))
+  (nil nil)
+  (1 1)
+  (nil 2)
+  (3 4)
+  (7 7)
+  (9 nil)
+  (10 nil))
+
+(deftest macrolet.31
+  (macrolet ((%m (&key ((:a (b c)) '(3 4) a-p))
+               (list 'quote (list (s:notnot a-p) c b))
+               #+(or) `(quote (,(s:notnot a-p) ,c ,b))))
+    (values (%m :a (1 2))
+            (%m :a (1 2) :a (10 11))
+            (%m)))
+  (t 2 1)
+  (t 2 1)
+  (nil 4 3))
+
+;;; Allow-other-keys tests
+
+(deftest macrolet.32
+  (macrolet ((%m (&key a b c) (list 'quote (list a b c))))
+    (values
+     (%m :allow-other-keys nil)
+     (%m :a 1 :allow-other-keys nil)
+     (%m :allow-other-keys t)
+     (%m :allow-other-keys t :allow-other-keys nil :foo t)
+     (%m :allow-other-keys t :c 1 :b 2 :a 3)
+     (%m :allow-other-keys nil :c 1 :b 2 :a 3)))
+  (nil nil nil)
+  (1 nil nil)
+  (nil nil nil)
+  (nil nil nil)
+  (3 2 1)
+  (3 2 1))
+
+(deftest macrolet.33
+  (macrolet ((%m (&key allow-other-keys)
+               (list 'quote allow-other-keys)))
+    (values
+     (%m)
+     (%m :allow-other-keys nil)
+     (%m :allow-other-keys t :foo t)))
+  nil
+  nil
+  t)
+
+(deftest macrolet.34
+  (macrolet ((%m (&key &allow-other-keys) :good))
+    (values
+     (%m)
+     (%m :foo t)
+     (%m :allow-other-keys nil :foo t)))
+  :good
+  :good
+  :good)
+
+(deftest macrolet.35
+  (macrolet ((%m (&key a b &allow-other-keys)
+               (list 'quote (list a b))))
+    (values
+     (%m :a 1)
+     (%m :foo t :b 2)
+     (%m :allow-other-keys nil :a 1 :foo t :b 2)))
+  (1 nil)
+  (nil 2)
+  (1 2))
+
+;;; &whole is followed by a destructuring pattern (see 3.4.4.1.2)
+(5am:test macrolet.36
+  (5am:skip "Ecclesia considers this invalid syntax")
+  #+(or)
+  (is-values-eval (macrolet ((%m (&whole (m a b) c d)
+                               (list 'quote (list m a b c d))
+                               #+(or) `(quote (,m ,a ,b ,c ,d))))
+                    (%m 1 2))
+                  (%m 1 2 1 2)))
+
+;;; Macro names are shadowed by local functions
+
+(deftest macrolet.37
+  (macrolet ((%f () :bad))
+    (flet ((%f () :good))
+      (%f)))
+  :good)
+
+
+;;; The &environment parameter is bound first
+
+(deftest macrolet.38
+  (macrolet ((foo () 1))
+    (macrolet ((%f (&optional (x (s:macroexpand '(foo) env)) &environment env)
+                 x))
+      (%f)))
+  1)
+
+;;; Test for bug that showed up in sbcl
+
+(5am:test macrolet.39
+  (5am:skip "Ecclesia considers this invalid syntax (probably incorrectly)")
+  #+(or)
+  (is-values-eval (macrolet ((%m (()) :good)) (%m ()))
+                  :good))
+
+;;; Test that macrolets accept declarations
+
+(deftest macrolet.40
+  (macrolet ((%x () t))
+    (declare (optimize)))
+  nil)
+
+(deftest macrolet.41
+  (macrolet ((%x () t))
+    (declare (optimize))
+    (declare (notinline identity)))
+  nil)
+
+(deftest macrolet.42
+  (macrolet ((%x () t))
+    (declare (optimize))
+    (%x))
+  t)
+
+(deftest macrolet.43
+  (let ((*x-in-macrolet.43* nil))
+    (declare (special *x-in-macrolet.43*))
+    (let ((*f* #'(lambda () *x-in-macrolet.43*)))
+      (declare (special *f*))
+      (s:eval '(macrolet ((%m (*x-in-macrolet.43*)
+                           (declare (special *f*))
+                           (funcall *f*)))
+                (%m t)))))
+  nil)
+
+(deftest macrolet.44
+  (let ((*x-in-macrolet.44* nil))
+    (declare (special *x-in-macrolet.44*))
+    (let ((*f* #'(lambda () *x-in-macrolet.44*)))
+      (declare (special *f*))
+      (s:eval '(macrolet ((%m (*x-in-macrolet.44*)
+                            (declare (special *f* *x-in-macrolet.44*))
+                            (funcall *f*)))
+                 (%m t)))))
+  t)
+
+(deftest macrolet.45
+  (let ((*x-in-macrolet.45* nil))
+    (declare (special *x-in-macrolet.45*))
+    (let ((*f* #'(lambda () *x-in-macrolet.45*)))
+      (declare (special *f*))
+      (s:eval '(macrolet ((%m ((*x-in-macrolet.45*))
+                            (declare (special *f* *x-in-macrolet.45*))
+                            (funcall *f*)))
+                 (%m (t))))))
+  t)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest macrolet.46
+  (macrolet ((%m (z) z))
+    (macrolet () (s:expand-in-current-env (%m :good))))
+  :good)
+
+;;; Free declarations in macrolet
+
+(deftest macrolet.47
+  (let ((x :good))
+    (declare (special x))
+    (let ((x :bad))
+      (macrolet () (declare (special x)) x)))
+  :good)
+
+(deftest macrolet.48
+  (let ((x :good))
+    (let ((y :bad))
+      (macrolet () (declare (ignore y)) x)))
+  :good)
+
+(deftest macrolet.49
+  (let ((x :good))
+    (let ((y :bad))
+      (macrolet () (declare (ignorable y)) x)))
+  :good)
+
+
+;;; TODO: more special declarations for other macrolet arguments
+
+
+;;; macrolet shadows global macro, function and compiler-macro
+;;; definitions
+
+#+(or)
+(defmacro macrolet.50 () :bad)
+
+#+(or)
+(deftest macrolet.50
+   (macrolet ((macrolet.50 () :good))
+     (macrolet.50))
+   :good)
+
+#+(or)
+(defun macrolet.51 () :bad)
+
+#+(or)
+(deftest macrolet.51
+   (macrolet ((macrolet.51 () :good))
+      (macrolet.51))
+   :good)
+
+#+(or)
+(define-compiler-macro macrolet.52 (&whole form)
+  :bad)
+
+#+(or)
+(deftest macrolet.52
+   (macrolet ((macrolet.52 () :good))
+      (macrolet.52))
+   :good)
diff --git a/test/ansi/multiple-value-call.lisp b/test/ansi/multiple-value-call.lisp
new file mode 100644
index 0000000..ea3606d
--- /dev/null
+++ b/test/ansi/multiple-value-call.lisp
@@ -0,0 +1,35 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Oct 18 23:35:07 2002
+;;;; Contains: Tests of MULTIPLE-VALUE-CALL, MULTIPLE-VALUE-LIST
+
+(in-package #:cvm.test)
+
+(5am:def-suite multiple-value-call :in data-and-control-flow)
+(5am:in-suite multiple-value-call)
+
+(deftest multiple-value-call.1
+  (multiple-value-call #'+ (values 1 2) (values) 3 (values 4 5 6))
+  21)
+
+(deftest multiple-value-call.2
+  (multiple-value-call 'list)
+  nil)
+
+(deftest multiple-value-call.3
+  (multiple-value-call 'list (floor 13 4))
+  (3 1))
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest multiple-value-call.4
+  (macrolet
+      ((%m (z) z))
+    (multiple-value-call (s:expand-in-current-env (%m #'list)) (values 1 2)))
+  (1 2))
+
+(deftest multiple-value-call.5
+  (macrolet
+      ((%m (z) z))
+    (multiple-value-call 'list (s:expand-in-current-env (%m (values 1 2)))))
+  (1 2))
diff --git a/test/ansi/multiple-value-prog1.lisp b/test/ansi/multiple-value-prog1.lisp
new file mode 100644
index 0000000..67e1fb0
--- /dev/null
+++ b/test/ansi/multiple-value-prog1.lisp
@@ -0,0 +1,101 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Oct 19 06:48:02 2002
+;;;; Contains: Tests for MULTIPLE-VALUE-PROG1
+
+(in-package #:cvm.test)
+
+(5am:def-suite multiple-value-prog1 :in data-and-control-flow)
+(5am:in-suite multiple-value-prog1)
+
+(deftest multiple-value-prog1.1
+  (multiple-value-prog1 nil)
+  nil)
+
+(deftest multiple-value-prog1.2
+  (multiple-value-prog1 '(a b c))
+  (a b c))
+
+(deftest multiple-value-prog1.3
+  (multiple-value-prog1 (values-list '(a b c)))
+  a b c)
+
+(deftest multiple-value-prog1.4
+  (multiple-value-prog1 (values)))
+
+(deftest multiple-value-prog1.5
+  (let ((x 0) (y 0))
+    (multiple-value-prog1 (values x y)
+      (s:incf x) (s:incf y 2)))
+  0 0)
+
+(deftest multiple-value-prog1.6
+  (let ((x 0) (y 0))
+    (multiple-value-call
+     #'list
+     (multiple-value-prog1 (values x y)
+       (s:incf x) (s:incf y 2))
+     x y))
+  (0 0 1 2))
+
+(deftest multiple-value-prog1.7
+  (let ((x 0) (y 0))
+    (multiple-value-call
+     #'list
+     (multiple-value-prog1 (values (s:incf x) y)
+       (s:incf x x)
+       (s:incf y 10))
+     x y))
+  (1 0 2 10))
+
+#+(or)
+(deftest multiple-value-prog1.8
+  (let* ((n (min 100 multiple-values-limit)))
+    (not-mv
+     (loop for i from 0 below n
+           for x = (make-int-list i)
+           always
+           (equalt
+            (multiple-value-list
+             (eval `(multiple-value-prog1 (values-list (quote ,(copy-seq x)))
+                                          nil)))
+            x))))
+  nil)
+
+
+(deftest multiple-value-prog1.9
+  (let ((x 0) (y 0))
+    (values
+     (block foo
+       (multiple-value-prog1
+        (values (s:incf x) (s:incf y 2))
+        (return-from foo 'a)))
+     x y))
+  a 1 2)
+
+;;; No implicit tagbody
+(deftest multiple-value-prog1.10
+  (block nil
+    (tagbody
+     (multiple-value-prog1
+      (values)
+      (go 10)
+      10
+      (return 'bad))
+     10
+     (return 'good)))
+  good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest multiple-value-prog1.11
+  (macrolet
+      ((%m (z) z))
+    (multiple-value-prog1 (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest multiple-value-prog1.12
+  (macrolet
+      ((%m (z) z))
+    (multiple-value-prog1 :good (s:expand-in-current-env (%m :foo))))
+  :good)
diff --git a/test/ansi/optimize.lisp b/test/ansi/optimize.lisp
new file mode 100644
index 0000000..8660079
--- /dev/null
+++ b/test/ansi/optimize.lisp
@@ -0,0 +1,57 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat May 21 09:31:34 2005
+;;;; Contains: Tests of the OPTIMIZE declaration
+
+(in-package #:cvm.test)
+
+(5am:def-suite optimize :in eval-and-compile)
+(5am:in-suite optimize)
+
+(deftest optimize.1
+  (locally (declare (optimize)) nil)
+  nil)
+
+(deftest optimize.2
+  (locally (declare (optimize speed)) nil)
+  nil)
+
+(deftest optimize.3
+  (locally (declare (optimize space)) nil)
+  nil)
+
+(deftest optimize.4
+  (locally (declare (optimize safety)) nil)
+  nil)
+
+(deftest optimize.5
+  (locally (declare (optimize debug)) nil)
+  nil)
+
+(deftest optimize.6
+  (locally (declare (optimize compilation-speed)) nil)
+  nil)
+
+(5am:test optimize.7
+  (5am:is-false
+   (loop for d in '(speed space safety debug compilation-speed)
+         nconc (loop for n from 0 to 3
+                     for form = `(locally (declare (optimize (,d ,n))) t)
+                     for val = (ceval form)
+                     unless (eql val t)
+                       collect (list d n val)))))
+
+(5am:test optimize.8
+  (5am:is-false
+   (loop for d in '(speed space safety debug compilation-speed)
+         nconc (loop for n from 0 to 3
+                     for form = `(lambda ()
+                                   (declare (optimize (,d ,n)))
+                                   t)
+                     for val = (funcall (ccompile nil form))
+                     unless (eql val t)
+                       collect (list d n val)))))
+
+
+
+
diff --git a/test/ansi/progn.lisp b/test/ansi/progn.lisp
new file mode 100644
index 0000000..1438e74
--- /dev/null
+++ b/test/ansi/progn.lisp
@@ -0,0 +1,70 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Oct 19 09:33:51 2002
+;;;; Contains: Tests of PROGN
+
+(in-package #:cvm.test)
+
+(5am:def-suite progn :in data-and-control-flow)
+(5am:in-suite progn)
+
+(deftest progn.1
+  (progn)
+  nil)
+
+(deftest progn.2
+  (progn 'a)
+  a)
+
+(deftest progn.3
+  (progn 'b 'a)
+  a)
+
+(deftest progn.4
+  (let ((x 0))
+    (values (progn (s:incf x) x) x))
+  1 1)
+
+(deftest progn.5 (progn (values)))
+
+(deftest progn.6
+  (progn (values 1 2) (values 'a 'b 'c 'd 'e))
+  a b c d e)
+
+(deftest progn.7
+  (let ((x 0))
+    (prog ()
+       (progn (go x) x 'a)
+       (return 'bad)
+     x
+       (return 'good)))
+  good)
+
+;;; No implicit tagbody
+(deftest progn.8
+  (block nil
+    (tagbody
+     (progn
+      (go 10)
+      10
+      (return 'bad))
+     10
+     (return 'good)))
+  good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest progn.9
+  (macrolet
+      ((%m (z) z))
+    (progn (s:expand-in-current-env (%m :good))))
+  :good)
+
+(deftest progn.10
+  (macrolet
+      ((%m (z) z))
+    (progn (s:expand-in-current-env (%m :bad))
+           (s:expand-in-current-env (%m :good))))
+  :good)
+
+
diff --git a/test/ansi/return-from.lisp b/test/ansi/return-from.lisp
new file mode 100644
index 0000000..71ff5ef
--- /dev/null
+++ b/test/ansi/return-from.lisp
@@ -0,0 +1,27 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Feb 24 20:22:23 2004
+;;;; Contains: Tests of RETURN-FROM
+
+(in-package #:cvm.test)
+
+(5am:def-suite return-from :in data-and-control-flow)
+(5am:in-suite return-from)
+
+;;; RETURN-FROM is tested extensively in other files
+
+(deftest return-from.1
+  (block xyz (return-from xyz) :bad)
+  nil)
+
+(deftest return-from.2
+  (block nil (return-from nil :good) :bad)
+  :good)
+
+;;; Macros are expanded in the appropriate environment
+
+(deftest return-from.3
+  (macrolet
+      ((%m (z) z))
+    (block foo (return-from foo (s:expand-in-current-env (%m :good)))))
+  :good)
diff --git a/test/ansi/special.lisp b/test/ansi/special.lisp
new file mode 100644
index 0000000..df12a51
--- /dev/null
+++ b/test/ansi/special.lisp
@@ -0,0 +1,36 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat May 21 12:51:59 2005
+;;;; Contains: Tests of the declaration SPECIAL
+
+(in-package #:cvm.test)
+
+(5am:def-suite special :in eval-and-compile)
+(5am:in-suite special)
+
+;;; Many tests for this declaration are in the tests
+;;; for specific binding forms.
+
+(deftest special.1
+  (let ((f 1))
+    (declare (special f))
+    (flet ((f () :good))
+      (flet ((g () (f)))
+        (flet ((f () :bad))
+          (g)))))
+  :good)
+
+(deftest special.2
+  (let ((x 'a))
+    (declare (special x))
+    (let ((x 'b))
+      (values x (locally (declare (special x)) x) x)))
+  b a b)
+
+(deftest special.3
+  (flet ((%f () (declare (special x10)) x10))
+    (let ((x10 'a))
+      (declare (special x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12))
+      (%f)))
+  a)
+
diff --git a/test/ansi/symbol-macrolet.lisp b/test/ansi/symbol-macrolet.lisp
new file mode 100644
index 0000000..126fd35
--- /dev/null
+++ b/test/ansi/symbol-macrolet.lisp
@@ -0,0 +1,89 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Jan  8 05:58:53 2005
+;;;; Contains: Tests of SYMBOL-MACROLET
+
+(in-package #:cvm.test)
+
+(5am:def-suite symbol-macrolet :in eval-and-compile)
+
+#+(or)
+(deftest symbol-macrolet.1
+  (loop for s in *cl-non-variable-constant-symbols*
+        for form = `(ignore-errors (symbol-macrolet ((,s 17)) ,s))
+        unless (eql (eval form) 17)
+        collect s)
+  nil)
+
+(deftest symbol-macrolet.2
+  (symbol-macrolet ())
+  nil)
+
+(deftest symbol-macrolet.3
+  (symbol-macrolet () (declare (optimize)))
+  nil)
+
+(deftest symbol-macrolet.4
+  (symbol-macrolet ((x 1))
+    (symbol-macrolet ((x 2))
+      x))
+  2)
+
+(deftest symbol-macrolet.5
+  (let ((x 10))
+     (symbol-macrolet ((y x))
+       (list x
+             y
+             (let ((x 20)) x)
+             (let ((y 30)) x)
+             (let ((y 50)) y)
+             x
+             y)))
+  (10 10 20 10 50 10 10))
+
+(deftest symbol-macrolet.6
+  (symbol-macrolet () (values)))
+
+(deftest symbol-macrolet.7
+  (symbol-macrolet () (values 'a 'b 'c 'd 'e))
+  a b c d e)
+
+(deftest symbol-macrolet.8
+  (let ((x :good))
+    (declare (special x))
+    (let ((x :bad))
+      (symbol-macrolet () (declare (special x)) x)))
+  :good)
+
+;;; Error tests
+
+(5am:test symbol-macrolet.error.1
+  (signals-eval program-error
+                (symbol-macrolet ((x 10))
+                  (declare (special x))
+                  20)))
+
+#+(or)
+(defconstant constant-for-symbol-macrolet.error.2 nil)
+
+#+(or)
+(deftest symbol-macrolet.error.2
+  (signals-error (symbol-macrolet ((constant-for-symbol-macrolet.error.2 'a))
+                   constant-for-symbol-macrolet.error.2)
+                 program-error)
+  t)
+
+#+(or)
+(deftest symbol-macrolet.error.3
+  (signals-error (symbol-macrolet ((*pathnames* 19)) *pathnames*)
+                 program-error)
+  t)
+
+;;; Test that explicit calls to macroexpand in subforms
+;;; are done in the correct environment
+
+(deftest symbol-macrolet.9
+  (macrolet
+      ((%m (z) z))
+    (symbol-macrolet () (s:expand-in-current-env (%m :good))))
+  :good)
diff --git a/test/ansi/tagbody.lisp b/test/ansi/tagbody.lisp
new file mode 100644
index 0000000..07d8e9a
--- /dev/null
+++ b/test/ansi/tagbody.lisp
@@ -0,0 +1,188 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Oct 12 13:27:22 2002
+;;;; Contains: Tests of TAGBODY
+
+(in-package #:cvm.test)
+
+(5am:def-suite tagbody :in data-and-control-flow)
+(5am:in-suite tagbody)
+
+(deftest tagbody.1
+  (tagbody)
+  nil)
+
+(deftest tagbody.2
+  (tagbody 'a)
+  nil)
+
+(deftest tagbody.3
+  (tagbody (values))
+  nil)
+
+(deftest tagbody.4
+  (tagbody (values 1 2 3 4 5))
+  nil)
+
+(deftest tagbody.5
+  (let ((x 0))
+    (values
+     (tagbody
+      (setq x 1)
+      (go a)
+      (setq x 2)
+      a)
+     x))
+  nil 1)
+
+(deftest tagbody.6
+  (let ((x 0))
+    (tagbody
+     (setq x 1)
+     (go a)
+     b
+     (setq x 2)
+     (go c)
+     a
+     (setq x 3)
+     (go b)
+     c)
+    x)
+  2)
+
+;;; Macroexpansion occurs after tag determination
+(deftest tagbody.7
+  (let ((x 0))
+    (macrolet ((%m () 'a))
+      (tagbody
+       (tagbody
+        (go a)
+        (%m)
+        (setq x 1))
+       a ))
+    x)
+  0)
+
+(deftest tagbody.8
+  (let ((x 0))
+    (tagbody
+     (flet ((%f (y) (setq x y) (go a)))
+       (%f 10))
+     (setq x 1)
+     a)
+    x)
+  10)
+
+;;; Tag names are in their own name space
+(deftest tagbody.9
+  (let (result)
+    (tagbody
+     (flet ((a (x) x))
+       (setq result (a 10))
+       (go a))
+     a)
+    result)
+  10)
+
+(deftest tagbody.10
+  (let (result)
+    (tagbody
+     (block a
+       (setq result 10)
+       (go a))
+     (setq result 20)
+     a)
+    result)
+  10)
+
+#+(or) ; catch not working yet
+(deftest tagbody.11
+  (let (result)
+    (tagbody
+     (catch 'a
+       (setq result 10)
+       (go a))
+     (setq result 20)
+     a)
+    result)
+  10)
+
+(deftest tagbody.12
+  (let (result)
+    (tagbody
+     (block a
+       (setq result 10)
+       (return-from a nil))
+     (setq result 20)
+     a)
+    result)
+  20)
+
+;;; Test that integers are accepted as go tags
+
+(deftest tagbody.13
+  (block done
+    (tagbody
+     (go around)
+     10
+     (return-from done 'good)
+     around
+     (go 10)))
+  good)
+
+(deftest tagbody.14
+  (block done
+    (tagbody
+     (go around)
+     -10
+     (return-from done 'good)
+     around
+     (go -10)))
+  good)
+
+(deftest tagbody.15
+  (block done
+    (tagbody
+     (go around)
+     #.(1+ most-positive-fixnum)
+     (return-from done 'good)
+     around
+     (go #.(1+ most-positive-fixnum))))
+  good)
+
+(5am:test tagbody.16
+  (let* ((t1 (1+ most-positive-fixnum))
+         (t2 (1+ most-positive-fixnum))
+         (form `(block done
+                  (tagbody
+                   (go around)
+                   ,t1
+                   (return-from done 'good)
+                   around
+                   (go ,t2)))))
+    (5am:is (eql 'good (ceval form)))))
+
+;;; Check that macros are not expanded before finding tags
+;;; Test for issue TAGBODY-TAG-EXPANSION
+
+(deftest tagbody.17
+  (block done
+    (tagbody
+     (macrolet ((foo () 'tag))
+       (let (tag)
+         (tagbody
+          (go tag)
+          (foo)
+          (return-from done :bad))))
+     tag
+     (return-from done :good)))
+  :good)
+
+;;; Test that explicit calls to macroexpand in subforms
+;;; are done in the correct environment
+
+(deftest tagbody.18
+  (macrolet ((%m (z) z))
+    (tagbody
+      (s:expand-in-current-env (%m :foo))))
+  nil)
diff --git a/test/ansi/the.lisp b/test/ansi/the.lisp
new file mode 100644
index 0000000..beff2b6
--- /dev/null
+++ b/test/ansi/the.lisp
@@ -0,0 +1,160 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue May  6 06:48:48 2003
+;;;; Contains: Tests of THE
+
+(in-package #:cvm.test)
+
+(5am:def-suite the :in eval-and-compile)
+(5am:in-suite the)
+
+(deftest the.1
+  (the (values) (values)))
+
+(deftest the.2
+  (the (values) 'a)
+  a)
+
+#+(or)
+(deftest the.3
+  (check-predicate #'(lambda (e)
+                       (let ((x (multiple-value-list (eval `(the (values) (quote ,e))))))
+                         (and x (not (cdr x)) (eql (car x) e)))))
+  nil)
+
+#+(or)
+(deftest the.4
+  (check-predicate #'(lambda (e)
+                       (let ((x (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))))
+                         (and x (not (cdr x)) (eql (car x) e)))))
+  nil)
+
+#+(or)
+(deftest the.5
+  (check-predicate #'(lambda (e)
+                       (let ((x (multiple-value-list (eval `(the (values ,(type-of e)) (quote ,e))))))
+                         (and x (not (cdr x)) (eql (car x) e)))))
+  nil)
+
+#+(or)
+(deftest the.6
+  (check-predicate #'(lambda (e)
+                       (let ((x (multiple-value-list (eval `(the (values ,(type-of e) t) (quote ,e))))))
+                         (and x (not (cdr x)) (eql (car x) e)))))
+  nil)
+
+#+(or)
+(deftest the.7
+  (check-predicate
+   #'(lambda (e)
+       (let ((x (multiple-value-list (eval `(the (values ,(type-of e))
+                                              (values (quote ,e) :ignored))))))
+         (and (eql (length x) 2)
+              (eql (car x) e)
+              (eql (cadr x) :ignored)))))
+  nil)
+
+#+(or)
+(deftest the.8
+  (check-predicate #'(lambda (e) (or (not (constantp e))
+                                     (eql (eval `(the ,(type-of e) ,e)) e))))
+  nil)
+
+#+(or)
+(deftest the.9
+  (check-predicate #'(lambda (e) (or (not (constantp e))
+                                     (eql (eval `(the ,(class-of e) ,e)) e))))
+  nil)
+
+#+(or)
+(deftest the.10
+  (check-predicate #'(lambda (e) (eql (eval `(the ,(class-of e) ',e)) e)))
+  nil)
+
+#+(or)
+(deftest the.11
+  (check-predicate
+   #'(lambda (e)
+       (let* ((type (type-of e))
+              (x (multiple-value-list (eval `(the ,type (the ,type (quote ,e)))))))
+         (and x (not (cdr x)) (eql (car x) e)))))
+  nil)
+
+#+(or)
+(deftest the.12
+  (let ((lexpr
+         `(lambda ()
+            (and
+             ,@(loop for e in *mini-universe*
+                     for type = (type-of e)
+                     collect `(eqlt (quote ,e) (the ,type (quote ,e))))))))
+    (funcall (compile nil lexpr)))
+  t)
+
+(deftest the.13
+  (let ((x 0))
+    (values
+     (the (or symbol integer) (s:incf x))
+     x))
+  1 1)
+
+(deftest the.14
+  (the (values &rest t) (values 'a 'b))
+  a b)
+
+(deftest the.15
+  (the (values &rest symbol) (values 'a 'b))
+  a b)
+
+(deftest the.16
+  (the (values &rest null) (values)))
+
+(deftest the.17
+  (the (values symbol integer &rest null) (values 'a 1))
+  a 1)
+
+(deftest the.18
+  (the (values symbol integer &rest t) (values 'a 1 'foo '(x y)))
+  a 1 foo (x y))
+
+#+(or)
+(deftest the.19
+  (let () (list (the (values) (eval '(values)))))
+  (nil))
+
+;;; This is from SBCL bug 261
+#+(or)
+(deftest the.20
+  (let () (list (the (values &optional fixnum) (eval '(values)))))
+  (nil))
+
+#+(or)
+(deftest the.21
+  (let () (list (the (values &rest t) (eval '(values)))))
+  (nil))
+
+#+(or)
+(deftest the.22
+  (the (values symbol integer &rest t) (eval '(values 'a 1 'foo '(x y))))
+  a 1 foo (x y))
+
+#+(or)
+(deftest the.23
+  (multiple-value-list
+   (the (values symbol integer &optional fixnum) (eval '(values 'a 1))))
+  (a 1))
+
+;;; Test that explicit calls to macroexpand in subforms
+;;; are done in the correct environment
+
+(deftest the.24
+  (macrolet
+      ((%m (z) z))
+    (the (integer 0 10) (s:expand-in-current-env (%m 4))))
+  4)
+
+(deftest the.25
+  (macrolet
+      ((%m (z) z))
+    (the (values t t) (s:expand-in-current-env (%m (values 1 2)))))
+  1 2)
diff --git a/test/ansi/type.lisp b/test/ansi/type.lisp
new file mode 100644
index 0000000..cba79f3
--- /dev/null
+++ b/test/ansi/type.lisp
@@ -0,0 +1,77 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun May 29 08:25:46 2005
+;;;; Contains: Tests of TYPE declarations
+
+(in-package #:cvm.test)
+
+(5am:def-suite type :in eval-and-compile)
+(5am:in-suite type)
+
+;;; Also of implicit type declarations
+
+(deftest type.1
+  (let ((x 1))
+    (declare (type (integer 0 1) x))
+    (values
+     x
+     (setq x 0)
+     (1+ x)))
+  1 0 1)
+
+(deftest type.2
+  (let ((x 1))
+    (declare (type (integer -1 1) x))
+    (locally (declare (type (integer 0 2) x))
+      (values
+       x
+       (setq x 0)
+       (1+ x))))
+  1 0 1)
+
+#+(or)
+(deftest type.3
+  (loop for x in *mini-universe*
+        for tp = (type-of x)
+        for form = `(let ((y ',x))
+                      (declare (type ,tp y))
+                      y)
+        for val = (eval form)
+        unless (eql val x)
+        collect (list x tp form val))
+  nil)
+
+#+(or)
+(deftest type.4
+  (loop for x in *mini-universe*
+        for tp = (type-of x)
+        for form = `(let ((y ',x))
+                      (declare (,tp y))
+                      y)
+        for val = (eval form)
+        unless (eql val x)
+        collect (list x tp form val))
+  nil)
+
+#+(or)
+(deftest type.5
+  (loop for x in *mini-universe*
+        for class = (class-of x)
+        for form = `(let ((y ',x))
+                      (declare (,class y))
+                      y)
+        for val = (eval form)
+        unless (eql val x)
+        collect (list x class form val))
+  nil)
+
+;;; Free TYPE declaration
+;;; It should not apply to the occurence of X in the form
+;;; whose value is being bound to Y.
+
+(deftest type.6
+  (let ((x 2))
+    (let ((y (+ (s:decf x) 2)))
+      (declare (type (integer 0 1) x))
+      (values x y)))
+  1 3)
diff --git a/test/cross-sham.lisp b/test/cross-sham.lisp
new file mode 100644
index 0000000..f9db23a
--- /dev/null
+++ b/test/cross-sham.lisp
@@ -0,0 +1,117 @@
+(in-package #:cvm.test)
+
+#| ; accounting for what's actually used
+compile: (eq let quote)
+dynamic-extent: (let quote list length vector flet mapcar labels consp cons car cdr most-positive-fixnum 1- values setq prog1 make-array coerce equal make-string every eql s:setf function)
+eval: (let)
+eval-when: (eval-when values setq let s:expand-in-current-env)
+ignorable: ()
+ignore: ()
+lambda: (s:notnot 1+ s:incf) ; not the lambda macro, funnily enough
+locally: (locally t nil macrolet) ; nil's probably in an earlier file, w/e
+optimize: ()
+special: ()
+symbol-macrolet: (symbol-macrolet)
+the: (the)
+type: (s:decf)
+block: (block return-from return tagbody)
+flet: (:x) ; bla bla keywords will need a clostrum intercept
+if: (if =)
+labels:
+let: (+)
+multiple-value-call: (multiple-value-call floor)
+multiple-value-prog1: (values-list)
+progn: (progn go)
+return-from: ()
+tagbody: ()
+|#
+
+(defun define-specials (client environment)
+  ;; from figure 3-2
+  (loop for op in '(block      let*                  return-from
+                    catch      load-time-value       setq
+                    eval-when  locally               symbol-macrolet
+                    flet       macrolet              tagbody
+                    function   multiple-value-call   the
+                    go         multiple-value-prog1  throw
+                    if         progn                 unwind-protect
+                    labels     progv
+                    let        quote)
+        do (clostrum:make-special-operator client environment op t)))
+
+;;; define functions that can be just copied from the host
+(defun define-aliases (client environment)
+  (loop for op in '(list length vector consp cons car cdr null not
+                    ;; coerce only ok because no test does
+                    ;; (coerce foo 'function)
+                    1+ 1- + = - values make-array coerce make-string
+                    values-list eq eql equal equalp
+                    error)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f)))
+
+(defun define-sham-aliases (client environment)
+  (loop for op in '(s:notnot)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f))
+  (loop for op in '(s:macroexpand-1 s:macroexpand)
+        for cl in '(  macroexpand-1   macroexpand)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f
+                 (clostrum:fdefinition client environment cl) f)))
+
+;;; functions that can be copied except we ban the env-specific parts
+(defun define-stricter-aliases (client environment)
+  (loop for op in '(mapc mapcar mapcan mapl maplist mapcon
+                    every some notany notevery funcall apply)
+        for f = (fdefinition op)
+        for g = (let ((f f))
+                  (lambda (fun &rest args)
+                    (check-type fun function)
+                    (apply f fun args)))
+        do (setf (clostrum:fdefinition client environment op) g)))
+
+;;; constants copied from the host
+(defun define-constants (client environment)
+  (loop for c in '(t nil most-positive-fixnum most-negative-fixnum)
+        for v = (symbol-value c)
+        do (clostrum:make-constant client environment c v)))
+
+(defun define-macros (client environment)
+  (loop for mac in '(s:expand-in-current-env setf-1)
+        for f = (macro-function mac)
+        do (setf (clostrum:macro-function client environment mac) f))
+  (loop for mac in '(s:multiple-value-bind
+                     s:setf s:incf s:decf
+                     s:when s:unless s:prog1)
+        for cl in    '(multiple-value-bind
+                       setf   incf   decf
+                       when   unless   prog1)
+        for f = (macro-function mac)
+        do (setf (clostrum:macro-function client environment mac) f
+                 (clostrum:macro-function client environment cl) f)))
+
+(defun fill-environment (client environment)
+  (define-specials client environment)
+  (define-aliases client environment)
+  (define-sham-aliases client environment)
+  (define-stricter-aliases client environment)
+  (define-constants client environment)
+  (define-macros client environment))
+
+;;; On top of all that, we need to define a client so that we
+;;; can define some methods to automatically bind keywords.
+(defclass cross-client (cvm.cross:client) ())
+
+(defmethod clostrum-sys:variable-cell :around ((client cross-client)
+                                               environment symbol)
+  (let ((cell (call-next-method)))
+    (when (keywordp symbol)
+      (setf (clostrum-sys:variable-cell-value client cell) symbol))
+    cell))
+
+(defmethod clostrum-sys:variable-status :around ((client cross-client)
+                                                 environment symbol)
+  (if (keywordp symbol)
+      :constant
+      (call-next-method)))
diff --git a/test/cross/README b/test/cross/README
new file mode 100644
index 0000000..27bf9a4
--- /dev/null
+++ b/test/cross/README
@@ -0,0 +1,3 @@
+This system runs the cvm/test tests with the cross VM. It has its own client, mostly to handle keywords, but you can use any environment as long as it works with Clostrum.
+
+The environment must have a certain small subset of the CL symbols bound appropriately, along with a few extras. FILL-ENVIRONMENT will define these for you, given an environment.
diff --git a/test/cross/packages.lisp b/test/cross/packages.lisp
new file mode 100644
index 0000000..1f8b29d
--- /dev/null
+++ b/test/cross/packages.lisp
@@ -0,0 +1,4 @@
+(defpackage #:cvm.test.cross
+  (:use #:cl)
+  (:local-nicknames (#:s #:cvm.test.sham))
+  (:export #:fill-environment #:run #:run!))
diff --git a/test/cross/rt.lisp b/test/cross/rt.lisp
new file mode 100644
index 0000000..b63eb6a
--- /dev/null
+++ b/test/cross/rt.lisp
@@ -0,0 +1,9 @@
+(in-package #:cvm.test.cross)
+
+(defvar *client* (make-instance 'client))
+
+(defun fill-environment (environment)
+  (%fill-environment *client* environment))
+
+(defun run (environment) (cvm.test:run environment *client*))
+(defun run! (environment) (cvm.test:run! environment *client*))
diff --git a/test/cross/script.lisp b/test/cross/script.lisp
new file mode 100644
index 0000000..b048097
--- /dev/null
+++ b/test/cross/script.lisp
@@ -0,0 +1,36 @@
+;;; This script is used by the github automation to run the tests.
+;;; You can also use it yourself: just load this file. SBCL will quit
+;;; with exit status based on whether everything passed.
+
+(ql:quickload '(:cvm/test/cross :clostrum-basic))
+
+(defpackage #:cvm.test.script
+  (:use #:cl))
+
+(in-package #:cvm.test.script)
+
+;;; from ANSI tests
+(defun exit (successp &aux (code (if successp 0 1)))
+  #+abcl (ext:quit :status code)
+  #+acl (excl:exit code :no-unwind t :quiet t)
+  #+ccl (ccl:quit code)
+  #+cmucl (handler-case (ext:quit nil code)
+            ;; Only the most recent versions of cmucl support an exit code.
+            ;; If it doesn't, we get a program error (wrong number of args),
+            ;; so catch that and just call quit without the arg.
+            (program-error ()
+              (ext:quit)))
+  #+(or clasp clisp ecl) (ext:quit code)
+  #+gcl (lisp:quit code)
+  #+lispworks (lispworks:quit :status code :ignore-errors-p t)
+  #+sbcl (sb-ext:exit :code code))
+
+(defun test ()
+  (cvm.cross.vm:initialize-vm 20000)
+  (let* ((rte (make-instance 'clostrum-basic:run-time-environment))
+         (ce (make-instance 'clostrum-basic:compilation-environment
+               :parent rte)))
+    (cvm.test.cross:fill-environment rte)
+    (exit (cvm.test.cross:run! ce))))
+
+(test)
diff --git a/test/cross/sham.lisp b/test/cross/sham.lisp
new file mode 100644
index 0000000..cf694e8
--- /dev/null
+++ b/test/cross/sham.lisp
@@ -0,0 +1,139 @@
+(in-package #:cvm.test.cross)
+
+#| ; accounting for what's actually used
+compile: (eq let quote)
+dynamic-extent: (let quote list length vector flet mapcar labels consp cons car cdr most-positive-fixnum 1- values setq prog1 make-array coerce equal make-string every eql s:setf function)
+eval: (let)
+eval-when: (eval-when values setq let s:expand-in-current-env)
+ignorable: ()
+ignore: ()
+lambda: (s:notnot 1+ s:incf) ; not the lambda macro, funnily enough
+locally: (locally t nil macrolet) ; nil's probably in an earlier file, w/e
+optimize: ()
+special: ()
+symbol-macrolet: (symbol-macrolet)
+the: (the)
+type: (s:decf)
+block: (block return-from return tagbody)
+flet: (:x) ; bla bla keywords will need a clostrum intercept
+if: (if =)
+labels:
+let: (+)
+multiple-value-call: (multiple-value-call floor)
+multiple-value-prog1: (values-list)
+progn: (progn go)
+return-from: ()
+tagbody: ()
+|#
+
+(defun define-specials (client environment)
+  ;; from figure 3-2
+  (loop for op in '(block      let*                  return-from
+                    catch      load-time-value       setq
+                    eval-when  locally               symbol-macrolet
+                    flet       macrolet              tagbody
+                    function   multiple-value-call   the
+                    go         multiple-value-prog1  throw
+                    if         progn                 unwind-protect
+                    labels     progv
+                    let        quote)
+        do (clostrum:make-special-operator client environment op t)))
+
+;;; define functions that can be just copied from the host
+(defun define-aliases (client environment)
+  (loop for op in '(list list* length vector make-array make-string
+                    consp cons car cdr null not
+                    ;; coerce only ok because no test does
+                    ;; (coerce foo 'function)
+                    1+ 1- + = - floor values functionp coerce
+                    values-list eq eql equal equalp
+                    error)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f)))
+
+;;; may or may not exist in the lisp, so
+(defun define-setters (client environment)
+  (flet (((setf %car) (new cons) (setf (car cons) new))
+         ((setf %cdr) (new cons) (setf (cdr cons) new)))
+    (setf (clostrum:fdefinition client environment '(setf car)) #'(setf %car)
+          (clostrum:fdefinition client environment '(setf cdr)) #'(setf %cdr))))
+
+(defun define-sham-aliases (client environment)
+  (loop for op in '(s:notnot)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f))
+  (loop for op in '(s:macroexpand-1 s:macroexpand s:eval)
+        for cl in '(  macroexpand-1   macroexpand   eval)
+        for f = (fdefinition op)
+        do (setf (clostrum:fdefinition client environment op) f
+                 (clostrum:fdefinition client environment cl) f)))
+
+(defun define-env-access (client environment)
+  ;; fdefinition is used implicitly by multiple-value-call.
+  (flet ((%fdefinition (name)
+           (clostrum:fdefinition client environment name))
+         (%symbol-function (name)
+           (check-type name symbol)
+           (clostrum:fdefinition client environment name)))
+    (setf (clostrum:fdefinition client environment 'fdefinition)
+          #'%fdefinition
+          (clostrum:fdefinition client environment 'symbol-function)
+          #'%symbol-function)))
+
+;;; functions that can be copied except we ban the env-specific parts
+(defun define-stricter-aliases (client environment)
+  (loop for op in '(mapc mapcar mapcan mapl maplist mapcon
+                    every some notany notevery funcall apply)
+        for f = (fdefinition op)
+        for g = (let ((f f))
+                  (lambda (fun &rest args)
+                    (check-type fun function)
+                    (apply f fun args)))
+        do (setf (clostrum:fdefinition client environment op) g)))
+
+;;; constants copied from the host
+(defun define-constants (client environment)
+  (loop for c in '(t nil most-positive-fixnum most-negative-fixnum)
+        for v = (symbol-value c)
+        do (clostrum:make-constant client environment c v)))
+
+(defun define-macros (client environment)
+  (loop for mac in '(s:expand-in-current-env)
+        for f = (macro-function mac)
+        do (setf (clostrum:macro-function client environment mac) f))
+  (loop for mac in '(s:multiple-value-bind
+                     s:setf s:incf s:decf
+                     s:when s:unless s:prog1 s:prog s:return)
+        for cl in    '(multiple-value-bind
+                       setf   incf   decf
+                       when   unless   prog1   prog   return)
+        for f = (macro-function mac)
+        do (setf (clostrum:macro-function client environment mac) f
+                 (clostrum:macro-function client environment cl) f)))
+
+(defun %fill-environment (client environment)
+  (define-specials client environment)
+  (define-aliases client environment)
+  (define-setters client environment)
+  (define-sham-aliases client environment)
+  (define-env-access client environment)
+  (define-stricter-aliases client environment)
+  (define-constants client environment)
+  (define-macros client environment))
+
+;;; On top of all that, we need to define a client so that we
+;;; can define some methods to automatically bind keywords.
+(defclass client (cvm.cross:client) ())
+
+(defmethod clostrum-sys:variable-cell :around ((client client)
+                                               environment symbol)
+  (let ((cell (call-next-method)))
+    (when (keywordp symbol)
+      (setf (clostrum-sys:variable-cell-value client cell) symbol))
+    cell))
+
+(defmethod clostrum-sys:variable-status :around ((client client)
+                                                 environment symbol)
+  (if (keywordp symbol)
+      :constant
+      (call-next-method)))
diff --git a/test/native-sham.lisp b/test/native-sham.lisp
new file mode 100644
index 0000000..da1065b
--- /dev/null
+++ b/test/native-sham.lisp
@@ -0,0 +1,149 @@
+(in-package #:cvm.test)
+
+;;;; KLUDGE TIME
+;;;; In an ideal world, all Lisp implementations would support
+;;;; first-class environments, and their MACROEXPAND(-1)
+;;;; implementations would go through a common interface like Trucler
+;;;; so that they could be used with custom environments like ours.
+;;;; In our world, none of them do this. This means that any macro
+;;;; that calls MACROEXPAND(-1) will very likely throw a fit if
+;;;; our compiler expands it. Sometimes it's worse - in SBCL,
+;;;; seemingly innocuous macros like COND and UNLESS try to grab an
+;;;; internal policy object from their environment, so we can't even
+;;;; use those.
+;;;; In this file we define some sham operators that work with the
+;;;; VM compiler's environments properly. These are used in the tests
+;;;; rather than the standard operators.
+;;;; VERY IMPORTANTLY, these sham operators must ONLY used in code that
+;;;; is fed to the VM compiler - not code for the host. This is in
+;;;; preparation for that ideal world, in which the environment
+;;;; these tests are run in is minimally defined to include only the
+;;;; standard special operators, these few macros, and a short list of
+;;;; functions to be catalogued.
+
+;;; Force true values to T.
+(defun s:notnot (v) (not (not v)))
+
+(defun s:macroexpand-1 (form &optional env)
+  (typecase form
+    (symbol
+     (let ((info (trucler:describe-variable *client* env form)))
+       (if (typep info 'trucler:symbol-macro-description)
+           (values (cvm.compile:symbol-macro-expansion info form env) t)
+           (values form nil))))
+    (cons
+     (let* ((head (car form))
+            (info (if (symbolp head)
+                      (trucler:describe-function *client* env head)
+                      nil)))
+       (if (typep info 'trucler:macro-description)
+           (values (cvm.compile:expand (trucler:expander info) form env) t)
+           (values form nil))))
+    (t (values form nil))))
+
+(defun s:macroexpand (form &optional env)
+  (loop with ever-expanded = nil
+        do (multiple-value-bind (expansion expandedp)
+               (s:macroexpand-1 form env)
+             (if expandedp
+                 (setq ever-expanded t form expansion)
+                 (return (values form ever-expanded))))))
+
+;;; used in e.g. MACROLET.43
+(setf (fdefinition 's:eval) #'ceval)
+
+;;; Macro used in tests of environments in system macros
+;;; This was inspired by a bug in ACL 8.0 beta where CONSTANTP
+;;; was being called in some system macros without the proper
+;;; environment argument
+(defmacro s:expand-in-current-env (macro-form &environment env)
+  (s:macroexpand macro-form env))
+
+;;; used indirectly in ecclesia:parse-macro results
+(defmacro s:when (test &body forms)
+  `(if ,test (progn ,@forms) nil))
+(defmacro s:unless (test &body forms)
+  `(if ,test nil (progn ,@forms)))
+
+(defmacro s:prog1 (result &body body)
+  (let ((temp (gensym)))
+    ;; progn to invalidate declarations
+    `(let ((,temp ,result)) (progn ,@body) ,temp)))
+
+(defmacro s:return (&optional value) `(return-from nil ,value))
+
+(defmacro s:prog ((&rest bindings) &body body)
+  (multiple-value-bind (body decls) (alexandria:parse-body body)
+    `(block nil
+       (let (,@bindings)
+         ,@decls
+         (tagbody ,@body)))))
+
+;;; SETF is also quite common.
+(defun default-symbol-setf-expansion (symbol)
+  (let ((new (gensym "NEW")))
+    (values () () `(,new) `(setq ,symbol ,new) symbol)))
+
+(defun default-call-setf-expansion (fname arguments)
+  (let ((new (gensym "NEW"))
+        (temps (loop repeat (length arguments) collect (gensym))))
+    (values temps arguments `(,new)
+            `(funcall #'(setf ,fname) ,new ,@temps)
+            `(,fname ,@temps))))
+
+(defun %get-setf-expansion (place &optional env)
+  (etypecase place
+    (symbol (multiple-value-bind (expansion expandedp)
+                (s:macroexpand-1 place env)
+              (if expandedp
+                  (%get-setf-expansion expansion env)
+                  (default-symbol-setf-expansion place))))
+    (cons (let* ((head (car place))
+                 (rest (rest place))
+                 (info (trucler:describe-function *client* env head)))
+            (typecase info
+              (trucler:local-function-description ; shadowed
+               (default-call-setf-expansion head rest))
+              (trucler:local-macro-description
+               ;; note that we leave global macros to the host,
+               ;; because there might be a global setf expander
+               ;; that overrides the macroexpansion.
+               (%get-setf-expansion (s:macroexpand-1 place env) env))
+              (t ; (for now) we have no setf expanders, so
+               (default-call-setf-expansion head rest)))))))
+
+(defmacro s:multiple-value-bind (vars valform &body body)
+  (if (= (length vars) 1)
+      `(let ((,(first vars) ,valform)) ,@body)
+      (let ((r (gensym "REST")))
+        `(multiple-value-call (lambda (&optional ,@(mapcar #'list vars)
+                                       &rest ,r)
+                                (declare (ignore ,r))
+                                ,@body)
+           ,valform))))
+
+(defmacro s:setf (&rest pairs &environment env)
+  (flet ((expand-setf-1 (place value)
+           (multiple-value-bind (temps forms news write read)
+               (%get-setf-expansion place env)
+             (declare (ignore read))
+             `(let* (,@(mapcar #'list temps forms))
+                (multiple-value-bind (,@news) ,value
+                  ,write)))))
+    `(progn
+       ,@(loop for (place value) on pairs by #'cddr
+               collect (expand-setf-1 place value)))))
+
+;;; Used extensively in tests as side effects.
+(defmacro s:incf (place &optional (delta 1) &environment env)
+  (multiple-value-bind (temps forms news write read)
+      (%get-setf-expansion place env)
+    `(let* (,@(mapcar #'list temps forms))
+       (multiple-value-bind (,@news) (+ ,read ,delta)
+         ,write))))
+(defmacro s:decf (place &optional (delta 1) &environment env)
+  (multiple-value-bind (temps forms news write read)
+      (%get-setf-expansion place env)
+    `(let* (,@(mapcar #'list temps forms))
+       (multiple-value-bind (,@news) (- ,read ,delta)
+         ,write))))
diff --git a/test/packages.lisp b/test/packages.lisp
new file mode 100644
index 0000000..71d97e4
--- /dev/null
+++ b/test/packages.lisp
@@ -0,0 +1,15 @@
+(defpackage #:cvm.test.sham
+  (:use)
+  (:export #:expand-in-current-env #:notnot)
+  (:export #:macroexpand-1 #:macroexpand #:eval)
+  (:export #:multiple-value-bind #:setf #:incf #:decf
+           #:prog1 #:when #:unless #:return #:prog))
+
+(defpackage #:cvm.test
+  (:use #:cl)
+  (:local-nicknames (#:s #:cvm.test.sham))
+  (:export #:run #:run!)
+  ;; We don't define these. They're shadowed so that if you
+  ;; use one accidentally in a test, you get an obvious error.
+  ;; We could shadow eval but that messes with e.g. eval-when.
+  (:shadow #:eval #:compile))
diff --git a/test/rt.lisp b/test/rt.lisp
new file mode 100644
index 0000000..d3c3a3f
--- /dev/null
+++ b/test/rt.lisp
@@ -0,0 +1,33 @@
+(in-package #:cvm.test)
+
+(defvar *environment*)
+(defvar *client*)
+
+(defun ceval (form)
+  (cvm.compile:eval form *environment* *client*))
+
+(defun ccompile (name definition)
+  (declare (ignore name))
+  (etypecase definition
+    ((cons (eql lambda))
+     (cvm.compile:compile definition *environment* *client*))
+    ;; this happens in lambda.55,56
+    (function definition)))
+
+(defmacro is-true-eval (form)
+  `(5am:is-true (ceval ',form)))
+
+(defmacro signals-eval (condition-type form)
+  `(5am:signals ,condition-type (ceval ',form)))
+
+(defmacro is-values-eval (form &rest expected)
+  `(5am:is (equal '(,@expected)
+                  (multiple-value-list (ceval ',form)))))
+
+(defmacro deftest (name form &rest expected)
+  `(5am:test ,name
+     (is-values-eval ,form ,@expected)))
+
+(defun run (*environment* *client*) (5am:run 'cvm))
+
+(defun run! (*environment* *client*) (5am:run! 'cvm))
diff --git a/test/script.lisp b/test/script.lisp
new file mode 100644
index 0000000..fe3de6f
--- /dev/null
+++ b/test/script.lisp
@@ -0,0 +1,33 @@
+;;; This script is used by the github automation to run the tests.
+;;; You can also use it yourself: just load this file. SBCL will quit
+;;; with exit status based on whether everything passed.
+
+(ql:quickload :cvm/test)
+
+(defpackage #:cvm.test.script
+  (:use #:cl))
+
+(in-package #:cvm.test.script)
+
+;;; from ANSI tests
+(defun exit (successp &aux (code (if successp 0 1)))
+  #+abcl (ext:quit :status code)
+  #+acl (excl:exit code :no-unwind t :quiet t)
+  #+ccl (ccl:quit code)
+  #+cmucl (handler-case (ext:quit nil code)
+            ;; Only the most recent versions of cmucl support an exit code.
+            ;; If it doesn't, we get a program error (wrong number of args),
+            ;; so catch that and just call quit without the arg.
+            (program-error ()
+              (ext:quit)))
+  #+(or clasp clisp ecl) (ext:quit code)
+  #+gcl (lisp:quit code)
+  #+lispworks (lispworks:quit :status code :ignore-errors-p t)
+  #+sbcl (sb-ext:exit :code code))
+
+(defun test ()
+  (cvm.vm:initialize-vm 20000)
+  ;; won't work outside SBCL
+  (exit (cvm.test:run! nil (make-instance 'trucler-native-sbcl:client))))
+
+(test)
diff --git a/test/suites.lisp b/test/suites.lisp
new file mode 100644
index 0000000..562fb83
--- /dev/null
+++ b/test/suites.lisp
@@ -0,0 +1,6 @@
+(in-package #:cvm.test)
+
+(5am:def-suite cvm)
+
+(5am:def-suite eval-and-compile :in cvm)
+(5am:def-suite data-and-control-flow :in cvm)
diff --git a/vm.lisp b/vm.lisp
index 01783f8..c537571 100644
--- a/vm.lisp
+++ b/vm.lisp
@@ -1,6 +1,7 @@
 (defpackage #:cvm.vm
   (:use #:cl)
-  (:local-nicknames (#:m #:cvm.machine))
+  (:local-nicknames (#:m #:cvm.machine)
+                    (#:arg #:cvm.argparse))
   (:export #:initialize-vm)
   (:export #:*trace*))
 
@@ -221,20 +222,23 @@
                    ((#.m:check-arg-count-<=)
                     (let ((n (next-code)))
                       (unless (<= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need at most ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :max-nargs n)))
                     (incf ip))
                    ((#.m:check-arg-count->=)
                     (let ((n (next-code)))
                       (unless (>= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need at least ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :min-nargs n)))
                     (incf ip))
                    ((#.m:check-arg-count-=)
                     (let ((n (next-code)))
                       (unless (= (vm-arg-count vm) n)
-                        (error "Invalid number of arguments: Got ~d, need exactly ~d."
-                               (vm-arg-count vm) n)))
+                        (error 'arg:wrong-number-of-arguments
+                               :given-nargs (vm-arg-count vm)
+                               :min-nargs n :max-nargs n)))
                     (incf ip))
                    ((#.m:jump-if-supplied-8)
                     (incf ip (if (typep (stack (+ bp (next-code))) 'unbound-marker)
@@ -292,7 +296,7 @@
                            (key-literal-start (next-code))
                            (key-literal-end (+ key-literal-start key-count))
                            (key-frame-start (+ bp (next-code)))
-                           (unknown-key-p nil)
+                           (unknown-keys nil)
                            (allow-other-keys-p nil))
                       ;; Initialize all key values to #<unbound-marker>
                       (loop for index from key-frame-start below (+ key-frame-start key-count)
@@ -302,24 +306,28 @@
                             ((< arg-index more-start)
                              (cond ((= arg-index (1- more-start)))
                                    ((= arg-index (- more-start 2))
-                                    (error "Passed odd number of &KEY args!"))
+                                    (error 'arg:odd-keywords))
                                    (t
                                     (error "BUG! This can't happen!"))))
                           (let ((key (stack (1- arg-index))))
-                            (if (eq key :allow-other-keys)
-                                (setf allow-other-keys-p (stack arg-index))
-                                (loop for key-index from key-literal-start
-                                        below key-literal-end
-                                      for offset of-type (unsigned-byte 16)
-                                      from key-frame-start
-                                      do (when (eq (constant key-index) key)
-                                           (setf (stack offset) (stack arg-index))
-                                           (return))
-                                      finally (setf unknown-key-p key))))))
+                            (when (eq key :allow-other-keys)
+                              (setf allow-other-keys-p (stack arg-index)))
+                            (loop for key-index from key-literal-start
+                                    below key-literal-end
+                                  for offset of-type (unsigned-byte 16)
+                                  from key-frame-start
+                                  do (when (eq (constant key-index) key)
+                                       (setf (stack offset) (stack arg-index))
+                                       (return))
+                                  finally (unless (or allow-other-keys-p
+                                                      ;; aok is always allowed
+                                                      (eq key :allow-other-keys))
+                                            (push key unknown-keys))))))
                       (when (and (not (or (logbitp 7 key-count-info)
                                           allow-other-keys-p))
-                                 unknown-key-p)
-                        (error "Unknown key arg ~a!" unknown-key-p)))
+                                 unknown-keys)
+                        (error 'arg:unrecognized-keyword-argument
+                               :unrecognized-keywords unknown-keys)))
                     (incf ip))
                    ((#.m:save-sp)
                     (setf (stack (+ bp (next-code))) sp)