[slime-cvs] CVS slime

CVS User sboukarev sboukarev at common-lisp.net
Wed Aug 25 08:20:09 UTC 2010


Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv21707

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (exec-image): Use (car sb-ext:*posix-argv*) if
SBCL doesn't have sb-ext:*runtime-pathname*.
Reported by Vinay.


--- /project/slime/cvsroot/slime/ChangeLog	2010/08/22 10:51:10	1.2130
+++ /project/slime/cvsroot/slime/ChangeLog	2010/08/25 08:20:09	1.2131
@@ -1,3 +1,9 @@
+2010-08-25  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sbcl.lisp (exec-image): Use (car sb-ext:*posix-argv*) if
+	SBCL doesn't have sb-ext:*runtime-pathname*.
+	Reported by Vinay.
+
 2010-08-22  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-xemacs-recompute-modelines): Add
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2010/08/21 06:39:59	1.274
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2010/08/25 08:20:09	1.275
@@ -1592,16 +1592,24 @@
                (sb-posix:syscall-error)))
         (sb-alien:free-alien a-args))))
 
+  (defun runtime-pathname ()
+    #+#.(swank-backend:with-symbol
+            '*runtime-pathname* 'sb-ext)
+    sb-ext:*runtime-pathname*
+    #-#.(swank-backend:with-symbol
+            '*runtime-pathname* 'sb-ext)
+    (car sb-ext:*posix-argv*))
+
   (defimplementation exec-image (image-file args)
     (loop with fd-arg =
           (loop for arg in args
                 and key = "" then arg
                 when (string-equal key "--swank-fd")
-                  return (parse-integer arg))
+                return (parse-integer arg))
           for my-fd from 3 to 1024
           when (/= my-fd fd-arg)
-            do (ignore-errors (sb-posix:fcntl my-fd sb-posix:f-setfd 1)))
-    (let* ((self-string (pathname-to-filename sb-ext:*runtime-pathname*)))
+          do (ignore-errors (sb-posix:fcntl my-fd sb-posix:f-setfd 1)))
+    (let* ((self-string (pathname-to-filename (runtime-pathname))))
       (execv
        self-string
        (apply 'list self-string "--core" image-file args)))))





More information about the slime-cvs mailing list