/[slime]/slime/swank-loader.lisp
ViewVC logotype

Diff of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38 by mbaringer, Tue Mar 1 23:23:49 2005 UTC revision 1.39 by pseibel, Tue Mar 8 02:35:19 2005 UTC
# Line 33  Line 33 
33             #+armedbear '("swank-abcl")             #+armedbear '("swank-abcl")
34             )))             )))
35    
36  (defparameter *lisp-name*  (defparameter *implementation-features*
37    #+cmu       (format nil "cmu-~A"    '(:allegro :sbcl :openmcl :cmu :ccl :corman :armedbear :gcl))
38                        (substitute #\- #\/ (lisp-implementation-version)))  
39    #+sbcl      (format nil "sbcl-~A" (lisp-implementation-version))  (defparameter *os-features*
40    #+openmcl   "openmcl"    '(:macosx :linux :windows :solaris :darwin :sunos :unix))
41    #+lispworks (format nil "lispworks-~A" (lisp-implementation-version))  
42    #+allegro   (format nil "allegro-~A" excl::*common-lisp-version-number*)  (defparameter *architecture-features*
43    #+clisp     (format nil "clisp-~A" (let ((s (lisp-implementation-version)))    '(:powerpc :ppc :x86 :i686 :sparc))
44                                         (subseq s 0 (position #\space s))))  
45    #+armedbear "abcl"  (defun unique-directory-name ()
46    )    "Return a name that can be used as a directory name that is
47    unique to a Lisp implementation, Lisp implementation version,
48    operating system, and hardware architecture."
49      (flet ((first-of (features)
50               (loop for f in features
51                  when (find f *features*) return it)))
52        (let ((lisp         (first-of *implementation-features*))
53              (os           (first-of *os-features*))
54              (architecture (first-of *architecture-features*))
55              (version
56               (block nil
57                 #+cmu
58                 (return (substitute #\- #\/ (lisp-implementation-version)))
59                 #+sbcl
60                 (return (lisp-implementation-version))
61                 #+gcl
62                 (let ((s (lisp-implementation-version))) (subseq s 4))
63                 #+openmcl
64                 (return (format nil "~d.~d"
65                                 ccl::*openmcl-major-version*
66                                 ccl::*openmcl-minor-version*))
67                 #+lispworks
68                 (return (lisp-implementation-version))
69                 #+allegro
70                 (return excl::*common-lisp-version-number*)
71                 #+clisp
72                 (return (let ((s (lisp-implementation-version)))
73                           (subseq s 0 (position #\space s))))
74                 #+armedbear
75                 (return "unknown")
76    
77                 (error "Don't know how to get Lisp implementation version."))))
78    
79          (unless lisp
80            (warn "No implementation feature found in ~a."
81                  *implementation-features*)
82            (setf lisp "unknown"))
83          (unless os
84            (warn "No os feature found in ~a." *os-features*)
85            (setf os "unknown"))
86          (unless architecture
87            (warn "No architecture feature found in ~a."
88                  *architecture-features*)
89            (setf architecture "unknown"))
90    
91          (format nil "~(~@{~a~^-~}~)" lisp version os architecture))))
92    
93  (defparameter *swank-pathname* (make-swank-pathname "swank"))  (defparameter *swank-pathname* (make-swank-pathname "swank"))
94    
# Line 55  Line 100 
100    "Return the pathname where SOURCE-PATHNAME's binary should be compiled."    "Return the pathname where SOURCE-PATHNAME's binary should be compiled."
101    (let ((cfp (compile-file-pathname source-pathname)))    (let ((cfp (compile-file-pathname source-pathname)))
102      (merge-pathnames (make-pathname      (merge-pathnames (make-pathname
103                        :directory `(:relative ".slime" "fasl" ,*lisp-name*)                        :directory
104                          `(:relative ".slime" "fasl" ,(unique-directory-name))
105                        :name (pathname-name cfp)                        :name (pathname-name cfp)
106                        :type (pathname-type cfp))                        :type (pathname-type cfp))
107                       (user-homedir-pathname))))                       (user-homedir-pathname))))

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.39

  ViewVC Help
Powered by ViewVC 1.1.5