1.0.1.18:

[sbcl.git] / src / compiler / fopcompile.lisp

diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp
index 42cff0f..7f18013 100644 (file)
--- a/src/compiler/fopcompile.lisp
+++ b/src/compiler/fopcompile.lisp
@@ -108,7 +108,7 @@
                            (every #'fopcompilable-p (cdr args))))
                      ;; Likewise for LOCALLY
                      ((locally)
-                      (every #'fopcompilable-p (cdr args)))
+                      (every #'fopcompilable-p args))
                      (otherwise
                       ;; ordinary function calls
                       (and (symbolp operator)
@@ -196,7 +196,11 @@
                       (declare (ignore init-form))
                       (case creation-form
                         (:sb-just-dump-it-normally
-                         (fasl-validate-structure constant *compile-object*)
+                         ;; FIXME: Why is this needed? If the constant
+                         ;; is deemed fopcompilable, then when we dump
+                         ;; it we bind *dump-only-valid-structures* to
+                         ;; NIL.
+                         (fasl-validate-structure value *compile-object*)
                          (dotimes (i (- (%instance-length value)
                                         (layout-n-untagged-slots
                                          (%instance-ref value 0))))
@@ -276,21 +280,36 @@
                      (fopcompile (cons 'progn (cdr args)) path for-value-p))
                    ;; Otherwise it must be an ordinary funcall.
                    (otherwise
-                    (fopcompile-constant operator t)
-                    (dolist (arg args)
-                      (fopcompile arg path t))
-                    (if for-value-p
-                        (sb!fasl::dump-fop 'sb!fasl::fop-funcall
-                                           *compile-object*)
-                        (sb!fasl::dump-fop 'sb!fasl::fop-funcall-for-effect
-                                           *compile-object*))
-                    (let ((n-args (length args)))
-                      ;; stub: FOP-FUNCALL isn't going to be usable
-                      ;; to compile more than this, since its count
-                      ;; is a single byte. Maybe we should just punt
-                      ;; to the ordinary compiler in that case?
-                      (aver (<= n-args 255))
-                      (sb!fasl::dump-byte n-args *compile-object*))))))))
+                    (cond
+                      ;; Special hack: there's already a fop for
+                      ;; find-undeleted-package-or-lose, so use it.
+                      ;; (We could theoretically do the same for
+                      ;; other operations, but I don't see any good
+                      ;; candidates in a quick read-through of
+                      ;; src/code/fop.lisp.)
+                      ((and (eq operator
+                                'sb!int:find-undeleted-package-or-lose)
+                            (= 1 (length args))
+                            for-value-p)
+                       (fopcompile (first args) path t)
+                       (sb!fasl::dump-fop 'sb!fasl::fop-package
+                                          *compile-object*))
+                      (t
+                       (fopcompile-constant operator t)
+                       (dolist (arg args)
+                         (fopcompile arg path t))
+                       (if for-value-p
+                           (sb!fasl::dump-fop 'sb!fasl::fop-funcall
+                                              *compile-object*)
+                           (sb!fasl::dump-fop 'sb!fasl::fop-funcall-for-effect
+                                              *compile-object*))
+                       (let ((n-args (length args)))
+                         ;; stub: FOP-FUNCALL isn't going to be usable
+                         ;; to compile more than this, since its count
+                         ;; is a single byte. Maybe we should just punt
+                         ;; to the ordinary compiler in that case?
+                         (aver (<= n-args 255))
+                         (sb!fasl::dump-byte n-args *compile-object*))))))))))
         (t
          (bug "looks unFOPCOMPILEable: ~S" form))))
 
@@ -359,5 +378,9 @@
 
 (defun fopcompile-constant (form for-value-p)
   (when for-value-p
+    ;; FIXME: Without this binding the dumper chokes on unvalidated
+    ;; structures: CONSTANT-FOPCOMPILABLE-P validates the structure
+    ;; about to be dumped, not its load-form. Compare and contrast
+    ;; with EMIT-MAKE-LOAD-FORM.
     (let ((sb!fasl::*dump-only-valid-structures* nil))
       (dump-object form *compile-object*))))