anchor.diff:  		     nil)))
   	(t vector)))
   
  -(defun compile-genesis-function (object)
  -  (progv (list (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C")))
  -      (list (cond ((eql (genesis-function-suppress-builtins object) :default)
  -                   (symbol-value (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C"))))
  -                  (t (genesis-function-suppress-builtins object))))
  -    (let ((fn (genesis-eval (list (genesis-eval (list (genesis-intern "INTERN") "COMPILE-LAMBDA" "SYS.C"))
  -                                  (list (genesis-intern "QUOTE") (genesis-function-source object))
  -                                  (list (genesis-intern "QUOTE") (convert-environment (genesis-function-source-environment object)))))))
  -      #+nil(let ((*print-circle* nil))
  -             (format t "Asm: ~S~%" (genesis-function-lap-code fn)))
  -      (setf (genesis-function-lap-code object) (genesis-function-lap-code fn)
  -            (genesis-function-assembled-code object) (genesis-function-assembled-code fn)
  -            (genesis-function-constants object) (genesis-function-constants fn))
  -      object)))
  -
  -(defbuiltin #:assemble-lap (code &optional name)
  +(defun assemble-lap (code &optional name)
     (multiple-value-bind (mc constants)
         (genesis-eval (list (genesis-eval (list (genesis-intern "INTERN") "ASSEMBLE" "SYS.LAP-X86"))
                             (list (genesis-intern "QUOTE") code)
                             (genesis-intern "BASE-ADDRESS" t) 12
                             (genesis-intern "INITIAL-SYMBOLS" t) (list (genesis-intern "QUOTE") *lap-symbols*)
                             (genesis-intern "INFO" t) (list (genesis-intern "QUOTE") (list name))))
  +    (values (strip-array-header mc) (strip-array-header constants))))
  +
  +(defun compile-genesis-function (object)
  +  (cond ((genesis-function-lap-function object)
  +         (multiple-value-bind (assembled-code constants)
  +             (assemble-lap (cddr (genesis-function-source object))
  +                           (first (second (genesis-function-source object))))
  +           (setf (genesis-function-lap-code object) (cddr (genesis-function-source object))
  +                 (genesis-function-assembled-code object) (strip-array-header assembled-code)
  +                 (genesis-function-constants object) (strip-array-header constants))))
  +        (t (progv (list (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C")))
  +               (list (cond ((eql (genesis-function-suppress-builtins object) :default)
  +                            (symbol-value (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C"))))
  +                           (t (genesis-function-suppress-builtins object))))
  +             (let ((fn (genesis-eval (list (genesis-eval (list (genesis-intern "INTERN") "COMPILE-LAMBDA" "SYS.C"))
  +                                           (list (genesis-intern "QUOTE") (genesis-function-source object))
  +                                           (list (genesis-intern "QUOTE") (convert-environment (genesis-function-source-environment object)))))))
  +               #+nil(let ((*print-circle* nil))
  +                      (format t "Asm: ~S~%" (genesis-function-lap-code fn)))
  +               (setf (genesis-function-lap-code object) (genesis-function-lap-code fn)
  +                     (genesis-function-assembled-code object) (genesis-function-assembled-code fn)
  +                     (genesis-function-constants object) (genesis-function-constants fn))))))
  +  object)
  +
  +(defbuiltin #:assemble-lap (code &optional name)
  +  (multiple-value-bind (mc constants)
  +      (assemble-lap code name)
       (make-genesis-function :lap-code code
   			   :assembled-code (strip-array-header mc)
   			   :constants (strip-array-header constants))))
  
positive.code: (defparameter *builtin-suppression-mode* :default)
  
  (defun fastload-form (form)
    (when (and (listp form)
               (= (list-length form) 4)
               (eql (first form) (genesis-intern "FUNCALL"))
               (listp (second form))
               (= (list-length (second form)) 2)
               (eql (first (second form)) (genesis-intern "FUNCTION"))
               (listp (second (second form)))
               (= (list-length (second (second form))) 2)
               (eql (first (second (second form))) (genesis-intern "SETF"))
               (eql (second (second (second form))) (genesis-intern "FDEFINITION"))
               (listp (third form))
               (= (list-length (third form)) 2)
               (eql (first (third form)) (genesis-intern "FUNCTION"))
               (listp (second (third form)))
               (eql (first (second (third form))) (genesis-intern "LAMBDA"))
               (listp (third form))
               (= (list-length (fourth form)) 2)
               (eql (first (fourth form)) (genesis-intern "QUOTE")))
      ;; FORM looks like (FUNCALL #'(SETF FDEFINITION) #'(LAMBDA ...) 'name)
      ;; Check if there's an existing function or an existing preload.
      (let ((name (resolve-function-name (second (fourth form)))))
        (when (and (not (assoc name *function-preloads*))
                   (not (and (fboundp name)
                             (gethash (symbol-function name) *function-info*))))
          (push (cons name (make-genesis-function :source (second (third form))
                                                  :source-environment nil
                                                  :suppress-builtins *builtin-suppression-mode*))
                *function-preloads*)
          t))))
  
  (defun make-toplevel-function (&rest files)
    (let ((toplevel-forms '()))
  
negative.code: (in-package #:genesis)
  
  (defstruct genesis-function
    (lap-function nil)
    source
    source-environment
    (suppress-builtins :default)
  