[slime-cvs] CVS update: slime/swank-backend.lisp slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-clisp.lisp slime/swank-lispworks.lisp slime/swank-allegro.lisp slime/swank-corman.lisp slime/swank-scl.lisp slime/swank-ecl.lisp
Helmut Eller
heller at common-lisp.net
Fri Nov 11 23:43:51 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6556
Modified Files:
swank-backend.lisp swank-cmucl.lisp swank-sbcl.lisp
swank-openmcl.lisp swank-clisp.lisp swank-lispworks.lisp
swank-allegro.lisp swank-corman.lisp swank-scl.lisp
swank-ecl.lisp
Log Message:
(accept-connection): New argument: buffering.
Date: Sat Nov 12 00:43:46 2005
Author: heller
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.92 slime/swank-backend.lisp:1.93
--- slime/swank-backend.lisp:1.92 Sun Oct 23 10:47:54 2005
+++ slime/swank-backend.lisp Sat Nov 12 00:43:43 2005
@@ -211,9 +211,10 @@
(definterface close-socket (socket)
"Close the socket SOCKET.")
-(definterface accept-connection (socket &key external-format)
- "Accept a client connection on the listening socket SOCKET. Return
-a stream for the new connection.")
+(definterface accept-connection (socket &key external-format
+ buffering)
+ "Accept a client connection on the listening socket SOCKET.
+Return a stream for the new connection.")
(definterface add-sigio-handler (socket fn)
"Call FN whenever SOCKET is readable.")
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.156 slime/swank-cmucl.lisp:1.157
--- slime/swank-cmucl.lisp:1.156 Sun Oct 9 21:13:03 2005
+++ slime/swank-cmucl.lisp Sat Nov 12 00:43:43 2005
@@ -94,13 +94,15 @@
(nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
(defimplementation close-socket (socket)
- (sys:invalidate-descriptor socket)
- (ext:close-socket (socket-fd socket)))
+ (let ((fd (socket-fd socket)))
+ (sys:invalidate-descriptor fd)
+ (ext:close-socket fd)))
-(defimplementation accept-connection (socket &key external-format)
- (let ((ef (or external-format :iso-latin-1-unix)))
- (assert (eq ef ':iso-latin-1-unix))
- (make-socket-io-stream (ext:accept-tcp-connection socket))))
+(defimplementation accept-connection (socket &key
+ (external-format :iso-latin-1-unix)
+ (buffering :full))
+ (assert (eq external-format ':iso-latin-1-unix))
+ (make-socket-io-stream (ext:accept-tcp-connection socket) buffering))
;;;;; Sockets
@@ -115,9 +117,10 @@
(let ((hostent (ext:lookup-host-entry hostname)))
(car (ext:host-entry-addr-list hostent))))
-(defun make-socket-io-stream (fd)
+(defun make-socket-io-stream (fd buffering)
"Create a new input/output fd-stream for FD."
- (sys:make-fd-stream fd :input t :output t :element-type 'base-char))
+ (sys:make-fd-stream fd :input t :output t :element-type 'base-char
+ :buffering buffering))
;;;;; Signal-driven I/O
@@ -189,21 +192,23 @@
(print-unreadable-object (s stream :type t :identity t)))
(defun sos/out (stream char)
- (let ((buffer (sos.buffer stream))
- (index (sos.index stream)))
- (setf (schar buffer index) char)
- (setf (sos.index stream) (1+ index))
- (incf (sos.column stream))
- (when (char= #\newline char)
- (setf (sos.column stream) 0)
- (force-output stream))
- (when (= index (1- (length buffer)))
- (finish-output stream)))
- char)
+ (system:without-interrupts
+ (let ((buffer (sos.buffer stream))
+ (index (sos.index stream)))
+ (setf (schar buffer index) char)
+ (setf (sos.index stream) (1+ index))
+ (incf (sos.column stream))
+ (when (char= #\newline char)
+ (setf (sos.column stream) 0)
+ (force-output stream))
+ (when (= index (1- (length buffer)))
+ (finish-output stream)))
+ char))
(defun sos/sout (stream string start end)
- (loop for i from start below end
- do (sos/out stream (aref string i))))
+ (system:without-interrupts
+ (loop for i from start below end
+ do (sos/out stream (aref string i)))))
(defun log-stream-op (stream operation)
stream operation
@@ -220,12 +225,13 @@
(case operation
(:finish-output
(log-stream-op stream operation)
- (let ((end (sos.index stream)))
- (unless (zerop end)
- (let ((s (subseq (sos.buffer stream) 0 end)))
- (setf (sos.index stream) 0)
- (funcall (sos.output-fn stream) s))
- (setf (sos.last-flush-time stream) (get-internal-real-time))))
+ (system:without-interrupts
+ (let ((end (sos.index stream)))
+ (unless (zerop end)
+ (let ((s (subseq (sos.buffer stream) 0 end)))
+ (setf (sos.index stream) 0)
+ (funcall (sos.output-fn stream) s))
+ (setf (sos.last-flush-time stream) (get-internal-real-time)))))
nil)
(:force-output
(log-stream-op stream operation)
@@ -240,16 +246,17 @@
(t (format *terminal-io* "~&~Astream: ~S~%" stream operation))))
(defun sos/misc-force-output (stream)
- (unless (or (zerop (sos.index stream))
- (loop with buffer = (sos.buffer stream)
- for i from 0 below (sos.index stream)
- always (char= (aref buffer i) #\newline)))
- (let ((last (sos.last-flush-time stream))
- (now (get-internal-real-time)))
- (when (> (/ (- now last)
- (coerce internal-time-units-per-second 'double-float))
- 0.1)
- (finish-output stream)))))
+ (system:without-interrupts
+ (unless (or (zerop (sos.index stream))
+ (loop with buffer = (sos.buffer stream)
+ for i from 0 below (sos.index stream)
+ always (char= (aref buffer i) #\newline)))
+ (let ((last (sos.last-flush-time stream))
+ (now (get-internal-real-time)))
+ (when (> (/ (- now last)
+ (coerce internal-time-units-per-second 'double-float))
+ 0.1)
+ (finish-output stream))))))
(defstruct (slime-input-stream
(:include string-stream
@@ -1864,7 +1871,7 @@
(loop for value in parts for i from 0
append (label-value-line i value))))))
-(defmethod inspect-for-emacs :around ((o function) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector))
(declare (ignore inspector))
(let ((header (kernel:get-type o)))
(cond ((= header vm:function-header-type)
@@ -1945,7 +1952,7 @@
(:displaced-p (kernel:%array-displaced-p o))
(:dimensions (array-dimensions o)))))
-(defmethod inspect-for-emacs ((o vector) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o simple-vector) (inspector cmucl-inspector))
inspector
(values (format nil "~A is a vector." o)
(append
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.149 slime/swank-sbcl.lisp:1.150
--- slime/swank-sbcl.lisp:1.149 Sun Nov 6 10:09:48 2005
+++ slime/swank-sbcl.lisp Sat Nov 12 00:43:43 2005
@@ -58,9 +58,10 @@
(sb-sys:invalidate-descriptor (socket-fd socket))
(sb-bsd-sockets:socket-close socket))
-(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
- (make-socket-io-stream (accept socket) external-format))
+(defimplementation accept-connection (socket &key
+ (external-format :iso-latin-1-unix)
+ (buffering :full))
+ (make-socket-io-stream (accept socket) external-format buffering))
(defvar *sigio-handlers* '()
"List of (key . fn) pairs to be called on SIGIO.")
@@ -115,12 +116,13 @@
(:utf-8-unix :utf-8)
(:euc-jp-unix :euc-jp)))
-(defun make-socket-io-stream (socket external-format)
+(defun make-socket-io-stream (socket external-format buffering)
(let ((ef (find-external-format external-format)))
(sb-bsd-sockets:socket-make-stream socket
:output t
:input t
:element-type 'character
+ :buffering buffering
#+sb-unicode :external-format
#+sb-unicode ef
)))
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.102 slime/swank-openmcl.lisp:1.103
--- slime/swank-openmcl.lisp:1.102 Thu Sep 22 22:20:43 2005
+++ slime/swank-openmcl.lisp Sat Nov 12 00:43:43 2005
@@ -128,7 +128,9 @@
(close socket))
(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
+ &key (external-format :iso-latin-1-unix)
+ buffering)
+ (declare (ignore buffering))
(assert (eq external-format :iso-latin-1-unix))
(ccl:accept-connection socket :wait t))
@@ -771,8 +773,6 @@
(defimplementation spawn (fn &key name)
(ccl:process-run-function (or name "Anonymous (Swank)") fn))
-
-(defimplementation startup-multiprocessing ())
(defimplementation thread-id (thread)
(ccl::process-serial-number thread))
Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.56 slime/swank-clisp.lisp:1.57
--- slime/swank-clisp.lisp:1.56 Thu Sep 15 10:17:38 2005
+++ slime/swank-clisp.lisp Sat Nov 12 00:43:43 2005
@@ -125,7 +125,9 @@
(ext:make-encoding :charset charset :line-terminator :unix)))
(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
+ &key (external-format :iso-latin-1-unix)
+ buffering)
+ (declare (ignore buffering))
(socket:socket-accept socket
:buffered nil ;; XXX should be t
:element-type 'character
@@ -234,9 +236,9 @@
(defvar *sldb-backtrace*)
(defimplementation call-with-debugging-environment (debugger-loop-fn)
- (let* ((sys::*break-count* (1+ sys::*break-count*))
- (sys::*driver* debugger-loop-fn)
- (sys::*fasoutput-stream* nil)
+ (let* (;;(sys::*break-count* (1+ sys::*break-count*))
+ ;;(sys::*driver* debugger-loop-fn)
+ ;;(sys::*fasoutput-stream* nil)
(*sldb-backtrace* (nthcdr 6 (sldb-backtrace))))
(funcall debugger-loop-fn)))
Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.80 slime/swank-lispworks.lisp:1.81
--- slime/swank-lispworks.lisp:1.80 Tue Sep 27 23:50:38 2005
+++ slime/swank-lispworks.lisp Sat Nov 12 00:43:43 2005
@@ -66,7 +66,9 @@
(comm::close-socket (socket-fd socket)))
(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
+ &key (external-format :iso-latin-1-unix)
+ buffering)
+ (declare (ignore buffering))
(assert (eq external-format :iso-latin-1-unix))
(let* ((fd (comm::get-fd-from-socket socket)))
(assert (/= fd -1))
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.79 slime/swank-allegro.lisp:1.80
--- slime/swank-allegro.lisp:1.79 Tue Oct 11 00:24:28 2005
+++ slime/swank-allegro.lisp Sat Nov 12 00:43:43 2005
@@ -41,7 +41,8 @@
(defimplementation close-socket (socket)
(close socket))
-(defimplementation accept-connection (socket &key external-format)
+(defimplementation accept-connection (socket &key external-format buffering)
+ (declare (ignore buffering))
(let ((ef (or external-format :iso-latin-1-unix))
(s (socket:accept-connection socket :wait t)))
(set-external-format s ef)
Index: slime/swank-corman.lisp
diff -u slime/swank-corman.lisp:1.4 slime/swank-corman.lisp:1.5
--- slime/swank-corman.lisp:1.4 Tue Jul 5 22:30:59 2005
+++ slime/swank-corman.lisp Sat Nov 12 00:43:43 2005
@@ -238,7 +238,9 @@
(close socket))
(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
+ &key (external-format :iso-latin-1-unix)
+ buffering)
+ (declare (ignore buffering))
(ecase external-format
(:iso-latin-1-unix
(sockets:make-socket-stream (sockets:accept-socket socket)))))
Index: slime/swank-scl.lisp
diff -u slime/swank-scl.lisp:1.1 slime/swank-scl.lisp:1.2
--- slime/swank-scl.lisp:1.1 Fri Oct 14 20:02:23 2005
+++ slime/swank-scl.lisp Sat Nov 12 00:43:43 2005
@@ -52,7 +52,8 @@
(defimplementation close-socket (socket)
(ext:close-socket (socket-fd socket)))
-(defimplementation accept-connection (socket &key external-format)
+(defimplementation accept-connection (socket &key external-format buffering)
+ (declare (ignore buffering))
(let ((external-format (or external-format :iso-latin-1-unix)))
(make-socket-io-stream (ext:accept-tcp-connection socket)
external-format)))
Index: slime/swank-ecl.lisp
diff -u slime/swank-ecl.lisp:1.3 slime/swank-ecl.lisp:1.4
--- slime/swank-ecl.lisp:1.3 Thu Sep 22 22:20:43 2005
+++ slime/swank-ecl.lisp Sat Nov 12 00:43:43 2005
@@ -45,7 +45,9 @@
(sb-bsd-sockets:socket-close socket))
(defimplementation accept-connection (socket
- &key (external-format :iso-latin-1-unix))
+ &key (external-format :iso-latin-1-unix)
+ buffering)
+ (declare (ignore buffering))
(assert (eq external-format :iso-latin-1-unix))
(make-socket-io-stream (accept socket) external-format))
More information about the slime-cvs
mailing list