Changeset 9485


Ignore:
Timestamp:
May 15, 2008, 2:09:03 PM (11 years ago)
Author:
gz
Message:

Propagate r9408 to here so doesn't get lost in back-merge

Location:
branches/working-0711-perf/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711-perf/ccl/level-1/l1-io.lisp

    r9425 r9485  
    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 (if (null output-stream)
    58                    *standard-output*
    59                    (if (eq output-stream t)
    60                      *terminal-io*
    61                      (if (istruct-typep output-stream 'xp-structure)
    62                        (get-xp-stream output-stream)
    63                        output-stream)))))
     68  (let* ((stream (%real-print-stream output-stream)))
    6469    (if (typep stream 'basic-stream)
    6570      (let* ((ioblock (basic-stream-ioblock stream)))
     
    7277  "Write the characters of the subsequence of STRING bounded by START
    7378and END to OUTPUT-STREAM."
    74   (let* ((stream (if (null output-stream)
    75                    *standard-output*
    76                    (if (eq output-stream t)
    77                      *terminal-io*
    78                      (if (istruct-typep output-stream 'xp-structure)
    79                        (get-xp-stream output-stream)
    80                        output-stream)))))
     79  (let* ((stream (%real-print-stream output-stream)))
    8180    (if (typep stream 'basic-stream)
    8281      (let* ((ioblock (basic-stream-ioblock stream)))
     
    10099      (if (and (not start-p) (not end-p))
    101100        (stream-write-string stream string)
    102         (stream-write-string stream string start end)))))
     101        (stream-write-string stream string start end)))
     102  string))
     103
     104(defun write-simple-string (string output-stream start end)
     105  "Write the characters of the subsequence of simple-string STRING bounded by START
     106and END to OUTPUT-STREAM."
     107  (let* ((stream (%real-print-stream output-stream))
     108         (string (the simple-string string))) ;; typecheck at high safety.
     109    (if (typep stream 'basic-stream)
     110      (let* ((ioblock (basic-stream-ioblock stream))
     111             (start (or start 0)))
     112        (with-ioblock-output-locked (ioblock)
     113          (if (and (eq start 0) (null end))
     114            (funcall (ioblock-write-simple-string-function ioblock)
     115                     ioblock string 0 (length string))
     116            (let* ((end (check-sequence-bounds string start end)))
     117              (funcall (ioblock-write-simple-string-function ioblock)
     118                       ioblock string start  (%i- end start))))))
     119      (if (and (not start) (not end))
     120        (stream-write-string stream string)
     121        (stream-write-string stream string start end)))
     122    string))
    103123
    104124(defun write-line (string &optional output-stream
     
    106126  "Write the characters of the subsequence of STRING bounded by START
    107127and END to OUTPUT-STREAM then output a #\Newline at end."
    108   (let ((stream (real-print-stream output-stream)))
    109     (write-string string stream :start start :end end)
    110     (terpri stream)
    111     string))
     128  (write-string string output-stream :start start :end end)
     129  (terpri output-stream)
     130  string)
    112131
    113132(defun terpri (&optional (stream *standard-output*))
    114   (let* ((stream (real-print-stream stream)))
     133  (let* ((stream (%real-print-stream stream)))
    115134    (if (typep stream 'basic-stream)
    116135      (let* ((ioblock (basic-stream-ioblock stream)))
    117136        (funcall (ioblock-write-char-function ioblock) ioblock #\newline))
    118       (stream-write-char  (real-print-stream stream) #\newline))
     137      (stream-write-char stream #\newline))
    119138    nil))
    120139
     
    700719  (let ((strlen 0) (exponent-char (float-exponent-char float)))
    701720    (declare (fixnum exp strlen))
    702     (setq stream (real-print-stream stream))
     721    (setq stream (%real-print-stream stream))
    703722    (if (and (not nanning)(nan-or-infinity-p float))
    704723      (print-a-nan float stream)   
     
    16851704        ((streamp stream)
    16861705         stream)
     1706        ;; This never gets called because streamp is true for xp-structure...
    16871707        ((istruct-typep stream 'xp-structure)
    16881708         (get-xp-stream stream))
     
    16911711
    16921712(defun write-1 (object stream &optional levels-left)
    1693   (setq stream (real-print-stream stream))
     1713  (setq stream (%real-print-stream stream))
    16941714  (when (not levels-left)
    16951715    (setq levels-left
     
    18321852  "Output a newline, the mostly READable printed representation of OBJECT, and
    18331853  space to the specified STREAM."
    1834   (setq stream (real-print-stream stream))
    18351854  (terpri stream)
    18361855  (let ((*print-escape* t))
  • branches/working-0711-perf/ccl/level-1/l1-streams.lisp

    r9427 r9485  
    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
     
    58365839
    58375840                             
    5838 (defun column (&optional stream)
    5839   (let* ((stream (real-print-stream stream)))
    5840     (stream-line-column stream)))       
    5841 
    58425841(defun (setf %ioblock-external-format) (ef ioblock)
    58435842  (let* ((encoding (get-character-encoding (external-format-character-encoding ef)))
Note: See TracChangeset for help on using the changeset viewer.