X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffopcompile.lisp;h=c0dfd12661cc7cad5ef5c835a72636035588fa58;hb=447477e72bd4fe54e678a28bdcc4a2802797d6ed;hp=42cff0f05c7f31f2dad0cc5d93860612283f60e4;hpb=3ca73f72116001579bde0f59e5aa1359cc41631e;p=sbcl.git

diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp
index 42cff0f..c0dfd12 100644
--- 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)
@@ -276,21 +276,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))))