mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Remove ansi-stream-csize-buffer
This commit is contained in:
Stas Boukarev
parent
b2a1d003f4
commit
00034f235f
|
|
@ -22,7 +22,7 @@
|
|||
;;;
|
||||
;;; In: Stream, Eof-Errorp, Eof-Value
|
||||
;;; Bin: Stream, Eof-Errorp, Eof-Value
|
||||
;;; N-Bin: Stream, Buffer, Size-Buffer, Start, Numbytes, Eof-Errorp
|
||||
;;; N-Bin: Stream, Buffer, Start, Numbytes, Eof-Errorp
|
||||
;;; Cout: Stream, Character
|
||||
;;; Bout: Stream, Integer
|
||||
;;; Sout: Stream, String, Start, End
|
||||
|
|
@ -93,9 +93,6 @@
|
|||
(deftype ansi-stream-cin-buffer ()
|
||||
`(simple-array character (,+ansi-stream-in-buffer-length+)))
|
||||
|
||||
(deftype ansi-stream-csize-buffer ()
|
||||
`(simple-array (unsigned-byte 8) (,+ansi-stream-in-buffer-length+)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun %stream-opcode (name)
|
||||
(ecase name
|
||||
|
|
@ -129,9 +126,7 @@
|
|||
;;
|
||||
;; (If a stream does not have an input buffer, then the IN-BUFFER
|
||||
;; slot must must be NIL, and the IN-INDEX must be
|
||||
;; +ANSI-STREAM-IN-BUFFER-LENGTH+. If a stream has a CIN-BUFFER, it
|
||||
;; must also have a CSIZE-BUFFER for the implementation of
|
||||
;; FILE-POSITION.)
|
||||
;; +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))
|
||||
;; Various char-buffer positions needed to calculate the difference
|
||||
|
|
@ -140,7 +135,7 @@
|
|||
(char-buffer-byte-position 0 :type index)
|
||||
(char-buffer-byte-position-start 0 :type index)
|
||||
(char-buffer-start 0 :type index)
|
||||
(csize-buffer nil :type (or ansi-stream-csize-buffer null))
|
||||
|
||||
(in-index +ansi-stream-in-buffer-length+
|
||||
:type (integer 0 #.+ansi-stream-in-buffer-length+))
|
||||
|
||||
|
|
@ -154,7 +149,7 @@
|
|||
;; source buffer into characters of the destination buffer.
|
||||
(n-bin #'ill-bin :type ; n-byte input function
|
||||
(sfunction (stream (or (simple-unboxed-array (*)) system-area-pointer)
|
||||
(or ansi-stream-csize-buffer null) index index
|
||||
index index
|
||||
;; EOF-ERROR-P, not used by character streams
|
||||
&optional t)
|
||||
index))
|
||||
|
|
|
|||
|
|
@ -736,8 +736,7 @@
|
|||
(setf (buffer-head ibuf) head)
|
||||
(truly-the index string-offset))))
|
||||
|
||||
(defmacro utf8-char-loop (&key size-buffer
|
||||
crlf
|
||||
(defmacro utf8-char-loop (&key crlf
|
||||
(eof t))
|
||||
`(do ()
|
||||
((or (= tail head)
|
||||
|
|
@ -752,19 +751,15 @@
|
|||
(cond ((and (<= new-head tail)
|
||||
(= (sap-ref-8 sap (1+ head)) 10))
|
||||
(incf head 2)
|
||||
,@(when size-buffer
|
||||
`((setf (aref size-buffer index) 2)))
|
||||
10)
|
||||
,@(and eof
|
||||
`((eof nil)))
|
||||
`((eof nil)))
|
||||
(t
|
||||
,@(and eof
|
||||
`((setf requested-refill t)))
|
||||
(return))))))))
|
||||
((< byte 128)
|
||||
(incf head)
|
||||
,@(when size-buffer
|
||||
`((setf (aref size-buffer index) 1)))
|
||||
byte)
|
||||
((< byte 194)
|
||||
(decode-break 1))
|
||||
|
|
@ -779,8 +774,6 @@
|
|||
(unless (<= 128 byte2 191)
|
||||
(decode-break 2))
|
||||
(dpb byte (byte 5 6) byte2))
|
||||
,@(when size-buffer
|
||||
`((setf (aref size-buffer index) 2)))
|
||||
(setf head new-head))))
|
||||
((< byte 240)
|
||||
(let ((new-head (+ head 3)))
|
||||
|
|
@ -799,8 +792,6 @@
|
|||
(decode-break 3))
|
||||
(dpb byte (byte 4 12)
|
||||
(dpb byte2 (byte 6 6) byte3)))
|
||||
,@(when size-buffer
|
||||
`((setf (aref size-buffer index) 3)))
|
||||
(setf head new-head))))
|
||||
(t
|
||||
(let ((new-head (+ head 4)))
|
||||
|
|
@ -822,8 +813,6 @@
|
|||
(dpb byte (byte 3 18)
|
||||
(dpb byte2 (byte 6 12)
|
||||
(dpb byte3 (byte 6 6) byte4))))
|
||||
,@(when size-buffer
|
||||
`((setf (aref size-buffer index) 4)))
|
||||
(setf head new-head)))))))
|
||||
(incf index))
|
||||
(setf (buffer-head ibuf) head)))
|
||||
|
|
@ -858,8 +847,7 @@
|
|||
(incf index 4))))
|
||||
(incf codepoint)))))
|
||||
|
||||
(defun fd-stream-read-n-characters/utf-8 (stream string size-buffer start end &aux (index start))
|
||||
(declare (ignore size-buffer))
|
||||
(defun fd-stream-read-n-characters/utf-8 (stream string start end &aux (index start))
|
||||
(declare (type fd-stream stream)
|
||||
(type index start end index)
|
||||
(type ansi-stream-cin-buffer string))
|
||||
|
|
@ -899,8 +887,7 @@
|
|||
(null (catch 'eof-input-catcher (refill-input-buffer stream))))
|
||||
(return index))))))
|
||||
|
||||
(defun fd-stream-read-n-characters/utf-8/crlf (stream string size-buffer start end &aux (index start))
|
||||
(declare (ignore size-buffer))
|
||||
(defun fd-stream-read-n-characters/utf-8/crlf (stream string start end &aux (index start))
|
||||
(declare (type fd-stream stream)
|
||||
(type index start end index)
|
||||
(type ansi-stream-cin-buffer string))
|
||||
|
|
@ -1182,7 +1169,25 @@
|
|||
:read-c-string-function read-from-c-string/utf-8/lf*
|
||||
:output-c-string-function output-to-c-string/utf-8/lf
|
||||
:handle-size nil
|
||||
:count-chars #'count-utf8-byte-to-chars)
|
||||
:count-chars count-utf8-byte-to-chars)
|
||||
|
||||
(DEFUN COUNT-CHARS/UTF-8/CR (STREAM)
|
||||
(LET* ((IBUF (FD-STREAM-IBUF STREAM))
|
||||
(SAP (BUFFER-SAP IBUF))
|
||||
(TAIL (BUFFER-TAIL IBUF))
|
||||
(HEAD (ANSI-STREAM-CHAR-BUFFER-BYTE-POSITION STREAM))
|
||||
(CODEPOINT (ANSI-STREAM-CHAR-BUFFER-BYTE-POSITION-AT STREAM))
|
||||
(TARGET-CODEPOINT (ANSI-STREAM-IN-INDEX STREAM)))
|
||||
(DECLARE (INDEX HEAD CODEPOINT)
|
||||
(IGNORABLE TAIL))
|
||||
(BLOCK DECODE-BREAK-REASON
|
||||
(LOOP (WHEN (>= CODEPOINT TARGET-CODEPOINT) (RETURN HEAD))
|
||||
(LET ((BYTE (SAP-REF-8 SAP HEAD)))
|
||||
(INCF HEAD (COND ((< BYTE 128) 1) ((< BYTE 194) (RETURN-FROM DECODE-BREAK-REASON 1)) ((< BYTE 224) 2) ((< BYTE 240) 3) (T 4))))
|
||||
(INCF CODEPOINT)))))
|
||||
|
||||
(DEFUN %COUNT-CHARS/UTF-8/CR (STREAM)
|
||||
(COUNT-CHARS/UTF-8/CR STREAM))
|
||||
|
||||
(define-external-format/variable-width (:utf-8) t
|
||||
#+sb-unicode (code-char #xfffd) #-sb-unicode #\?
|
||||
|
|
@ -1247,7 +1252,8 @@
|
|||
string/cr->utf8
|
||||
:char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
|
||||
:newline-variant :cr
|
||||
:handle-size nil)
|
||||
:handle-size nil
|
||||
:count-chars %COUNT-CHARS/UTF-8/CR)
|
||||
|
||||
(define-external-format/variable-width (:utf-8 :utf8) t
|
||||
#+sb-unicode (code-char #xfffd) #-sb-unicode #\?
|
||||
|
|
@ -1327,7 +1333,7 @@
|
|||
:char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
|
||||
:fd-stream-read-n-characters fd-stream-read-n-characters/utf-8/crlf
|
||||
:newline-variant :crlf
|
||||
:count-chars #'count-utf8-crlf-byte-to-chars
|
||||
:count-chars count-utf8-crlf-byte-to-chars
|
||||
:handle-size nil)
|
||||
|
||||
#+(and sb-unicode 64-bit little-endian
|
||||
|
|
|
|||
|
|
@ -56,11 +56,6 @@
|
|||
|
||||
;;; Array of decoded characters, when required.
|
||||
(define-load-time-global *available-char-buffers* ())
|
||||
;;; Array of element type (unsigned-byte 8) could serve two needs:
|
||||
;;; - storing length-in-octets of each character for maintaining char pos
|
||||
;; vs. byte pos involving non-fixed-width EFs.
|
||||
;;; - holding data for streams of element type UB8 (not done)
|
||||
(define-load-time-global *available-ub8-buffers* ())
|
||||
|
||||
(defconstant +bytes-per-buffer+ (* 32 1024)
|
||||
"Default number of bytes per buffer.")
|
||||
|
|
@ -908,14 +903,9 @@
|
|||
(write-c-string-fun (missing-arg) :type function)
|
||||
(octets-to-string-fun (missing-arg) :type function)
|
||||
(string-to-octets-fun (missing-arg) :type function)
|
||||
(count-chars nil :type (or null function)))
|
||||
(count-chars nil :type (or fixnum function)))
|
||||
(declaim (freeze-type external-format))
|
||||
|
||||
(defun ef-char-size (ef-entry)
|
||||
(if (variable-width-external-format-p ef-entry)
|
||||
(bytes-for-char-fun ef-entry)
|
||||
(funcall (bytes-for-char-fun ef-entry) #\x)))
|
||||
|
||||
(defun sb-alien::string-to-c-string (string external-format)
|
||||
(declare (type simple-string string)
|
||||
(explicit-check :result))
|
||||
|
|
@ -972,7 +962,7 @@
|
|||
'character
|
||||
1
|
||||
(ef-write-n-bytes-fun entry)
|
||||
(ef-char-size entry)
|
||||
(ef-count-chars entry)
|
||||
(ef-replacement entry))))
|
||||
(dolist (entry *output-routines*)
|
||||
(when (and (subtypep type (first entry))
|
||||
|
|
@ -1340,7 +1330,7 @@
|
|||
'character
|
||||
1
|
||||
(ef-read-n-chars-fun entry)
|
||||
(ef-char-size entry)
|
||||
(ef-count-chars entry)
|
||||
(ef-replacement entry))))
|
||||
(dolist (entry *input-routines*)
|
||||
(when (and (subtypep type (first entry))
|
||||
|
|
@ -1392,10 +1382,9 @@
|
|||
;;; Note that this blocks in UNIX-READ. It is generally used where
|
||||
;;; there is a definite amount of reading to be done, so blocking
|
||||
;;; isn't too problematical.
|
||||
(defun fd-stream-read-n-bytes (stream buffer sbuffer start end eof-error-p)
|
||||
(defun fd-stream-read-n-bytes (stream buffer start end eof-error-p)
|
||||
(declare (type fd-stream stream))
|
||||
(declare (type index start end))
|
||||
(declare (ignore sbuffer))
|
||||
(aver (= (length (fd-stream-instead stream)) 0))
|
||||
(let* ((ibuf (fd-stream-ibuf stream))
|
||||
(sap (buffer-sap ibuf))
|
||||
|
|
@ -1569,7 +1558,7 @@
|
|||
(char-encodable-p t)
|
||||
(read-c-string-function nil custom-read-c-string-function-p)
|
||||
(output-c-string-function nil custom-output-c-string-function)
|
||||
count-chars)
|
||||
(count-chars nil count-chars-p))
|
||||
(let* ((name (first external-format))
|
||||
(suffix (symbolicate name '/ newline-variant))
|
||||
(out-function (or write-n-bytes-fun
|
||||
|
|
@ -1584,6 +1573,8 @@
|
|||
(symbolicate "READ-FROM-C-STRING/" suffix)))
|
||||
(output-c-string-function (or output-c-string-function
|
||||
(symbolicate "OUTPUT-TO-C-STRING/" suffix)))
|
||||
(count-chars-function (or count-chars
|
||||
(symbolicate "COUNT-CHARS/" suffix)))
|
||||
(n-buffer (gensym "BUFFER")))
|
||||
`(progn
|
||||
(defun ,size-function (|ch|)
|
||||
|
|
@ -1661,11 +1652,10 @@
|
|||
(sap (buffer-sap obuf)))
|
||||
,out-expr))
|
||||
,@(unless fd-stream-read-n-characters
|
||||
`((defun ,in-function (stream buffer sbuffer start end &aux (index start))
|
||||
`((defun ,in-function (stream buffer start end &aux (index start))
|
||||
(declare (type fd-stream stream)
|
||||
(type index index start end)
|
||||
(type ansi-stream-cin-buffer buffer)
|
||||
(type ansi-stream-csize-buffer sbuffer)
|
||||
(optimize (sb-c:verify-arg-count 0)))
|
||||
(when (fd-stream-eof-forced-p stream)
|
||||
(setf (fd-stream-eof-forced-p stream) nil)
|
||||
|
|
@ -1674,7 +1664,6 @@
|
|||
((= (fill-pointer instead) 0)
|
||||
(setf (fd-stream-listen stream) nil))
|
||||
(setf (aref buffer index) (vector-pop instead))
|
||||
(setf (aref sbuffer index) 0)
|
||||
(incf index)
|
||||
(when (= index end)
|
||||
(when (= (fill-pointer instead) 0)
|
||||
|
|
@ -1715,6 +1704,12 @@
|
|||
size-info))
|
||||
in-size-expr)))
|
||||
(declare (type index head tail))
|
||||
,(if (integerp in-size-expr)
|
||||
`(setf (ansi-stream-char-buffer-byte-position-start stream) head
|
||||
(ansi-stream-char-buffer-start stream) index)
|
||||
`(setf (ansi-stream-char-buffer-byte-position-start stream) head
|
||||
(ansi-stream-char-buffer-byte-position stream) head
|
||||
(ansi-stream-char-buffer-start stream) index))
|
||||
;; Copy data from stream buffer into user's buffer.
|
||||
(do ((size nil nil))
|
||||
((or (= tail head)
|
||||
|
|
@ -1736,7 +1731,6 @@
|
|||
(when (> size (- tail head))
|
||||
(return))
|
||||
(setf (aref buffer index) ,in-expr)
|
||||
(setf (aref sbuffer index) size)
|
||||
(incf index)
|
||||
(incf head size))
|
||||
nil))
|
||||
|
|
@ -1908,6 +1902,31 @@
|
|||
,out-expr)))
|
||||
,n-buffer))))))))
|
||||
|
||||
,@(unless (or count-chars-p
|
||||
(integerp in-size-expr))
|
||||
`((defun ,count-chars-function (stream)
|
||||
(let* ((ibuf (fd-stream-ibuf stream))
|
||||
(sap (buffer-sap ibuf))
|
||||
(tail (buffer-tail ibuf))
|
||||
(head (ansi-stream-char-buffer-byte-position stream))
|
||||
(codepoint (ansi-stream-char-buffer-byte-position-at stream))
|
||||
(target-codepoint (ansi-stream-in-index stream)))
|
||||
(declare (index head codepoint)
|
||||
(ignorable tail))
|
||||
(block decode-break-reason ;; shouldn't be reachable
|
||||
(loop
|
||||
(when (>= codepoint target-codepoint)
|
||||
(return head))
|
||||
(let (,@(if (member 1 (ensure-list
|
||||
(if (consp in-size-expr)
|
||||
(car in-size-expr)
|
||||
in-size-expr)))
|
||||
`((byte (sap-ref-8 sap head)))))
|
||||
(incf head
|
||||
,(if (consp in-size-expr)
|
||||
(cadr in-size-expr)
|
||||
in-size-expr)))
|
||||
(incf codepoint)))))))
|
||||
(register-external-format
|
||||
',external-format
|
||||
:newline-variant ,newline-variant
|
||||
|
|
@ -1929,7 +1948,9 @@
|
|||
:string-to-octets-fun (lambda (&rest rest)
|
||||
(declare (dynamic-extent rest))
|
||||
(apply ',string-to-octets-sym rest))
|
||||
:count-chars ,count-chars))))
|
||||
:count-chars ,(if (integerp in-size-expr)
|
||||
in-size-expr
|
||||
`#',count-chars-function)))))
|
||||
|
||||
;;;; utility functions (misc routines, etc)
|
||||
|
||||
|
|
@ -2040,14 +2061,7 @@
|
|||
(setf (ansi-stream-cin-buffer fd-stream)
|
||||
(or (atomic-pop *available-char-buffers*)
|
||||
(make-array +ansi-stream-in-buffer-length+
|
||||
:element-type 'character)))
|
||||
(if (ef-count-chars external-format-entry)
|
||||
(setf (fd-stream-char-size fd-stream)
|
||||
(ef-count-chars external-format-entry))
|
||||
(setf (ansi-stream-csize-buffer fd-stream)
|
||||
(or (atomic-pop *available-ub8-buffers*)
|
||||
(make-array +ansi-stream-in-buffer-length+
|
||||
:element-type '(unsigned-byte 8)))))))
|
||||
:element-type 'character)))))
|
||||
((equal target-type '(unsigned-byte 8))
|
||||
(setf (ansi-stream-in-buffer fd-stream)
|
||||
(make-array +ansi-stream-in-buffer-length+
|
||||
|
|
@ -2123,10 +2137,6 @@
|
|||
;;; it as closed.
|
||||
(defun release-fd-stream-resources (fd-stream)
|
||||
(declare (sb-c::tlab :system)) ; so ATOMIC-PUSH goes to the heap
|
||||
(let ((buffer (ansi-stream-csize-buffer fd-stream)))
|
||||
(when buffer
|
||||
(setf (ansi-stream-csize-buffer fd-stream) nil)
|
||||
(atomic-push buffer *available-ub8-buffers*)))
|
||||
(let ((buffer (ansi-stream-cin-buffer fd-stream)))
|
||||
(when buffer
|
||||
(setf (ansi-stream-cin-buffer fd-stream) nil)
|
||||
|
|
|
|||
|
|
@ -311,7 +311,7 @@ used to specify the oldest generation guaranteed to be collected."
|
|||
(scrub-power-cache)
|
||||
(setf sb-unicode::*name->char-buffers* nil)
|
||||
(setf sb-c::*phash-lambda-cache* nil)
|
||||
(setf sb-impl::*available-ub8-buffers* nil sb-impl::*available-char-buffers* nil)
|
||||
(setf sb-impl::*available-char-buffers* nil)
|
||||
(setf sb-impl::*read-line-buffers* nil)
|
||||
;; Clear caches depending on the generation being collected.
|
||||
(cond ((eql 0 gen)
|
||||
|
|
|
|||
|
|
@ -195,15 +195,14 @@
|
|||
(setf (ansi-stream-misc stream) #'closed-flame-saved))
|
||||
|
||||
;;;; for file position and file length
|
||||
(declaim (inline external-format-char-size))
|
||||
(defun external-format-char-size (external-format)
|
||||
(ef-char-size (get-external-format external-format)))
|
||||
(ef-count-chars (get-external-format external-format)))
|
||||
|
||||
;;; Call the MISC method with the :GET-FILE-POSITION operation.
|
||||
(declaim (inline !ansi-stream-ftell)) ; named for the stdio inquiry function
|
||||
(defun !ansi-stream-ftell (stream)
|
||||
(declare (type stream stream))
|
||||
;; FIXME: It would be good to comment on the stuff that is done here...
|
||||
;; FIXME: This doesn't look interrupt safe.
|
||||
(let ((res (truly-the (or null index) (call-ansi-stream-misc stream :get-file-position)))
|
||||
(delta (- +ansi-stream-in-buffer-length+
|
||||
(ansi-stream-in-index stream))))
|
||||
|
|
@ -213,36 +212,38 @@
|
|||
(let ((char-size (if (fd-stream-p stream)
|
||||
(fd-stream-char-size stream)
|
||||
(external-format-char-size (stream-external-format stream)))))
|
||||
(etypecase char-size
|
||||
(fixnum
|
||||
(- res (* (truly-the (unsigned-byte 8) char-size) delta)))
|
||||
(function
|
||||
(let ((size-buffer (ansi-stream-csize-buffer stream)))
|
||||
(if size-buffer
|
||||
(- res
|
||||
(loop with start = (ansi-stream-in-index stream)
|
||||
for i from start below +ansi-stream-in-buffer-length+
|
||||
sum (aref size-buffer i) of-type fixnum))
|
||||
(+
|
||||
(- res
|
||||
(buffer-head (fd-stream-ibuf stream)))
|
||||
(let ((codepoint (ansi-stream-char-buffer-byte-position-at stream))
|
||||
(target-codepoint (ansi-stream-in-index stream)))
|
||||
(cond ((<= (ansi-stream-in-index stream)
|
||||
(ansi-stream-char-buffer-start stream))
|
||||
;; reading from "instead"
|
||||
(ansi-stream-char-buffer-byte-position-start stream))
|
||||
(t
|
||||
(when (< target-codepoint codepoint) ;; unread-char happened
|
||||
;; start from scratch
|
||||
(setf (ansi-stream-char-buffer-byte-position stream)
|
||||
(ansi-stream-char-buffer-byte-position-start stream)
|
||||
(ansi-stream-char-buffer-byte-position-at stream)
|
||||
(ansi-stream-char-buffer-start stream)))
|
||||
(let ((byte (funcall char-size stream)))
|
||||
(setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-in-index stream)
|
||||
(ansi-stream-char-buffer-byte-position stream) byte)
|
||||
byte))))))))))))))
|
||||
;; For variable width encodings, count how many
|
||||
;; bytes between the previous position and the
|
||||
;; current position in the current character
|
||||
;; buffer
|
||||
(+
|
||||
(- res
|
||||
(buffer-head (fd-stream-ibuf stream)))
|
||||
|
||||
(cond ((<= (ansi-stream-in-index stream)
|
||||
(ansi-stream-char-buffer-start stream))
|
||||
;; reading from "instead"
|
||||
(ansi-stream-char-buffer-byte-position-start stream))
|
||||
(t
|
||||
(etypecase char-size
|
||||
(fixnum
|
||||
(+ (ansi-stream-char-buffer-byte-position-start stream)
|
||||
(* (- (ansi-stream-in-index stream)
|
||||
(ansi-stream-char-buffer-start stream))
|
||||
(truly-the (unsigned-byte 8) char-size))))
|
||||
(function
|
||||
(let ((codepoint (ansi-stream-char-buffer-byte-position-at stream))
|
||||
(target-codepoint (ansi-stream-in-index stream)))
|
||||
(when (< target-codepoint codepoint) ;; unread-char happened
|
||||
;; start from scratch
|
||||
(setf (ansi-stream-char-buffer-byte-position stream)
|
||||
(ansi-stream-char-buffer-byte-position-start stream)
|
||||
(ansi-stream-char-buffer-byte-position-at stream)
|
||||
(ansi-stream-char-buffer-start stream)))
|
||||
(let ((byte (funcall char-size stream)))
|
||||
(setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-in-index stream)
|
||||
(ansi-stream-char-buffer-byte-position stream) byte)
|
||||
byte))))))))))))
|
||||
|
||||
;;; You're not allowed to specify NIL for the position but we were permitting
|
||||
;;; it, which made it impossible to test for a bad call that tries to assign
|
||||
|
|
@ -612,9 +613,9 @@
|
|||
(%byte-blt in-buffer index buffer start num-buffered)
|
||||
(setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+)
|
||||
(funcall (ansi-stream-n-bin stream)
|
||||
stream buffer nil
|
||||
stream buffer
|
||||
(+ start num-buffered) end eof-error-p))))
|
||||
(funcall (ansi-stream-n-bin stream) stream buffer nil start end eof-error-p))))
|
||||
(funcall (ansi-stream-n-bin stream) stream buffer start end eof-error-p))))
|
||||
|
||||
;;; This function is called by the FAST-READ-CHAR expansion to refill
|
||||
;;; the IN-BUFFER for text streams. There is definitely an IN-BUFFER,
|
||||
|
|
@ -626,11 +627,9 @@
|
|||
(when (ansi-stream-input-char-pos stream)
|
||||
(update-input-char-pos stream))
|
||||
(let* ((ibuf (ansi-stream-cin-buffer stream))
|
||||
(sizebuf (ansi-stream-csize-buffer stream))
|
||||
(count (- (funcall (ansi-stream-n-bin stream)
|
||||
stream
|
||||
ibuf
|
||||
sizebuf
|
||||
+ansi-stream-in-buffer-extra+
|
||||
+ansi-stream-in-buffer-length+)
|
||||
+ansi-stream-in-buffer-extra+))
|
||||
|
|
@ -670,14 +669,12 @@
|
|||
;; we resynced or were given something instead
|
||||
(t
|
||||
(setf (aref ibuf index) value)
|
||||
(if sizebuf
|
||||
(setf (aref sizebuf index) size)
|
||||
(setf (ansi-stream-char-buffer-byte-position-at stream) index
|
||||
(ansi-stream-char-buffer-start stream) (if (zerop size) ;; a replacement used
|
||||
+ansi-stream-in-buffer-length+
|
||||
index)
|
||||
(ansi-stream-char-buffer-byte-position-start stream)
|
||||
(setf (ansi-stream-char-buffer-byte-position stream) (- (buffer-head (fd-stream-ibuf stream)) size))))
|
||||
(setf (ansi-stream-char-buffer-byte-position-at stream) index
|
||||
(ansi-stream-char-buffer-start stream) (if (zerop size) ;; a replacement used
|
||||
+ansi-stream-in-buffer-length+
|
||||
index)
|
||||
(ansi-stream-char-buffer-byte-position-start stream)
|
||||
(setf (ansi-stream-char-buffer-byte-position stream) (- (buffer-head (fd-stream-ibuf stream)) size)))
|
||||
(when (ansi-stream-input-char-pos stream)
|
||||
(decf (ansi-stream-input-char-pos stream) index)
|
||||
(setf (form-tracking-stream-last-newline stream) index))
|
||||
|
|
@ -697,10 +694,7 @@
|
|||
ibuf +ansi-stream-in-buffer-extra+
|
||||
ibuf start
|
||||
count)
|
||||
(if sizebuf
|
||||
(replace sizebuf sizebuf :start1 start :end1 (+ start count)
|
||||
:start2 +ansi-stream-in-buffer-extra+)
|
||||
(incf (ansi-stream-char-buffer-start stream) (- start +ansi-stream-in-buffer-extra+))))
|
||||
(incf (ansi-stream-char-buffer-start stream) (- start +ansi-stream-in-buffer-extra+)))
|
||||
|
||||
(when (ansi-stream-input-char-pos stream)
|
||||
(decf (ansi-stream-input-char-pos stream) start)
|
||||
|
|
@ -713,7 +707,7 @@
|
|||
(defun fast-read-byte-refill (stream eof-error-p eof-value)
|
||||
(let* ((ibuf (ansi-stream-in-buffer stream))
|
||||
(count (funcall (ansi-stream-n-bin stream) stream
|
||||
ibuf nil 0 +ansi-stream-in-buffer-length+
|
||||
ibuf 0 +ansi-stream-in-buffer-length+
|
||||
nil))
|
||||
(start (- +ansi-stream-in-buffer-length+ count)))
|
||||
(declare (type index start count))
|
||||
|
|
@ -1032,12 +1026,11 @@
|
|||
(macrolet ((in-fun (name fun &rest args)
|
||||
`(defun ,name (stream ,@args)
|
||||
(declare (optimize (safety 1) (sb-c:verify-arg-count 0)))
|
||||
,@(when (member 'sbuffer args) '((declare (ignore sbuffer))))
|
||||
(,fun (symbol-value (synonym-stream-symbol stream))
|
||||
,@(remove 'sbuffer args)))))
|
||||
,@args))))
|
||||
(in-fun synonym-in read-char eof-error-p eof-value)
|
||||
(in-fun synonym-bin read-byte eof-error-p eof-value)
|
||||
(in-fun synonym-n-bin read-n-bytes buffer sbuffer start end eof-error-p))
|
||||
(in-fun synonym-n-bin read-n-bytes buffer start end eof-error-p))
|
||||
|
||||
(defun synonym-misc (stream operation arg1)
|
||||
(declare (optimize (safety 1)))
|
||||
|
|
@ -1114,11 +1107,10 @@
|
|||
|
||||
(macrolet ((in-fun (name fun &rest args)
|
||||
`(defun ,name (stream ,@args)
|
||||
,@(when (member 'sbuffer args) '((declare (ignore sbuffer))))
|
||||
(,fun (two-way-stream-input-stream stream) ,@(remove 'sbuffer args)))))
|
||||
(,fun (two-way-stream-input-stream stream) ,@args))))
|
||||
(in-fun two-way-in read-char eof-error-p eof-value)
|
||||
(in-fun two-way-bin read-byte eof-error-p eof-value)
|
||||
(in-fun two-way-n-bin read-n-bytes buffer sbuffer start end eof-error-p))
|
||||
(in-fun two-way-n-bin read-n-bytes buffer start end eof-error-p))
|
||||
|
||||
(defun two-way-misc (stream operation arg1)
|
||||
(let* ((in (two-way-stream-input-stream stream))
|
||||
|
|
@ -1210,8 +1202,7 @@
|
|||
(in-fun concatenated-in read-char)
|
||||
(in-fun concatenated-bin read-byte))
|
||||
|
||||
(defun concatenated-n-bin (stream buffer sbuffer start end eof-errorp)
|
||||
(declare (ignore sbuffer))
|
||||
(defun concatenated-n-bin (stream buffer start end eof-errorp)
|
||||
(do ((streams (concatenated-stream-list stream) (cdr streams))
|
||||
(current-start start))
|
||||
((null streams)
|
||||
|
|
@ -1313,8 +1304,7 @@
|
|||
(in-fun echo-in read-char write-char eof-error-p eof-value)
|
||||
(in-fun echo-bin read-byte write-byte eof-error-p eof-value))
|
||||
|
||||
(defun echo-n-bin (stream buffer sbuffer start end eof-error-p)
|
||||
(declare (ignore sbuffer))
|
||||
(defun echo-n-bin (stream buffer start end eof-error-p)
|
||||
(let ((index start))
|
||||
;; Note: before ca 1.0.27.18, the logic for handling unread
|
||||
;; characters never could have worked, so probably nobody has ever
|
||||
|
|
@ -2748,7 +2738,6 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
|
|||
;; before we're ready (or after we think it's been deinitialized).
|
||||
;; This uses the internal %MAKUNBOUND because the CL: function would
|
||||
;; rightly complain that *AVAILABLE-BUFFERS* is proclaimed always bound.
|
||||
(%makunbound '*available-ub8-buffers*)
|
||||
(%makunbound '*available-char-buffers*)
|
||||
(%makunbound '*available-buffers*))
|
||||
|
||||
|
|
@ -2782,8 +2771,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
|
|||
;; Use the internal %BOUNDP for similar reason to that cited above-
|
||||
;; BOUNDP on a known global transforms to the constant T.
|
||||
(aver (not (%boundp '*available-buffers*)))
|
||||
(setf *available-char-buffers* nil
|
||||
*available-ub8-buffers* nil)
|
||||
(setf *available-char-buffers* nil)
|
||||
(setf *available-buffers* nil))
|
||||
(%with-output-to-string (*error-output*)
|
||||
(multiple-value-bind (in out err)
|
||||
|
|
|
|||
|
|
@ -279,7 +279,6 @@
|
|||
sb-impl::*package-names-cookie*
|
||||
sb-impl::*available-buffers*
|
||||
sb-impl::*available-char-buffers*
|
||||
sb-impl::*available-ub8-buffers*
|
||||
sb-impl::*token-buf-pool*
|
||||
sb-impl::*user-hash-table-tests*
|
||||
sb-impl::*pn-dir-table*
|
||||
|
|
|
|||
|
|
@ -790,10 +790,7 @@
|
|||
(n-bin #'mock-fd-stream-n-bin-fun)
|
||||
(cin-buffer
|
||||
(make-array sb-impl::+ansi-stream-in-buffer-length+
|
||||
:element-type 'character))
|
||||
(csize-buffer
|
||||
(make-array sb-impl::+ansi-stream-in-buffer-length+
|
||||
:element-type '(unsigned-byte 8)))))
|
||||
:element-type 'character))))
|
||||
buffer-chain)
|
||||
|
||||
(defun make-mock-fd-stream (buffer-chain)
|
||||
|
|
@ -801,14 +798,13 @@
|
|||
(%make-mock-fd-stream
|
||||
(mapcar (lambda (x) (substitute #\Newline #\| x)) buffer-chain)))
|
||||
|
||||
(defun mock-fd-stream-n-bin-fun (stream char-buf size-buf start end &optional eof-err-p)
|
||||
(defun mock-fd-stream-n-bin-fun (stream char-buf start end &optional eof-err-p)
|
||||
(cond ((mock-fd-stream-buffer-chain stream)
|
||||
(let* ((chars (pop (mock-fd-stream-buffer-chain stream)))
|
||||
(n-chars (length chars)))
|
||||
;; make sure the mock object is being used as expected.
|
||||
(assert (>= end (length chars)))
|
||||
(replace char-buf chars :start1 start)
|
||||
(fill size-buf 1 :start start :end (+ start n-chars))
|
||||
(+ start n-chars)))
|
||||
(t
|
||||
(sb-impl::eof-or-lose stream eof-err-p start))))
|
||||
|
|
|
|||
|
|
@ -1858,5 +1858,23 @@
|
|||
(let ((b (& (>> val 7) #x1f)))
|
||||
(let ((a (>> (<< val 9) 27)))
|
||||
(^ a (aref tab b))))))")
|
||||
(#(24D3B50 59DB420 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121 46050970
|
||||
49C05C00 57C2457C 5A355FA0 665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9D753C32 9E88666C
|
||||
9EDCE097 9F1704E1 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E6B647A0 F087745E
|
||||
F5306542 F8AA3557 FA4BD0D1)
|
||||
"(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CHAR-BUFFER-START :CHAR-BUFFER-BYTE-POSITION-START :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
|
||||
"((let ((tab #a((32) (unsigned-byte 8) 19 0 9 28 0 0 0 0 9 12 9 51 36 0 20 9 51 0 33 0 9 0 55 0 12 50 63 0 0 0 0 0)))
|
||||
(let ((b (& (>> val 7) #x1f)))
|
||||
(let ((a (>> (<< val 9) 27)))
|
||||
(^ a (aref tab b))))))")
|
||||
(#(13913B1 24D3B50 59DB420 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121
|
||||
46050970 49C05C00 57C2457C 5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6
|
||||
9D753C32 9E88666C 9EDCE097 9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D088DA49 D64A65E2
|
||||
DB5C8A6A DDF478CA E57CFC3F E6B647A0 F087745E F5306542 F8AA3557 FA4BD0D1)
|
||||
"(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CHAR-BUFFER-START :CHAR-BUFFER-BYTE-POSITION-START :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
|
||||
"((let ((tab #a((32) (unsigned-byte 8) 51 0 16 0 9 60 19 0 51 26 0 0 0 28 51 34 59 22 22 36 36 9 0 0 49 22 0 41 61 10 0 59)))
|
||||
(let ((b (& (>> val 9) #x1f)))
|
||||
(let ((a (>> (<< val 9) 27)))
|
||||
(^ a (aref tab b))))))")
|
||||
)
|
||||
;; EOF
|
||||
|
|
|
|||
Loading…
Reference in a new issue