Changeset 15165 for trunk/source/level-1
- Timestamp:
- Jan 19, 2012, 1:47:48 AM (9 years ago)
- Location:
- trunk/source/level-1
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-streams.lisp
r14833 r15165 102 102 ;; From Shannon Spires, slightly modified. 103 103 (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)) 106 107 (eof nil)) 108 (declare (fixnum pos len) (simple-string str)) 107 109 (do* ((ch (read-char s nil :eof) (read-char s nil :eof))) 108 110 ((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))))) 111 117 112 118 (defun generic-character-read-list (stream list count) … … 2297 2303 (len 0) 2298 2304 (eof nil) 2305 (filled-buf 0) 2299 2306 (buf (io-buffer-buffer inbuf)) 2300 2307 (newline (char-code #\newline))) 2308 (declare (fixnum filled-buf)) 2301 2309 (let* ((ch (ioblock-untyi-char ioblock))) 2302 2310 (when ch … … 2313 2321 (idx (io-buffer-idx inbuf)) 2314 2322 (count (io-buffer-count inbuf))) 2315 (declare (fixnum idx count more ))2323 (declare (fixnum idx count more filled-buf)) 2316 2324 (if (= idx count) 2317 2325 (if eof … … 2319 2327 (progn 2320 2328 (setq eof t) 2329 (incf filled-buf) 2321 2330 (%ioblock-advance ioblock t))) 2322 2331 (progn … … 2342 2351 (%copy-u8-to-string 2343 2352 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)))))))))))) 2345 2380 2346 2381 ;;; There are lots of ways of doing better here, but in the most general … … 2348 2383 ;;; whether there's a 1:1 mapping between code units and characters. 2349 2384 (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)) 2352 2388 (rcf (ioblock-read-char-when-locked-function ioblock)) 2353 2389 (eof nil)) 2390 (declare (fixnum pos len) (simple-string str)) 2354 2391 (do* ((ch (funcall rcf ioblock) (funcall rcf ioblock))) 2355 2392 ((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))))) 2358 2398 2359 2399 (defun %ioblock-unencoded-character-read-vector (ioblock vector start end) … … 3344 3384 (8 (ash octets -3))))) 3345 3385 #+windows-target 3346 (let ((octets #$BUFSIZ))3386 (let ((octets 4096)) 3347 3387 (scale-buffer-size octets)) 3348 3388 #-windows-target -
trunk/source/level-1/l1-sysio.lisp
r15138 r15165 774 774 ((:io :output) nil) 775 775 (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.... 777 777 (multiple-value-bind (native-truename kind) (probe-file-x filename) 778 778 (tagbody retry … … 805 805 (when (null if-exists) (return-from open nil)) 806 806 (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? 808 808 (error "Attempt to create ~s failed unexpectedly" filename)) 809 809 (go retry)) … … 830 830 (char-p (or (eq element-type 'character) 831 831 (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))) 833 833 (real-external-format 834 834 (if char-p
Note: See TracChangeset
for help on using the changeset viewer.