Changeset 15176


Ignore:
Timestamp:
Jan 24, 2012, 3:00:34 PM (8 years ago)
Author:
gb
Message:

Revert last change.

File:
1 edited

Legend:

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

    r15175 r15176  
    100100;;; For input streams:
    101101
    102 ;;; From Shannon Spires, slightly modified.
     102;; From Shannon Spires, slightly modified.
    103103(defun generic-read-line (s)
    104   (collect ((chunks))
    105     (let* ((pos 0)
    106            (len 0)
    107            (chunksize 8192)
    108            (str (make-string chunksize))
    109            (eof nil))
    110       (declare (fixnum pos len chunksize)
    111                (simple-string str)
    112                (dynamic-extent str))
    113       (do* ((ch (read-char s nil :eof) (read-char s nil :eof)))
    114            ((or (eq ch #\newline) (setq eof (eq ch :eof)))
    115             (if (zerop len)
    116               (values (subseq str 0 pos) eof)
    117               (let* ((outpos 0))
    118                 (setq len (+ len pos))
    119                 (let* ((out (make-string len)))
    120                   (dolist (s (chunks))
    121                     (%uvector-replace out outpos s 0 chunksize target::subtag-simple-base-string)
    122                     (incf outpos chunksize))
    123                   (%uvector-replace out outpos str 0 pos target::subtag-simple-base-string)
    124                   (values out eof)))))
    125         (when (= pos chunksize)
    126           (chunks str)
    127           (setq str (make-string chunksize)
    128                 len (+ len pos)
    129                 pos 0))
    130         (setf (schar str pos) ch
    131               pos (1+ pos))))))
    132 
     104  (let* ((len 20)
     105         (pos 0)
     106         (str (make-array len :element-type 'base-char))
     107         (eof nil))
     108    (declare (fixnum pos len) (simple-string str))
     109    (do* ((ch (read-char s nil :eof) (read-char s nil :eof)))
     110         ((or (eq ch #\newline) (setq eof (eq ch :eof)))
     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)))))
    133117
    134118(defun generic-character-read-list (stream list count)
     
    23142298            (io-buffer-idx buf) 0)))
    23152299
    2316 
    23172300(defun %ioblock-unencoded-read-line (ioblock)
    2318   (declare (optimize (speed 3) (safety 0)))
    2319   (collect ((octet-vectors))
    2320     (let* ((inbuf (ioblock-inbuf ioblock))
     2301  (let* ((inbuf (ioblock-inbuf ioblock)))
     2302    (let* ((string "")
    23212303           (len 0)
    2322            (buf (io-buffer-buffer inbuf)))
    2323       (declare (fixnum len) (type (simple-array (unsigned-byte 8)(*)) buf))
     2304           (eof nil)
     2305           (filled-buf 0)
     2306           (buf (io-buffer-buffer inbuf))
     2307           (newline (char-code #\newline)))
     2308      (declare (fixnum filled-buf))
    23242309      (let* ((ch (ioblock-untyi-char ioblock)))
    23252310        (when ch
     
    23272312          (if (eql ch #\newline)
    23282313            (return-from %ioblock-unencoded-read-line
    2329               (values "" nil))
     2314              (values string nil))
    23302315            (progn
    2331               (octet-vectors (make-array 1 :element-type '(unsigned-byte 8)
    2332                                          :initial-element (char-code ch)))
    2333               (setq len 1)))))
    2334       (do* ((done nil)
    2335             (idx (io-buffer-idx inbuf))
    2336             (count (io-buffer-count inbuf)))
    2337            (done (let* ((string (make-string len))
    2338                         (outpos 0))
    2339                    (declare (simple-string string) (fixnum outpos))
    2340                    (dolist (v (octet-vectors (values string (eq done :eof))))
    2341                      (let* ((vlen (length v)))
    2342                        (declare (fixnum vlen))
    2343                        (%copy-u8-to-string v 0 string outpos vlen)
    2344                        (incf outpos vlen)))))
    2345         (declare (fixnum idx count))
    2346         (when (= idx count)
    2347           (%ioblock-advance ioblock t)
    2348           (setq idx (io-buffer-idx inbuf)
    2349                 count (io-buffer-count inbuf)
    2350                 done (if (= idx count) :eof)))
    2351         (unless done
    2352           (let* ((p (do* ((i idx (1+ i)))
    2353                          ((= i count)
    2354                           (setf (io-buffer-idx inbuf) count)
    2355                           nil)
    2356                       (declare (fixnum i))
    2357                       (when (eql (aref buf i) (char-code #\newline))
    2358                         (setf (io-buffer-idx inbuf) (the fixnum (1+ i)))
    2359                         (setq done t)
    2360                         (return i))))
    2361                  (end (or p count))
    2362                  (n (- end idx)))
    2363             (declare (fixnum p end n))
    2364             (if (and p (eql len 0))
    2365               ;; Likely a fairly common case
    2366               (let* ((string (make-string n)))
    2367                 (%copy-u8-to-string buf idx string 0 n)
    2368                 (return-from %ioblock-unencoded-read-line
    2369                   (values string nil)))
    2370               (let* ((v (make-array n :element-type '(unsigned-byte 8))))
    2371                 (%copy-ivector-to-ivector buf idx v 0 n)
    2372                 (incf len n)
    2373                 (octet-vectors v)
    2374                 (setq idx count)))))))))
    2375 
     2316              (setq string (make-string 1)
     2317                    len 1)
     2318              (setf (schar string 0) ch)))))
     2319      (loop
     2320        (let* ((more 0)
     2321               (idx (io-buffer-idx inbuf))
     2322               (count (io-buffer-count inbuf)))
     2323          (declare (fixnum idx count more filled-buf))
     2324          (if (= idx count)
     2325            (if eof
     2326              (return (values string t))
     2327              (progn
     2328                (setq eof t)
     2329                (incf filled-buf)
     2330                (%ioblock-advance ioblock t)))
     2331            (progn
     2332              (setq eof nil)
     2333              (let* ((pos (position newline buf :start idx :end count)))
     2334                (when pos
     2335                  (locally (declare (fixnum pos))
     2336                    (setf (io-buffer-idx inbuf) (the fixnum (1+ pos)))
     2337                    (setq more (- pos idx))
     2338                    (unless (zerop more)
     2339                      (setq string
     2340                            (%extend-vector
     2341                             0 string (the fixnum (+ len more)))))
     2342                    (%copy-u8-to-string
     2343                     buf idx string len more)
     2344                    (return (values string nil))))
     2345                ;; No #\newline in the buffer.  Read everything that's
     2346                ;; there into the string, and fill the buffer again.
     2347                (setf (io-buffer-idx inbuf) count)
     2348                (setq more (- count idx)
     2349                      string (%extend-vector
     2350                              0 string (the fixnum (+ len more))))
     2351                (%copy-u8-to-string
     2352                 buf idx string 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))))))))))))
    23762380
    23772381;;; There are lots of ways of doing better here, but in the most general
     
    23792383;;; whether there's a 1:1 mapping between code units and characters.
    23802384(defun %ioblock-encoded-read-line (ioblock)
    2381   (declare (optimize (speed 3) (safety 0)))
    2382   (collect ((chunks))
    2383     (let* ((pos 0)
    2384            (len 0)
    2385            (chunksize 8192)
    2386            (str (make-string chunksize))
    2387            (rcf (ioblock-read-char-when-locked-function ioblock))
    2388            (eof nil))
    2389       (declare (fixnum pos len chunksize)
    2390                (simple-string str)
    2391                (dynamic-extent str))
    2392       (do* ((ch (funcall rcf ioblock) (funcall rcf ioblock)))
    2393            ((or (eq ch #\newline) (setq eof (eq ch :eof)))
    2394             (if (zerop len)
    2395               (values (subseq str 0 pos) eof)
    2396               (let* ((outpos 0))
    2397                 (declare (fixnum outpos))
    2398                 (setq len (+ len pos))
    2399                 (let* ((out (make-string len)))
    2400                   (dolist (s (chunks))
    2401                     (%copy-ivector-to-ivector s 0 out outpos (the fixnum (ash chunksize 2)))
    2402                     (incf outpos (ash chunksize 2)))
    2403                   (%copy-ivector-to-ivector str 0 out outpos (the fixnum (ash pos 2)))
    2404                   (values out eof)))))
    2405         (when (= pos chunksize)
    2406           (chunks str)
    2407           (setq str (make-string chunksize)
    2408                 len (+ len pos)
    2409                 pos 0))
    2410         (setf (schar str pos) ch
    2411               pos (1+ pos))))))
     2385  (let* ((pos 0)
     2386         (len 20)
     2387         (str (make-string len))
     2388         (rcf (ioblock-read-char-when-locked-function ioblock))
     2389         (eof nil))
     2390    (declare (fixnum pos len) (simple-string str))
     2391    (do* ((ch (funcall rcf ioblock) (funcall rcf ioblock)))
     2392         ((or (eq ch #\newline) (setq eof (eq ch :eof)))
     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)))))
    24122398         
    24132399(defun %ioblock-unencoded-character-read-vector (ioblock vector start end)
Note: See TracChangeset for help on using the changeset viewer.