[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Tue Dec 22 09:31:15 UTC 2009
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv25008
Modified Files:
ChangeLog swank.lisp swank-backend.lisp swank-cmucl.lisp
Log Message:
Commands to save&restore image files without disconnecting.
* slime-snapshot.el: New file.
* swank-snapshot.lisp: New file.
Some new backend functions used for loading image files.
* swank-backend.lisp (socket-fd, make-fd-stream, dup, exec-image)
(command-line-args): New functions.
* swank-cmucl.lisp: Impemented.
* swank-cmucl.lisp (reset-sigio-handlers): New function.
(save-image): Fix quoting bug.
* swank.lisp (clear-event-history): New functoin.
(interactive-eval, eval-region): Don't use FRESH-LINE.
--- /project/slime/cvsroot/slime/ChangeLog 2009/12/21 13:31:55 1.1946
+++ /project/slime/cvsroot/slime/ChangeLog 2009/12/22 09:31:15 1.1947
@@ -1,3 +1,16 @@
+2009-12-22 Helmut Eller <heller at common-lisp.net>
+
+ Some new backend functions used for loading image files.
+
+ * swank-backend.lisp (socket-fd, make-fd-stream, dup, exec-image)
+ (command-line-args): New functions.
+ * swank-cmucl.lisp: Impemented.
+ * swank-cmucl.lisp (reset-sigio-handlers): New function.
+ (save-image): Fix quoting bug.
+
+ * swank.lisp (clear-event-history): New functoin.
+ (interactive-eval, eval-region): Don't use FRESH-LINE.
+
2009-12-21 Tobias C. Rittweiler <tcr at freebits.de>
* slime.el (slime-at-list-p): Deleted.
--- /project/slime/cvsroot/slime/swank.lisp 2009/12/17 10:30:32 1.680
+++ /project/slime/cvsroot/slime/swank.lisp 2009/12/22 09:31:15 1.681
@@ -585,6 +585,10 @@
(idx *event-history-index*))
(concatenate 'list (subseq arr idx) (subseq arr 0 idx))))
+(defun clear-event-history ()
+ (fill *event-history* nil)
+ (setq *event-history-index* 0))
+
(defun dump-event-history (stream)
(dolist (e (event-history-to-list))
(dump-event e stream)))
@@ -766,8 +770,8 @@
(coding-system *coding-system*))
"Start the server and write the listen port number to PORT-FILE.
This is the entry point for Emacs."
- (setup-server 0 (lambda (port)
- (announce-server-port port-file port))
+ (setup-server 0
+ (lambda (port) (announce-server-port port-file port))
style dont-close
(find-external-format-or-lose coding-system)))
@@ -1367,17 +1371,16 @@
(defun simple-repl ()
(loop
(with-simple-restart (abort "Abort")
- (format t "~&~a> " (package-string-for-prompt *package*))
+ (format t "~a> " (package-string-for-prompt *package*))
(force-output)
(let ((form (read)))
- (fresh-line)
(let ((- form)
(values (multiple-value-list (eval form))))
(setq *** ** ** * * (car values)
/// // // / / values
+++ ++ ++ + + form)
- (cond ((null values) (format t "~&; No values"))
- (t (mapc (lambda (v) (format t "~&~s" v)) values))))))))
+ (cond ((null values) (format t "; No values~&"))
+ (t (mapc (lambda (v) (format t "~s~&" v)) values))))))))
(defun make-repl-input-stream (connection stdin)
(make-input-stream
@@ -2195,7 +2198,6 @@
(with-buffer-syntax ()
(with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
(let ((values (multiple-value-list (eval (from-string string)))))
- (fresh-line)
(finish-output)
(format-values-for-echo-area values)))))
@@ -2217,7 +2219,6 @@
(loop
(let ((form (read stream nil stream)))
(when (eq form stream)
- (fresh-line)
(finish-output)
(return (values values -)))
(setq - form)
--- /project/slime/cvsroot/slime/swank-backend.lisp 2009/12/19 14:56:06 1.187
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/12/22 09:31:15 1.188
@@ -335,6 +335,28 @@
"Return a short name for the Lisp implementation."
(lisp-implementation-type))
+(definterface socket-fd (socket-stream)
+ "Return the file descriptor for SOCKET-STREAM.")
+
+(definterface make-fd-stream (fd external-format)
+ "Create a character stream for the file descriptor FD.")
+
+(definterface dup (fd)
+ "Duplicate a file descriptor.
+If the syscall fails, signal a condition.
+See dup(2).")
+
+(definterface exec-image (image-file args)
+ "Replace the current process with a new process image.
+The new image is created by loading the previously dumped
+core file IMAGE-FILE.
+ARGS is a list of strings passed as arguments to
+the new image.
+This is thin wrapper around exec(3).")
+
+(definterface command-line-args ()
+ "Return a list of strings as passed by the OS.")
+
;; pathnames are sooo useless
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/11/03 18:22:58 1.215
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/12/22 09:31:15 1.216
@@ -107,7 +107,7 @@
;;;;; Sockets
-(defun socket-fd (socket)
+(defimplementation socket-fd (socket)
"Return the filedescriptor for the socket represented by SOCKET."
(etypecase socket
(fixnum socket)
@@ -137,6 +137,27 @@
#+unicode :external-format
#+unicode external-format))
+(defimplementation make-fd-stream (fd external-format)
+ (make-socket-io-stream fd :full external-format))
+
+(defimplementation dup (fd)
+ (multiple-value-bind (clone error) (unix:unix-dup fd)
+ (unless clone (error "dup failed: ~a" (unix:get-unix-error-msg error)))
+ clone))
+
+(defimplementation command-line-args ()
+ ext:*command-line-strings*)
+
+(defimplementation exec-image (image-file args)
+ (multiple-value-bind (ok error)
+ (unix:unix-execve (car (command-line-args))
+ (list* (car (command-line-args))
+ "-core" image-file
+ "-noinit"
+ args))
+ (error "~a" (unix:get-unix-error-msg error))
+ ok))
+
;;;;; Signal-driven I/O
(defimplementation install-sigint-handler (function)
@@ -149,6 +170,10 @@
All functions are called on SIGIO, and the key is used for removing
specific functions.")
+(defun reset-sigio-handlers () (setq *sigio-handlers* '()))
+;; All file handlers are invalid afer reload.
+(pushnew 'reset-sigio-handlers ext:*after-save-initializations*)
+
(defun set-sigio-handler ()
(sys:enable-interrupt :sigio (lambda (signal code scp)
(sigio-handler signal code scp))))
@@ -2366,10 +2391,10 @@
(multiple-value-bind (pid error) (unix:unix-fork)
(when (not pid) (error "fork: ~A" (unix:get-unix-error-msg error)))
(cond ((= pid 0)
- (let ((args `(,filename
- ,@(if restart-function
- `((:init-function ,restart-function))))))
- (apply #'ext:save-lisp args)))
+ (apply #'ext:save-lisp
+ filename
+ (if restart-function
+ `(:init-function ,restart-function))))
(t
(let ((status (waitpid pid)))
(destructuring-bind (&key exited? status &allow-other-keys) status
More information about the slime-cvs
mailing list