[slime-cvs] CVS update: slime/swank-cmucl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14690

Modified Files:
	swank-cmucl.lisp 
Log Message:
(read-into-simple-string): Workaround for bug in read-sequence.
Date: Wed Feb 18 14:31:49 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.66 slime/swank-cmucl.lisp:1.67
--- slime/swank-cmucl.lisp:1.66	Tue Feb 17 16:51:24 2004
+++ slime/swank-cmucl.lisp	Wed Feb 18 14:31:49 2004
@@ -4,6 +4,39 @@
 
 (in-package :swank)
 
+(in-package :lisp)
+
+;; Fix for read-sequence in 18e
+#+cmu18e
+(progn
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) nil)))
+
+  (defun read-into-simple-string (s stream start end)
+    (declare (type simple-string s))
+    (declare (type stream stream))
+    (declare (type index start end))
+    (unless (subtypep (stream-element-type stream) 'character)
+      (error 'type-error
+             :datum (read-char stream nil #\Null)
+             :expected-type (stream-element-type stream)
+             :format-control "Trying to read characters from a binary stream."))
+    ;; Let's go as low level as it seems reasonable.
+    (let* ((numbytes (- end start))
+           (bytes-read (system:read-n-bytes stream s start numbytes t)))
+      (if (< bytes-read numbytes)
+          (+ start bytes-read)
+          end)))
+
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) t)))
+
+  )
+
+(in-package :swank)
+
 
 ;;;; TCP server.