[slime-cvs] CVS update: slime/swank-loader.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12128

Modified Files:
	swank-loader.lisp 
Log Message:
Place the fasl files of different implementations in different
directories.  Patch by Peter Seibel.

Date: Wed Feb 18 02:31:59 2004
Author: heller

Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.16 slime/swank-loader.lisp:1.17
--- slime/swank-loader.lisp:1.16	Thu Feb  5 00:57:04 2004
+++ slime/swank-loader.lisp	Wed Feb 18 02:31:59 2004
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-loader.lisp,v 1.16 2004/02/05 05:57:04 wjenkner Exp $
+;;;   $Id: swank-loader.lisp,v 1.17 2004/02/18 07:31:59 heller Exp $
 ;;;
 
 (cl:defpackage :swank-loader
@@ -35,12 +35,25 @@
           #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
           ))
 
+(defparameter *lisp-name*
+  #+cmu "cmu"
+  #+sbcl "sbcl"
+  #+openmcl "openmcl"
+  #+lispworks "lispworks"
+  #+allegro "allegro"
+  #+clisp "clisp")
+
 (defparameter *swank-pathname* (make-swank-pathname "swank"))
 
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."
   (> (file-write-date new-file) (file-write-date old-file)))
 
+(defun binary-pathname (source-pathname)
+  (merge-pathnames
+   (make-pathname :directory `(:relative "fasl" ,*lisp-name*))
+   (merge-pathnames (compile-file-pathname source-pathname))))
+
 (defun compile-files-if-needed-serially (files)
   "Compile each file in FILES if the source is newer than
 its corresponding binary, or the file preceding it was 
@@ -48,14 +61,15 @@
   (with-compilation-unit ()
     (let ((needs-recompile nil))
       (dolist (source-pathname files)
-        (let ((binary-pathname (compile-file-pathname source-pathname)))
+        (let ((binary-pathname (binary-pathname source-pathname)))
           (handler-case
               (progn
                 (when (or needs-recompile
                           (not (probe-file binary-pathname))
                           (file-newer-p source-pathname binary-pathname))
                   (format t "~&;; Compiling ~A...~%" source-pathname)
-                  (compile-file source-pathname)
+                  (ensure-directories-exist binary-pathname)
+                  (compile-file source-pathname :output-file binary-pathname)
                   (setq needs-recompile t))
                 (load binary-pathname))
             #+(or)