/[cmucl]/src/code/stream.lisp
ViewVC logotype

Diff of /src/code/stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by ram, Mon May 14 12:32:42 1990 UTC revision 1.3.1.1 by wlott, Tue Jun 12 22:54:17 1990 UTC
# Line 7  Line 7 
7  ;;; Scott Fahlman (FAHLMAN@CMUC).  ;;; Scott Fahlman (FAHLMAN@CMUC).
8  ;;; **********************************************************************  ;;; **********************************************************************
9  ;;;  ;;;
10    ;;; $Header$
11    ;;;
12  ;;; Stream functions for Spice Lisp.  ;;; Stream functions for Spice Lisp.
13  ;;; Written by Skef Wholey and Rob MacLachlan.  ;;; Written by Skef Wholey and Rob MacLachlan.
14  ;;;  ;;;
# Line 190  Line 192 
192           (index (stream-in-index stream)))           (index (stream-in-index stream)))
193      (declare (fixnum index))      (declare (fixnum index))
194      (if (simple-string-p buffer)      (if (simple-string-p buffer)
195          (let ((nl (%primitive find-character buffer index in-buffer-length          (let ((nl (%sp-find-character buffer index in-buffer-length #\newline)))
                               #\newline)))  
196            (if nl            (if nl
197                (values (prog1 (subseq (the simple-string buffer) index nl)                (values (prog1 (subseq (the simple-string buffer) index nl)
198                               (setf (stream-in-index stream) (1+ (the fixnum nl))))                               (setf (stream-in-index stream)
199                                       (1+ (the fixnum nl))))
200                        nil)                        nil)
201                (multiple-value-bind (str eofp)                (multiple-value-bind (str eofp)
202                                     (funcall (stream-misc stream) stream                                     (funcall (stream-misc stream) stream
# Line 304  Line 306 
306      (cond      (cond
307       ((not in-buffer)       ((not in-buffer)
308        (with-in-stream stream stream-n-bin buffer start numbytes eof-errorp))        (with-in-stream stream stream-n-bin buffer start numbytes eof-errorp))
309       ((not (eql (%primitive get-vector-access-code in-buffer) 3))       ((not (typep in-buffer
310                      '(or simple-string (simple-array (unsigned-byte 8) (*)))))
311        (error "N-Bin only works on 8-bit-like streams."))        (error "N-Bin only works on 8-bit-like streams."))
312       ((<= numbytes num-buffered)       ((<= numbytes num-buffered)
313        (%primitive byte-blt in-buffer index buffer start (+ start numbytes))        (%primitive byte-blt in-buffer index buffer start (+ start numbytes))
# Line 773  Line 776 
776         (declare (simple-string string) (fixnum current end))         (declare (simple-string string) (fixnum current end))
777         (if (= current end)         (if (= current end)
778             (eof-or-lose stream arg1 arg2)             (eof-or-lose stream arg1 arg2)
779             (let ((pos (%primitive find-character string current end #\newline)))             (let ((pos (position #\newline string :start current :end end)))
780               (if pos               (if pos
781                   (let* ((res-length (- (the fixnum pos) current))                   (let* ((res-length (- (the fixnum pos) current))
782                          (result (make-string res-length)))                          (result (make-string res-length)))
# Line 908  Line 911 
911    
912  (defun fill-pointer-ouch (stream character)  (defun fill-pointer-ouch (stream character)
913    (let* ((buffer (fill-pointer-output-stream-string stream))    (let* ((buffer (fill-pointer-output-stream-string stream))
914           (current (%primitive header-ref buffer %array-fill-pointer-slot))           (current (fill-pointer buffer))
915           (current+1 (1+ current)))           (current+1 (1+ current)))
916      (declare (fixnum current))      (declare (fixnum current))
917      (with-array-data ((workspace buffer) (start) (end))      (with-array-data ((workspace buffer) (start) (end))
# Line 924  Line 927 
927                (setf offset-current current)                (setf offset-current current)
928                (set-array-header buffer workspace new-length                (set-array-header buffer workspace new-length
929                                  current+1 0 new-length nil))                                  current+1 0 new-length nil))
930              (%primitive header-set buffer %array-fill-pointer-slot current+1))              (setf (fill-pointer buffer) current+1))
931          (setf (schar workspace offset-current) character)))          (setf (schar workspace offset-current) character)))
932      current+1))      current+1))
933    
# Line 932  Line 935 
935  (defun fill-pointer-sout (stream string start end)  (defun fill-pointer-sout (stream string start end)
936    (declare (simple-string string) (fixnum start end))    (declare (simple-string string) (fixnum start end))
937    (let* ((buffer (fill-pointer-output-stream-string stream))    (let* ((buffer (fill-pointer-output-stream-string stream))
938           (current (%primitive header-ref buffer %array-fill-pointer-slot))           (current (fill-pointer buffer))
939           (string-len (- end start))           (string-len (- end start))
940           (dst-end (+ string-len current)))           (dst-end (+ string-len current)))
941      (declare (fixnum current dst-end string-len))      (declare (fixnum current dst-end string-len))
# Line 951  Line 954 
954                (setf offset-dst-end dst-end)                (setf offset-dst-end dst-end)
955                (set-array-header buffer workspace new-length                (set-array-header buffer workspace new-length
956                                  dst-end 0 new-length nil))                                  dst-end 0 new-length nil))
957              (%primitive header-set buffer %array-fill-pointer-slot dst-end))              (setf (fill-pointer buffer) dst-end))
958          (%primitive byte-blt string start          (%primitive byte-blt string start
959                      workspace offset-current offset-dst-end)))                      workspace offset-current offset-dst-end)))
960      dst-end))      dst-end))
# Line 962  Line 965 
965    (case operation    (case operation
966      (:charpos      (:charpos
967       (let* ((buffer (fill-pointer-output-stream-string stream))       (let* ((buffer (fill-pointer-output-stream-string stream))
968              (current (%primitive header-ref buffer %array-fill-pointer-slot)))              (current (fill-pointer buffer)))
969         (with-array-data ((string buffer) (start) (end current))         (with-array-data ((string buffer) (start) (end current))
970           (declare (simple-string string) (ignore start))           (declare (simple-string string) (ignore start))
971           (let ((found (position #\newline string :test #'char=           (let ((found (position #\newline string :test #'char=

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.3.1.1

  ViewVC Help
Powered by ViewVC 1.1.5