Changeset 9886


Ignore:
Timestamp:
Jul 2, 2008, 9:07:05 PM (11 years ago)
Author:
gz
Message:

Propagate 9408 from working-0711 to trunk

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

Legend:

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

    r9879 r9886  
    3030
    3131
     32(declaim (inline %real-print-stream))
     33(defun %real-print-stream (&optional (stream nil))
     34  (cond ((null stream)
     35         *standard-output*)
     36        ((eq stream t)
     37         *terminal-io*)
     38        (t stream)))
     39
    3240;;; OK, EOFP isn't CL ...
    3341(defun eofp (&optional (stream *standard-input*))
     
    3543
    3644(defun force-output (&optional stream)
    37   (stream-force-output (real-print-stream stream))
     45  (stream-force-output (%real-print-stream stream))
    3846  nil)
    3947
     
    4553  "Output #\Newline only if the OUTPUT-STREAM is not already at the
    4654start of a line.  Return T if #\Newline needed."
    47   (stream-fresh-line (real-print-stream output-stream)))
    48 
     55  (stream-fresh-line (%real-print-stream output-stream)))
     56
     57(defun column (&optional stream)
     58  (let* ((stream (%real-print-stream stream)))
     59    (stream-line-column stream)))
    4960
    5061(defun clear-input (&optional input-stream)
     
    5566(defun write-char (char &optional (output-stream nil))
    5667  "Output CHAR to OUTPUT-STREAM."
    57   (let* ((stream (real-print-stream output-stream)))
     68  (let* ((stream (%real-print-stream output-stream)))
    5869    (if (typep stream 'basic-stream)
    5970      (let* ((ioblock (basic-stream-ioblock stream)))
    6071        (funcall (ioblock-write-char-function ioblock) ioblock char))
    61       (stream-write-char (real-print-stream output-stream) char))
     72      (stream-write-char stream char))
    6273    char))
    6374
     
    6677  "Write the characters of the subsequence of STRING bounded by START
    6778and END to OUTPUT-STREAM."
    68   (let* ((stream (real-print-stream output-stream)))
     79  (let* ((stream (%real-print-stream output-stream)))
    6980    (if (typep stream 'basic-stream)
    7081      (let* ((ioblock (basic-stream-ioblock stream)))
     
    95106  "Write the characters of the subsequence of STRING bounded by START
    96107and END to OUTPUT-STREAM then output a #\Newline at end."
    97   (let ((stream (real-print-stream output-stream)))
    98     (write-string string stream :start start :end end)
    99     (terpri stream)
    100     string))
     108  (write-string string output-stream :start start :end end)
     109  (terpri output-stream)
     110  string)
    101111
    102112(defun terpri (&optional (stream *standard-output*))
    103   (let* ((stream (real-print-stream stream)))
     113  (let* ((stream (%real-print-stream stream)))
    104114    (if (typep stream 'basic-stream)
    105115      (let* ((ioblock (basic-stream-ioblock stream)))
    106116        (funcall (ioblock-write-char-function ioblock) ioblock #\newline))
    107       (stream-write-char  (real-print-stream stream) #\newline))
     117      (stream-write-char stream #\newline))
    108118    nil))
    109119
     
    689699  (let ((strlen 0) (exponent-char (float-exponent-char float)))
    690700    (declare (fixnum strlen))
    691     (setq stream (real-print-stream stream))
     701    (setq stream (%real-print-stream stream))
    692702    (if (and (not nanning)(nan-or-infinity-p float))
    693703      (print-a-nan float stream)   
     
    16741684        ((streamp stream)
    16751685         stream)
     1686        ;; This never gets called because streamp is true for xp-structure...
    16761687        ((istruct-typep stream 'xp-structure)
    16771688         (get-xp-stream stream))
     
    16801691
    16811692(defun write-1 (object stream &optional levels-left)
    1682   (setq stream (real-print-stream stream))
     1693  (setq stream (%real-print-stream stream))
    16831694  (when (not levels-left)
    16841695    (setq levels-left
     
    18211832  "Output a newline, the mostly READable printed representation of OBJECT, and
    18221833  space to the specified STREAM."
    1823   (setq stream (real-print-stream stream))
    18241834  (terpri stream)
    18251835  (let ((*print-escape* t))
  • trunk/source/level-1/l1-streams.lisp

    r9879 r9886  
    102102
    103103(defmethod stream-element-type ((x t))
     104  (report-bad-arg x 'stream))
     105
     106(defmethod stream-force-output ((x t))
    104107  (report-bad-arg x 'stream))
    105108
     
    32723275  (declare (dynamic-extent initargs))
    32733276  (let* ((s
    3274           (if (subtypep class (find-class 'basic-stream))
     3277          (if (subtypep class 'basic-stream)
    32753278            (apply #'make-basic-stream-instance class :allow-other-keys t initargs)
    32763279            (apply #'make-instance class :allow-other-keys t initargs))))
     
    33113314                   (:socket
    33123315                    #+linux-target nominal
    3313                     #-linux-target 
     3316                    #-linux-target
    33143317                    (int-getsockopt fd #$SOL_SOCKET #$SO_SNDLOWAT))
    33153318                   ((:character-special :tty) (#_fpathconf fd #$_PC_MAX_INPUT))
     
    37363739
    37373740
    3738 
    3739 
    3740 
    3741 
    37423741(defun stream-is-closed (s)
    37433742  (error "~s is closed" s))
     
    43504349    (incf (ioblock-charpos ioblock)))
    43514350  (if (= index len)
    4352       (let* ((newlen (+ len len))      ;non-zero !
     4351      (let* ((newlen (if (zerop len) 20 (+ len len)))      ;non-zero !
    43534352             (new (make-string newlen)))
    43544353        (%copy-ivector-to-ivector string 0 new 0 (the fixnum (ash len 2)))
     
    48164815    (when ioblock
    48174816      (%ioblock-close ioblock))))
    4818 
    48194817
    48204818(defmethod close :before ((stream buffered-output-stream-mixin) &key abort)
     
    56015599    (error "Can't create that type of stream.")))
    56025600
    5603 (defun make-selection-input-stream (fd &key peer-fd  encoding)
     5601(defun make-selection-input-stream (fd &key peer-fd encoding)
    56045602  (let* ((s (make-fd-stream fd
    56055603                            :class 'selection-input-stream
     
    57705768          (if (typep stream 'two-way-stream)
    57715769            (input-stream-shared-resource
    5772              (two-way-stream-input-stream *terminal-io*)))))
     5770             (two-way-stream-input-stream stream)))))
    57735771    (when shared-resource (%yield-shared-resource shared-resource process))))
    57745772
     
    58605858
    58615859                             
    5862 (defun column (&optional stream)
    5863   (let* ((stream (real-print-stream stream)))
    5864     (stream-line-column stream)))       
    5865 
    58665860(defun (setf %ioblock-external-format) (ef ioblock)
    58675861  (let* ((encoding (get-character-encoding (external-format-character-encoding ef)))
Note: See TracChangeset for help on using the changeset viewer.