Changeset 15165 for trunk/source/level-1


Ignore:
Timestamp:
Jan 19, 2012, 1:47:48 AM (8 years ago)
Author:
gb
Message:

Except on the PPC (which has LAP versions of %EXTEND-VECTOR), define
%EXTEND-VECTOR in terms of %UVECTOR-REPLACE, which can use things like
%COPY-IVECTOR-TO-IVECTOR.

Make %UVECTOR-REPLACE work on non-CL-array uvector types, too.

When creating an fd-based stream (in MAKE-FD-STREAM and MAKE-FILE-STREAM),
if the stream is capable of character I/O it'll be buffered by an octet
vector, so call OPTIMAL-BUFFER-SIZE with the appropriate element type.
On Windows, use the arbitrary buffer size of 4K octets (rather than #$BUFSIZ).

In %IOBLOCK-UNENCODED-READ-LINE, if we haven't seen a newline in the first
few bufferfuls of data, stop expecting to do so (and grow the string in
larger increments less often.)

In the more generic READ-LINE cases, use a SIMPLE-STRING (and track
its length and current position manually) rather than a string with a
fill-pointer.

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-streams.lisp

    r14833 r15165  
    102102;; From Shannon Spires, slightly modified.
    103103(defun generic-read-line (s)
    104   (let* ((str (make-array 20 :element-type 'base-char
    105                           :adjustable t :fill-pointer 0))
     104  (let* ((len 20)
     105         (pos 0)
     106         (str (make-array len :element-type 'base-char))
    106107         (eof nil))
     108    (declare (fixnum pos len) (simple-string str))
    107109    (do* ((ch (read-char s nil :eof) (read-char s nil :eof)))
    108110         ((or (eq ch #\newline) (setq eof (eq ch :eof)))
    109           (values (ensure-simple-string str) eof))
    110       (vector-push-extend ch str))))
     111          (values (subseq str 0 pos) eof))
     112      (when (= pos len)
     113        (setq len (* len 2)
     114              str (%extend-vector 0 str len)))
     115      (setf (schar str pos) ch
     116            pos (1+ pos)))))
    111117
    112118(defun generic-character-read-list (stream list count)
     
    22972303           (len 0)
    22982304           (eof nil)
     2305           (filled-buf 0)
    22992306           (buf (io-buffer-buffer inbuf))
    23002307           (newline (char-code #\newline)))
     2308      (declare (fixnum filled-buf))
    23012309      (let* ((ch (ioblock-untyi-char ioblock)))
    23022310        (when ch
     
    23132321               (idx (io-buffer-idx inbuf))
    23142322               (count (io-buffer-count inbuf)))
    2315           (declare (fixnum idx count more))
     2323          (declare (fixnum idx count more filled-buf))
    23162324          (if (= idx count)
    23172325            (if eof
     
    23192327              (progn
    23202328                (setq eof t)
     2329                (incf filled-buf)
    23212330                (%ioblock-advance ioblock t)))
    23222331            (progn
     
    23422351                (%copy-u8-to-string
    23432352                 buf idx string len more)
    2344                 (incf len more)))))))))
     2353                (incf len more))
     2354              (when (> filled-buf 1)
     2355                (let* ((pos len))
     2356                  (loop
     2357                    (%ioblock-advance ioblock t)
     2358                    (setq count (io-buffer-count inbuf))
     2359                    (when (zerop count)                       
     2360                      (return-from %ioblock-unencoded-read-line
     2361                        (values (if (= pos len)
     2362                                  string
     2363                                  (subseq string 0 pos))
     2364                                t)))
     2365                    (let* ((p (position newline buf :end count))
     2366                           (n (or p count))
     2367                           (room (- len pos)))
     2368                      (declare (fixnum n room))
     2369                      (when (< room n)
     2370                        (setq len (+ len (the fixnum (or p len)))
     2371                              string (%extend-vector 0 string len)))
     2372                      (%copy-u8-to-string buf 0 string pos n)
     2373                      (incf pos n)
     2374                      (when p
     2375                        (return-from %ioblock-unencoded-read-line
     2376                          (values (if (= pos len)
     2377                                    string
     2378                                    (subseq string 0 pos)) nil)))
     2379                      (setf (io-buffer-idx inbuf) count))))))))))))
    23452380
    23462381;;; There are lots of ways of doing better here, but in the most general
     
    23482383;;; whether there's a 1:1 mapping between code units and characters.
    23492384(defun %ioblock-encoded-read-line (ioblock)
    2350   (let* ((str (make-array 20 :element-type 'base-char
    2351                           :adjustable t :fill-pointer 0))
     2385  (let* ((pos 0)
     2386         (len 20)
     2387         (str (make-string len))
    23522388         (rcf (ioblock-read-char-when-locked-function ioblock))
    23532389         (eof nil))
     2390    (declare (fixnum pos len) (simple-string str))
    23542391    (do* ((ch (funcall rcf ioblock) (funcall rcf ioblock)))
    23552392         ((or (eq ch #\newline) (setq eof (eq ch :eof)))
    2356           (values (ensure-simple-string str) eof))
    2357       (vector-push-extend ch str))))
     2393          (values (subseq str 0 pos) eof))
     2394      (when (= pos len)
     2395        (setq len (* len 2) str (%extend-vector 0 str len)))
     2396      (setf (schar str pos) ch
     2397            pos (1+ pos)))))
    23582398         
    23592399(defun %ioblock-unencoded-character-read-vector (ioblock vector start end)
     
    33443384             (8 (ash octets -3)))))
    33453385    #+windows-target
    3346     (let ((octets #$BUFSIZ))
     3386    (let ((octets 4096))
    33473387      (scale-buffer-size octets))
    33483388    #-windows-target
  • trunk/source/level-1/l1-sysio.lisp

    r15138 r15165  
    774774        ((:io :output) nil)
    775775        (t (report-bad-arg direction '(member :input :output :io :probe))))
    776       (check-pathname-not-wild filename) ;; probe-file-x misses wild versions....
     776      (check-pathname-not-wild filename) ; probe-file-x misses wild versions....
    777777      (multiple-value-bind (native-truename kind) (probe-file-x filename)
    778778        (tagbody retry
     
    805805                   (when (null if-exists) (return-from open nil))
    806806                   (multiple-value-setq (native-truename kind) (probe-file-x filename))
    807                    (unless native-truename ;; huh?  Perhaps it disappeared again?
     807                   (unless native-truename ; huh?  Perhaps it disappeared again?
    808808                     (error "Attempt to create ~s failed unexpectedly" filename))
    809809                   (go retry))
     
    830830                       (char-p (or (eq element-type 'character)
    831831                                   (subtypep element-type 'character)))
    832                        (elements-per-buffer (optimal-buffer-size fd element-type))
     832                       (elements-per-buffer (optimal-buffer-size fd (if char-p '(unsigned-byte 8) element-type)))
    833833                       (real-external-format
    834834                        (if char-p
Note: See TracChangeset for help on using the changeset viewer.