[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Tue Nov 8 08:15:34 UTC 2011
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv27582
Modified Files:
ChangeLog slime.el swank-rpc.lisp
Log Message:
Restore old header format.
* swank-rpc.lisp (parse-header, write-header)
* slime.el (slime-net-decode-length, slime-net-encode-length)
--- /project/slime/cvsroot/slime/ChangeLog 2011/11/06 18:34:51 1.2239
+++ /project/slime/cvsroot/slime/ChangeLog 2011/11/08 08:15:34 1.2240
@@ -1,3 +1,10 @@
+2011-11-08 Helmut Eller <heller at common-lisp.net>
+
+ Restore old header format.
+
+ * swank-rpc.lisp (parse-header, write-header)
+ * slime.el (slime-net-decode-length, slime-net-encode-length)
+
2011-11-06 Helmut Eller <heller at common-lisp.net>
* swank-ecl.lisp (accept-connection): Fix buffering arg.
--- /project/slime/cvsroot/slime/slime.el 2011/11/06 17:06:49 1.1378
+++ /project/slime/cvsroot/slime/slime.el 2011/11/08 08:15:34 1.1379
@@ -1476,16 +1476,10 @@
;;; This section covers the low-level networking: establishing
;;; connections and encoding/decoding protocol messages.
;;;
-;;; Each SLIME protocol message beings with a 4-byte header followed
+;;; Each SLIME protocol message beings with a 6-byte header followed
;;; by an S-expression as text. The sexp must be readable both by
;;; Emacs and by Common Lisp, so if it contains any embedded code
;;; fragments they should be sent as strings:
-;;;
-;;; | byte0 | 3 bytes length |
-;;; | ... s-exp ... |
-;;;
-;;; The s-exp text is encoded in UTF8. byte0 is currently always 0;
-;;; other values are reserved for future use.
;;;
;;; The set of meaningful protocol messages are not specified
;;; here. They are defined elsewhere by the event-dispatching
@@ -1570,8 +1564,7 @@
(let* ((payload (encode-coding-string
(concat (slime-prin1-to-string sexp) "\n")
'utf-8-unix))
- (string (concat (slime-unibyte-string 0)
- (slime-net-encode-length (length payload))
+ (string (concat (slime-net-encode-length (length payload))
payload)))
(slime-log-event sexp)
(process-send-string proc string)))
@@ -1632,8 +1625,8 @@
(defun slime-net-have-input-p ()
"Return true if a complete message is available."
(goto-char (point-min))
- (and (>= (buffer-size) 4)
- (>= (- (buffer-size) 4) (slime-net-decode-length))))
+ (and (>= (buffer-size) 6)
+ (>= (- (buffer-size) 6) (slime-net-decode-length))))
(defun slime-run-when-idle (function &rest args)
"Call FUNCTION as soon as Emacs is idle."
@@ -1664,7 +1657,7 @@
"Read a message from the network buffer."
(goto-char (point-min))
(let* ((length (slime-net-decode-length))
- (start (+ (point) 4))
+ (start (+ (point) 6))
(end (+ start length)))
(assert (plusp length))
(prog1 (save-restriction
@@ -1679,18 +1672,11 @@
(delete-region (point-min) end))))
(defun slime-net-decode-length ()
- "Read a 24-bit little endian integer from buffer."
- ;; extra masking for "raw bytes" in multibyte text above #x3FFF00
- (logior (lsh (logand (char-after (+ (point) 1)) #xff) 16)
- (lsh (logand (char-after (+ (point) 2)) #xff) 8)
- (lsh (logand (char-after (+ (point) 3)) #xff) 0)))
+ (string-to-number (buffer-substring-no-properties (point) (+ (point) 6))
+ 16))
(defun slime-net-encode-length (n)
- (assert (<= 0 n))
- (assert (<= n #xffffff))
- (slime-unibyte-string (logand (lsh n -16) #xff)
- (logand (lsh n -8) #xff)
- (logand (lsh n 0) #xff)))
+ (format "%06x" n))
(defun slime-prin1-to-string (sexp)
"Like `prin1-to-string' but don't octal-escape non-ascii characters.
--- /project/slime/cvsroot/slime/swank-rpc.lisp 2011/11/06 17:06:09 1.8
+++ /project/slime/cvsroot/slime/swank-rpc.lisp 2011/11/08 08:15:34 1.9
@@ -36,16 +36,13 @@
:packet packet :cause c))))))
(defun read-packet (stream)
- (multiple-value-bind (byte0 length) (parse-header stream)
- (cond ((= byte0 0)
- (let ((octets (read-chunk stream length)))
- (handler-case (swank-backend:utf8-to-string octets)
- (error (c)
- (error (make-condition 'swank-reader-error
- :packet (asciify octets)
- :cause c))))))
- (t
- (error "Invalid header byte0 #b~b" byte0)))))
+ (let* ((length (parse-header stream))
+ (octets (read-chunk stream length)))
+ (handler-case (swank-backend:utf8-to-string octets)
+ (error (c)
+ (error (make-condition 'swank-reader-error
+ :packet (asciify octets)
+ :cause c))))))
(defun asciify (packet)
(with-output-to-string (*standard-output*)
@@ -56,11 +53,9 @@
(t (format t "\\x~x" code))))))
(defun parse-header (stream)
- (values (read-byte stream)
- (logior (ash (read-byte stream) 16)
- (ash (read-byte stream) 8)
- (read-byte stream))))
-
+ (parse-integer (map 'string #'code-char (read-chunk stream 6))
+ :radix 16))
+
(defun read-chunk (stream length)
(let* ((buffer (make-array length :element-type '(unsigned-byte 8)))
(count (read-sequence buffer stream)))
@@ -115,7 +110,7 @@
(octets (handler-case (swank-backend:string-to-utf8 string)
(error (c) (encoding-error c string))))
(length (length octets)))
- (write-header stream 0 length)
+ (write-header stream length)
(write-sequence octets stream)
(finish-output stream)))
@@ -130,14 +125,11 @@
(asciify (princ-to-string (type-of condition))))))
(find-package :cl))))
-(defun write-header (stream byte0 length)
- (declare (type (unsigned-byte 8) byte0)
- (type (unsigned-byte 24) length))
- ;;(format *trace-output* "byte0: ~d length: ~d (#x~x)~%" byte0 length length)
- (write-byte byte0 stream)
- (write-byte (ldb (byte 8 16) length) stream)
- (write-byte (ldb (byte 8 8) length) stream)
- (write-byte (ldb (byte 8 0) length) stream))
+(defun write-header (stream length)
+ (declare (type (unsigned-byte 24) length))
+ ;;(format *trace-output* "length: ~d (#x~x)~%" length length)
+ (loop for c across (format nil "~6,'0x" length)
+ do (write-byte (char-code c) stream)))
(defun prin1-to-string-for-emacs (object package)
(with-standard-io-syntax
More information about the slime-cvs
mailing list