Teemu Kalvas:
He worked on Unicode support for SBCL, including parsing the Unicode
- character database.
+ character database and restoring the FAST-READ-CHAR optimization.
Frederik Kuivinen:
He showed how to implement the DEBUG-RETURN functionality.
(deftype ansi-stream-in-buffer ()
`(simple-array (unsigned-byte 8) (,+ansi-stream-in-buffer-length+)))
+(deftype ansi-stream-cin-buffer ()
+ `(simple-array character (,+ansi-stream-in-buffer-length+)))
+
;;; base class for ANSI standard streams (as opposed to the Gray
;;; streams extension)
(defstruct (ansi-stream (:constructor nil)
;; slot must must be NIL, and the IN-INDEX must be
;; +ANSI-STREAM-IN-BUFFER-LENGTH+.)
(in-buffer nil :type (or ansi-stream-in-buffer null))
+ (cin-buffer nil :type (or ansi-stream-cin-buffer null))
(in-index +ansi-stream-in-buffer-length+ :type index)
;; buffered input functions
(defun refill-fd-stream-buffer (stream)
;; We don't have any logic to preserve leftover bytes in the buffer,
;; so we should only be called when the buffer is empty.
- (aver (= (fd-stream-ibuf-head stream) (fd-stream-ibuf-tail stream)))
- (multiple-value-bind (count err)
- (sb!unix:unix-read (fd-stream-fd stream)
- (fd-stream-ibuf-sap stream)
- (fd-stream-ibuf-length stream))
- (declare (type (or index null) count))
- (when (null count)
- (simple-stream-perror "couldn't read from ~S" stream err))
- (setf (fd-stream-listen stream) nil
- (fd-stream-ibuf-head stream) 0
- (fd-stream-ibuf-tail stream) count)
- count))
+ ;; FIXME: can have three bytes in buffer because of UTF-8
+ (let ((new-head 0)
+ (sap (fd-stream-ibuf-sap stream)))
+ (do ((head (fd-stream-ibuf-head stream) (1+ head))
+ (tail (fd-stream-ibuf-tail stream)))
+ ((= head tail))
+ (setf (sap-ref-8 sap new-head) (sap-ref-8 sap head))
+ (incf new-head))
+ (multiple-value-bind (count err)
+ (sb!unix:unix-read (fd-stream-fd stream)
+ (sap+ sap new-head)
+ (- (fd-stream-ibuf-length stream) new-head))
+ (declare (type (or index null) count))
+ (when (null count)
+ (simple-stream-perror "couldn't read from ~S" stream err))
+ (setf (fd-stream-listen stream) nil
+ (fd-stream-ibuf-head stream) new-head
+ (fd-stream-ibuf-tail stream) (+ count new-head))
+ count)))
\f
;;;; utility functions (misc routines, etc)
(input-type nil)
(output-type nil)
(input-size nil)
- (output-size nil))
+ (output-size nil)
+ (character-stream-p (subtypep type 'character)))
(when (fd-stream-obuf-sap fd-stream)
(push (fd-stream-obuf-sap fd-stream) *available-buffers*)
(setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
(setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
(setf (fd-stream-ibuf-tail fd-stream) 0)
- (if (subtypep type 'character)
+ (if character-stream-p
(setf (fd-stream-in fd-stream) routine
(fd-stream-bin fd-stream) #'ill-bin)
(setf (fd-stream-in fd-stream) #'ill-in
;; (unsigned-byte 8). Because there's no buffer, the
;; other element-types will dispatch to the appropriate
;; input (output) routine in fast-read-byte.
- (equal target-type '(unsigned-byte 8))
- #+nil
+ (or character-stream-p
+ (equal target-type '(unsigned-byte 8)))
+ (not output-p) ; temporary disable on :io streams
+ #+(or)
(or (eq type 'unsigned-byte)
(eq type :default)))
- (setf (ansi-stream-in-buffer fd-stream)
- (make-array +ansi-stream-in-buffer-length+
- :element-type '(unsigned-byte 8)))))
+ (if character-stream-p
+ (setf (ansi-stream-cin-buffer fd-stream)
+ (make-array +ansi-stream-in-buffer-length+
+ :element-type 'character))
+ (setf (ansi-stream-in-buffer fd-stream)
+ (make-array +ansi-stream-in-buffer-length+
+ :element-type '(unsigned-byte 8))))))
(setf input-size size)
(setf input-type type)))
#!-sb-fluid (declaim (inline ansi-stream-unread-char))
(defun ansi-stream-unread-char (character stream)
(let ((index (1- (ansi-stream-in-index stream)))
- (buffer (ansi-stream-in-buffer stream)))
+ (buffer (ansi-stream-cin-buffer stream)))
(declare (fixnum index))
(when (minusp index) (error "nothing to unread"))
(cond (buffer
- (setf (aref buffer index) (char-code character))
+ (setf (aref buffer index) character)
(setf (ansi-stream-in-index stream) index))
(t
(funcall (ansi-stream-misc stream) stream
;;; the IN-BUFFER for text streams. There is definitely an IN-BUFFER,
;;; and hence must be an N-BIN method.
(defun fast-read-char-refill (stream eof-error-p eof-value)
- (let* ((ibuf (ansi-stream-in-buffer stream))
+ (let* ((ibuf (ansi-stream-cin-buffer stream))
(count (funcall (ansi-stream-n-bin stream)
stream
ibuf
sb!vm:n-word-bits))
(* count sb!vm:n-byte-bits)))
(setf (ansi-stream-in-index stream) (1+ start))
- (code-char (aref ibuf start))))))
+ (aref ibuf start)))))
;;; This is similar to FAST-READ-CHAR-REFILL, but we don't have to
;;; leave room for unreading.
(with-array-data ((data seq) (offset-start start) (offset-end end))
(typecase data
((or (simple-array (unsigned-byte 8) (*))
- (simple-array (signed-byte 8) (*))
- simple-string)
+ (simple-array (signed-byte 8) (*)))
(let* ((numbytes (- end start))
(bytes-read (read-n-bytes stream data offset-start
numbytes nil)))
(defmacro prepare-for-fast-read-char (stream &body forms)
`(let* ((%frc-stream% ,stream)
(%frc-method% (ansi-stream-in %frc-stream%))
- (%frc-buffer% (ansi-stream-in-buffer %frc-stream%))
+ (%frc-buffer% (ansi-stream-cin-buffer %frc-stream%))
(%frc-index% (ansi-stream-in-index %frc-stream%)))
(declare (type index %frc-index%)
(type ansi-stream %frc-stream%))
(prog1 (fast-read-char-refill %frc-stream% ,eof-error-p ,eof-value)
(setq %frc-index% (ansi-stream-in-index %frc-stream%))))
(t
- (prog1 (code-char (aref %frc-buffer% %frc-index%))
+ (prog1 (aref %frc-buffer% %frc-index%)
(incf %frc-index%)))))
;;;; And these for the fasloader...
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.16.12"
+"0.8.16.13"
projects / sbcl.git / commitdiff