? sbcl-1.0.40-windows-x86
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.273
diff -u -r1.273 swank-sbcl.lisp
--- swank-sbcl.lisp	12 Aug 2010 12:09:45 -0000	1.273
+++ swank-sbcl.lisp	19 Aug 2010 21:49:52 -0000
@@ -155,12 +155,18 @@
 (defimplementation remove-fd-handlers (socket)
   (sb-sys:invalidate-descriptor (socket-fd socket)))
 
-(defun socket-fd (socket)
+(defimplementation socket-fd (socket)
   (etypecase socket
     (fixnum socket)
     (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
     (file-stream (sb-sys:fd-stream-fd socket))))
 
+(defimplementation command-line-args ()
+  sb-ext:*posix-argv*)
+
+(defimplementation dup (fd)
+  (sb-posix:dup fd))
+
 (defvar *wait-for-input-called*)
 
 (defimplementation wait-for-input (streams &optional timeout)
@@ -1550,7 +1556,7 @@
 #-win32
 (defimplementation save-image (filename &optional restart-function)
   (let ((pid (sb-posix:fork)))
-    (cond ((= pid 0) 
+    (cond ((= pid 0)
            (apply #'sb-ext:save-lisp-and-die filename
                   (when restart-function
                     (list :toplevel restart-function))))
@@ -1559,3 +1565,37 @@
              (assert (= pid rpid))
              (assert (and (sb-posix:wifexited status)
                           (zerop (sb-posix:wexitstatus status)))))))))
+
+#+unix
+(progn
+  (sb-alien:define-alien-routine ("execv" sys-execv) sb-alien:int 
+    (program sb-alien:c-string)
+    (argv (* sb-alien:c-string)))
+  
+  (defun execv (program args)
+    "Replace current executable with another one."
+    (let ((a-args (sb-alien:make-alien sb-alien:c-string
+                                       (+ 1 (length args)))))
+      (unwind-protect
+           (progn
+             (loop for index from 0 by 1
+                   and item in (append args '(nil))
+                   do (setf (sb-alien:deref a-args index)
+                            item))
+             (when (minusp
+                    (sys-execv program a-args))
+               (sb-posix:syscall-error)))
+        (sb-alien:free-alien a-args))))
+
+  (defimplementation exec-image (image-file args)
+    (let* ((self-string (pathname-to-filename sb-ext:*runtime-pathname*)))
+      (execv
+       self-string
+       (apply 'list self-string "--core" image-file args)))))
+
+(defimplementation make-fd-stream (fd external-format)
+  (sb-sys:make-fd-stream fd :input t :output t
+                         :element-type 'character
+                         :buffering :full
+                         :dual-channel-p t                         
+                         :external-format external-format))
Index: contrib/swank-snapshot.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/contrib/swank-snapshot.lisp,v
retrieving revision 1.2
diff -u -r1.2 swank-snapshot.lisp
--- contrib/swank-snapshot.lisp	13 Aug 2010 07:25:15 -0000	1.2
+++ contrib/swank-snapshot.lisp	19 Aug 2010 21:49:52 -0000
@@ -21,11 +21,15 @@
 		     "--swank-style" (format nil "~s" style)
 		     "--swank-coding" (format nil "~s" coding))))
     (swank::close-connection conn nil nil)
+    #+sbcl
+    (ignore-errors (sb-posix:fcntl 3 sb-posix:f-setfd 1))
     (swank-backend:exec-image image-file args)))
 
 (in-package :swank)
 
 (defun swank-snapshot::resurrect (old-connection)
+  #+sbcl
+  (setf sb-impl::*descriptor-handlers* nil)
   (setq *log-output* nil)
   (init-log-output)
   (clear-event-history)
@@ -37,6 +41,8 @@
 	 (* (format *error-output* "fd=~s style=~s cs=~s~%" fd style coding))
 	 (stream (make-fd-stream fd (find-external-format-or-lose coding)))
 	 (connection (make-connection nil stream style  coding)))
+    (let ((*emacs-connection* connection))
+      (create-repl nil))
     (serve-requests connection)
     (simple-repl)))