[armedbear-cvs] r13531 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Mon Aug 22 07:48:39 2011
New Revision: 13531

Log:
Optimize the compilation of files with a large number of compilands.

Don't use DIRECTORY with a wildcard unless when compiling files unless
we know of the presence of at least one class constant ".clc" via
PROBE-FILE.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Mon Aug 22 02:52:28 2011	(r13530)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Mon Aug 22 07:48:39 2011	(r13531)
@@ -588,12 +588,18 @@
       (let ((truename (probe-file (compute-classfile-name (1+ i)))))
         (when truename
           (push truename pathnames)
-          (dolist (resource (directory
-                             (make-pathname :name (format nil "~A_*"
-                                                           (pathname-name truename))
-                                            :type "clc"
-                                            :defaults truename)))
-            (push resource pathnames)))))
+          ;;; XXX it would be better to just use the recorded number
+          ;;; of class constants, but probing for the first at least
+          ;;; makes this subjectively bearable.
+          (when (probe-file (make-pathname :name (format nil "~A_1" (pathname-name truename))
+                                           :type "clc"
+                                           :defaults truename))
+            (dolist (resource (directory
+                               (make-pathname :name (format nil "~A_*"
+                                                            (pathname-name truename))
+                                              :type "clc"
+                                              :defaults truename)))
+              (push resource pathnames))))))
     (setf pathnames (nreverse (remove nil pathnames)))
     (let ((load-file (merge-pathnames (make-pathname :type "_")
                                       output-file)))