contrib/sb-simple-streams/cl.lisp

   1 ;;; -*- lisp -*-
   2
   3 ;;; This code is in the public domain.
   4
   5 ;;; The cmucl implementation of simple-streams was done by Paul Foley,
   6 ;;; who placed the code in the public domain.  Sbcl port by Rudi
   7 ;;; Schlatte.
   8
   9 (in-package "SB-SIMPLE-STREAMS")
  10
  11 ;;; Implementations of standard Common Lisp functions for simple-streams
  12
  13 (defmacro %check-simple-stream (stream &optional direction)
  14   ;; Check that STREAM is valid and open in the appropriate direction.
  15   `(locally
  16      (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
  17      (with-stream-class (simple-stream ,stream)
  18        (let ((flags (sm %flags ,stream)))
  19          (cond ((zerop (logand flags ,(%flags '(:simple))))
  20                 (error "~S is not properly initialized." stream))
  21                ((zerop (logand flags ,(%flags '(:input :output))))
  22                 (error "~S is closed." stream))
  23                ,@(when direction
  24                    `(((zerop (logand flags ,(%flags (list direction))))
  25                       (error ,(format nil "~~S is not an ~(~A~) stream."
  26                                       direction)
  27                              stream)))))))))
  28
  29
  30 (defun %simple-stream-file-position (stream position)
  31   (if (typep stream 'file-simple-stream)
  32       (with-stream-class (file-simple-stream stream)
  33         (if (null position)
  34             (let ((posn (device-file-position stream)))
  35               (when posn
  36                 ;; Adjust for data read from device but not yet
  37                 ;; consumed from buffer, or written after the end of
  38                 ;; the buffer
  39                 (decf posn (- (sm buffer-ptr stream) (sm buffpos stream))))
  40               posn)
  41             (progn
  42               (setf (sm last-char-read-size stream) 0)
  43               (let ((position
  44                      (cond ((numberp position) position)
  45                            ((eq position :start) 0)
  46                            ((eq position :end)
  47                             (%simple-stream-file-length stream))
  48                            (t (error "Invalid position-spec: ~A" position))))
  49                     (device-position (device-file-position stream)))
  50                 (if (and (<= (- device-position (sm buffer-ptr stream))
  51                              position
  52                              device-position)
  53                          (not (any-stream-instance-flags stream :dirty)))
  54                     ;; new position is within buffer; just move pointer
  55                     (setf (sm buffpos stream)
  56                           (- position (- device-position (sm buffer-ptr stream))))
  57                     (progn
  58                       (when (any-stream-instance-flags stream :dirty)
  59                         (sc-flush-buffer stream t))
  60                       (setf (device-file-position stream) position
  61                             (sm buffer-ptr stream) 0
  62                             (sm buffpos stream) 0)))))))
  63       ;; TODO: implement file-position for other types of stream where
  64       ;; it makes sense
  65       nil))
  66
  67
  68 (defun %simple-stream-file-length (stream)
  69   (declare (type simple-stream stream))
  70   (%check-simple-stream stream)
  71   (device-file-length stream)
  72   ;; implement me
  73   )
  74
  75
  76 (defun %simple-stream-file-name (stream)
  77   (declare (type simple-stream stream))
  78   (if (typep stream 'file-simple-stream)
  79       (with-stream-class (file-simple-stream stream)
  80         (sm pathname stream))
  81       nil))
  82
  83
  84 (defun %simple-stream-file-rename (stream new-name)
  85   (declare (type simple-stream stream))
  86   (if (typep stream 'file-simple-stream)
  87       (with-stream-class (file-simple-stream stream)
  88         (setf (sm pathname stream) new-name)
  89         (setf (sm filename stream) (sb-int:unix-namestring new-name nil))
  90         t)
  91       nil))
  92
  93
  94 (defun %simple-stream-file-string-length (stream object)
  95   (declare (type simple-stream stream))
  96   (etypecase object
  97     (character 1)
  98     (string (length object))))
  99
 100
 101 (defun %simple-stream-read-char (stream eof-error-p eof-value
 102                                  recursive-p blocking-p)
 103   (declare (type simple-stream stream)
 104            (ignore recursive-p))
 105   (with-stream-class (simple-stream stream)
 106     (%check-simple-stream stream :input)
 107     (funcall-stm-handler j-read-char (sm melded-stream stream)
 108                          eof-error-p eof-value blocking-p)))
 109
 110
 111 (defun %simple-stream-unread-char (stream character)
 112   (declare (type simple-stream stream) (ignore character))
 113   (%check-simple-stream stream :input)
 114   (with-stream-class (simple-stream)
 115     (if (zerop (sm last-char-read-size stream))
 116         (error "Nothing to unread.")
 117         (funcall-stm-handler j-unread-char stream nil))))
 118
 119 (defun %simple-stream-peek-char (stream peek-type eof-error-p
 120                                  eof-value recursive-p)
 121   (declare (type simple-stream stream)
 122            (ignore recursive-p))
 123   (with-stream-class (simple-stream stream)
 124     (%check-simple-stream stream :input)
 125     (let* ((encap (sm melded-stream stream))
 126            (char (funcall-stm-handler j-read-char encap
 127                                      eof-error-p stream t)))
 128       (cond ((eq char stream) eof-value)
 129             ((characterp peek-type)
 130              (do ((char char (funcall-stm-handler j-read-char encap
 131                                                   eof-error-p
 132                                                   stream t)))
 133                  ((or (eq char stream) (char= char peek-type))
 134                   (unless (eq char stream)
 135                     (funcall-stm-handler j-unread-char encap t))
 136                   (if (eq char stream) eof-value char))))
 137             ((eq peek-type t)
 138              (do ((char char (funcall-stm-handler j-read-char stream
 139                                                   eof-error-p
 140                                                   stream t)))
 141                  ((or (eq char stream)
 142                       (not (sb-impl::whitespacep char)))
 143                   (unless (eq char stream)
 144                     (funcall-stm-handler j-unread-char encap t))
 145                   (if (eq char stream) eof-value char))))
 146             (t
 147              (funcall-stm-handler j-unread-char encap t)
 148              char)))))
 149
 150
 151 (defun %simple-stream-read-line (stream eof-error-p eof-value recursive-p)
 152   (declare (type simple-stream stream)
 153            (ignore recursive-p)
 154            (optimize (speed 3) (space 2) (safety 0) (debug 0)))
 155   (%check-simple-stream stream :input)
 156   (with-stream-class (simple-stream stream)
 157     (let* ((encap (sm melded-stream stream)) ; encapsulating stream
 158            (cbuf (make-string 80))      ; current buffer
 159            (bufs (list cbuf))           ; list of buffers
 160            (tail bufs)                  ; last cons of bufs list
 161            (index 0)                    ; current index in current buffer
 162            (total 0))                   ; total characters
 163       (declare (type simple-stream encap)
 164                (type simple-base-string cbuf)
 165                (type cons bufs tail)
 166                (type fixnum index total))
 167       (loop
 168         (multiple-value-bind (chars done)
 169             (funcall-stm-handler j-read-chars encap cbuf
 170                                  #\Newline index (length cbuf) t)
 171           (declare (type fixnum chars))
 172           (incf index chars)
 173           (incf total chars)
 174           (when (and (eq done :eof) (zerop index))
 175             (if eof-error-p
 176                 (error 'end-of-file :stream stream)
 177                 (return (values eof-value t))))
 178           (when done
 179             ;; If there's only one buffer in use, return it directly
 180             (when (null (cdr bufs))
 181               (return (values (sb-kernel:shrink-vector cbuf index)
 182                               (eq done :eof))))
 183             ;; If total fits in final buffer, use it
 184             #+(or)
 185             (when (<= total (length cbuf))
 186               (replace cbuf cbuf :start1 (- total index) :end2 index)
 187               (let ((idx 0))
 188                 (declare (type fixnum idx))
 189                 (dolist (buf bufs)
 190                   (declare (type simple-base-string buf))
 191                   (replace cbuf buf :start1 idx)
 192                   (incf idx (length buf))))
 193               (return (values (sb-kernel:shrink-vector cbuf index)
 194                               (eq done :eof))))
 195             ;; Allocate new string of appropriate length
 196             (let ((string (make-string total))
 197                   (index 0))
 198               (declare (type fixnum index))
 199               (dolist (buf bufs)
 200                 (declare (type simple-base-string buf))
 201                 (replace string buf :start1 index)
 202                 (incf index (length buf)))
 203               (return  (values string (eq done :eof)))))
 204           (when (>= index (length cbuf))
 205             (setf cbuf (make-string (the fixnum (* 2 index))))
 206             (setf index 0)
 207             (setf (cdr tail) (cons cbuf nil))
 208             (setf tail (cdr tail))))))))
 209
 210
 211 (defun %simple-stream-listen (stream width)
 212   (declare (type simple-stream stream))
 213   ;; WIDTH is number of octets which must be available; any value
 214   ;; other than 1 is treated as 'character.
 215   (%check-simple-stream stream :input)
 216   (simple-stream-dispatch stream
 217     ;; single-channel-simple-stream
 218     (with-stream-class (single-channel-simple-stream stream)
 219       (if (not (eql width 1))
 220           (funcall-stm-handler j-listen stream)
 221           (or (< (sm buffpos stream) (sm buffer-ptr stream))
 222               (when (>= (sm mode stream) 0) ;; device-connected
 223                 (incf (sm last-char-read-size stream))
 224                 (let ((ok (sc-refill-buffer stream nil)))
 225                   (decf (sm last-char-read-size stream))
 226                   (plusp ok))))))
 227     ;; dual-channel-simple-stream
 228     (error "Implement %LISTEN")
 229     ;; string-simple-stream
 230     (error "Implement %LISTEN")))
 231
 232
 233 (defun %simple-stream-clear-input (stream buffer-only)
 234   (declare (type simple-stream stream))
 235   (%check-simple-stream stream :input)
 236   (simple-stream-dispatch stream
 237     ;; single-channel-simple-stream
 238     (with-stream-class (single-channel-simple-stream stream)
 239       (setf (sm buffpos stream) 0
 240             (sm buffer-ptr stream) 0
 241             (sm last-char-read-size stream) 0))
 242     ;; dual-channel-simple-stream
 243     (with-stream-class (dual-channel-simple-stream stream)
 244       (setf (sm buffpos stream) 0
 245             (sm buffer-ptr stream) 0
 246             (sm last-char-read-size stream) 0))
 247     ;; string-simple-stream
 248     nil)
 249   (unless buffer-only (device-clear-input stream buffer-only)))
 250
 251
 252 (defun %simple-stream-read-byte (stream eof-error-p eof-value)
 253   (declare (type simple-stream stream))
 254   (%check-simple-stream stream :input)
 255   (with-stream-class (simple-stream stream)
 256     (if (any-stream-instance-flags stream :eof)
 257         (sb-impl::eof-or-lose stream eof-error-p eof-value)
 258         (simple-stream-dispatch stream
 259           ;; single-channel-simple-stream
 260           (sc-read-byte stream eof-error-p eof-value t)
 261           ;; dual-channel-simple-stream
 262           (dc-read-byte stream eof-error-p eof-value t)
 263           ;; string-simple-stream
 264           (with-stream-class (string-simple-stream stream)
 265             (let ((encap (sm input-handle stream)))
 266               (unless encap
 267                 (error 'simple-type-error
 268                        :datum stream
 269                        :expected-type 'stream
 270                        :format-control "Can't read-byte on string streams"
 271                        :format-arguments '()))
 272               (prog1
 273                   (locally (declare (notinline read-byte))
 274                     (read-byte encap eof-error-p eof-value))
 275                 (setf (sm last-char-read-size stream) 0
 276                       (sm encapsulated-char-read-size stream) 0))))))))
 277
 278
 279 (defun %simple-stream-write-char (stream character)
 280   (declare (type simple-stream stream))
 281   (%check-simple-stream stream :output)
 282   (with-stream-class (simple-stream stream)
 283     (funcall-stm-handler-2 j-write-char character (sm melded-stream stream))))
 284
 285
 286 (defun %simple-stream-fresh-line (stream)
 287   (declare (type simple-stream stream))
 288   (%check-simple-stream stream :output)
 289   (with-stream-class (simple-stream stream)
 290     (when (/= (or (sm charpos stream) 1) 0)
 291       (funcall-stm-handler-2 j-write-char #\Newline (sm melded-stream stream))
 292       t)))
 293
 294
 295 (defun %simple-stream-write-string (stream string start end)
 296   (declare (type simple-stream stream))
 297   (%check-simple-stream stream :output)
 298   (with-stream-class (simple-stream stream)
 299     (funcall-stm-handler-2 j-write-chars string (sm melded-stream stream)
 300                            start end)))
 301
 302
 303 (defun %simple-stream-line-length (stream)
 304   (declare (type simple-stream stream))
 305   (%check-simple-stream stream :output)
 306   #| TODO: implement me |#
 307   nil  ;; implement me
 308   )
 309
 310
 311 (defun %simple-stream-finish-output (stream)
 312   (declare (type simple-stream stream))
 313   (with-stream-class (simple-stream stream)
 314     (%check-simple-stream stream :output)
 315     (simple-stream-dispatch stream
 316       ;; single-channel-simple-stream
 317       (sc-flush-buffer stream t)
 318       ;; dual-channel-simple-stream
 319       (dc-flush-buffer stream t)
 320       ;; string-simple-stream
 321       nil)))
 322
 323
 324 (defun %simple-stream-force-output (stream)
 325   (declare (type simple-stream stream))
 326   (with-stream-class (simple-stream stream)
 327     (%check-simple-stream stream :output)
 328     (simple-stream-dispatch stream
 329       ;; single-channel-simple-stream
 330       (sc-flush-buffer stream nil)
 331       ;; dual-channel-simple-stream
 332       (dc-flush-buffer stream nil)
 333       ;; string-simple-stream
 334       nil)))
 335
 336
 337 (defun %simple-stream-clear-output (stream)
 338   (declare (type simple-stream stream))
 339   (%check-simple-stream stream :output)
 340   (with-stream-class (simple-stream stream)
 341     #| TODO: clear output buffer |#
 342     (device-clear-output stream)))
 343
 344
 345 (defun %simple-stream-write-byte (stream integer)
 346   (declare (type simple-stream stream))
 347   (with-stream-class (simple-stream stream)
 348     (%check-simple-stream stream :output)
 349     (simple-stream-dispatch stream
 350       ;; single-channel-simple-stream
 351       (with-stream-class (single-channel-simple-stream stream)
 352         (let ((ptr (sm buffpos stream)))
 353           (when (>= ptr (sm buf-len stream))
 354             (setf ptr (sc-flush-buffer stream t)))
 355           (add-stream-instance-flags stream :dirty)
 356           (setf (sm buffpos stream) (1+ ptr))
 357           (setf (bref (sm buffer stream) ptr) integer)))
 358       ;; dual-channel-simple-stream
 359       (with-stream-class (dual-channel-simple-stream stream)
 360         (let ((ptr (sm outpos stream)))
 361           (when (>= ptr (sm max-out-pos stream))
 362             (setf ptr (dc-flush-buffer stream t)))
 363           (setf (sm outpos stream) (1+ ptr))
 364           (setf (bref (sm out-buffer stream) ptr) integer)))
 365       ;; string-simple-stream
 366       (error 'simple-type-error
 367              :datum stream
 368              :expected-type 'stream
 369              :format-control "Can't write-byte on string streams."
 370              :format-arguments '()))))
 371
 372
 373 (defun %simple-stream-read-sequence (stream seq start end partial-fill)
 374   (declare (type simple-stream stream))
 375   (with-stream-class (simple-stream stream)
 376     (%check-simple-stream stream :input)
 377     (etypecase seq
 378       (string
 379        (funcall-stm-handler j-read-chars (sm melded-stream stream) seq nil
 380                             start (or end (length seq))
 381                             (if partial-fill :bnb t)))
 382       ((or (simple-array (unsigned-byte 8) (*))
 383            (simple-array (signed-byte 8) (*)))
 384        ;; TODO: "read-vector" equivalent, but blocking if partial-fill is NIL
 385        (error "implement me")
 386        ))))
 387
 388
 389 (defun %simple-stream-write-sequence (stream seq start end)
 390   (declare (type simple-stream stream))
 391   (with-stream-class (simple-stream stream)
 392     (%check-simple-stream stream :output)
 393     (etypecase seq
 394       (string
 395        (funcall-stm-handler-2 j-write-chars seq (sm melded-stream stream)
 396                               start (or end (length seq))))
 397       ((or (simple-array (unsigned-byte 8) (*))
 398            (simple-array (signed-byte 8) (*)))
 399        ;; "write-vector" equivalent
 400        (simple-stream-dispatch stream
 401          ;; single-channel-simple-stream
 402          (with-stream-class (single-channel-simple-stream stream)
 403            (loop with max-ptr = (sm buf-len stream)
 404                  with real-end = (or end (length seq))
 405                  for src-pos = start then (+ src-pos count)
 406                  for src-rest = (- real-end src-pos)
 407                  while (> src-rest 0) ; FIXME: this is non-ANSI
 408                  for ptr = (let ((ptr (sm buffpos stream)))
 409                              (if (>= ptr max-ptr)
 410                                  (sc-flush-buffer stream t)
 411                                  ptr))
 412                  for buf-rest = (- max-ptr ptr)
 413                  for count = (min buf-rest src-rest)
 414                  do (progn (add-stream-instance-flags stream :dirty)
 415                            (setf (sm buffpos stream) (+ ptr count))
 416                            (buffer-copy seq src-pos (sm buffer stream) ptr count))))
 417          ;; dual-channel-simple-stream
 418          (error "Implement me")
 419          ;; string-simple-stream
 420          (error 'simple-type-error
 421                 :datum stream
 422                 :expected-type 'stream
 423                 :format-control "Can't write-byte on string streams."
 424                 :format-arguments '()))
 425        ))))
 426
 427
 428 ;;; Basic functionality for ansi-streams.  These are separate
 429 ;;; functions because they are called in places where we already know
 430 ;;; we operate on an ansi-stream (as opposed to a simple- or
 431 ;;; gray-stream, or the symbols t or nil), so we can evade typecase
 432 ;;; and (in|out)-synonym-of calls.
 433
 434 (declaim (inline %ansi-stream-read-byte %ansi-stream-read-char
 435                  %ansi-stream-unread-char %ansi-stream-read-line
 436                  %ansi-stream-read-sequence))
 437
 438 (defun %ansi-stream-read-byte (stream eof-error-p eof-value blocking)
 439   (declare (ignore blocking))
 440   #+nil
 441   (sb-kernel:ansi-stream-read-byte stream eof-error-p eof-value)
 442   (sb-int:prepare-for-fast-read-byte stream
 443     (prog1
 444         (sb-int:fast-read-byte eof-error-p eof-value t)
 445       (sb-int:done-with-fast-read-byte))))
 446
 447 (defun %ansi-stream-read-char (stream eof-error-p eof-value blocking)
 448   (declare (ignore blocking))
 449   #+nil
 450   (sb-kernel:ansi-stream-read-char stream eof-error-p eof-value)
 451   (sb-int:prepare-for-fast-read-char stream
 452     (prog1
 453         (sb-int:fast-read-char eof-error-p eof-value)
 454       (sb-int:done-with-fast-read-char))))
 455
 456 (defun %ansi-stream-unread-char (character stream)
 457   (let ((index (1- (sb-kernel:ansi-stream-in-index stream)))
 458         (buffer (sb-kernel:ansi-stream-in-buffer stream)))
 459     (declare (fixnum index))
 460     (when (minusp index) (error "nothing to unread"))
 461     (cond (buffer
 462            (setf (aref buffer index) (char-code character))
 463            (setf (sb-kernel:ansi-stream-in-index stream) index))
 464           (t
 465            (funcall (sb-kernel:ansi-stream-misc stream) stream
 466                     :unread character)))))
 467
 468 (defun %ansi-stream-read-line (stream eof-error-p eof-value)
 469   (sb-int:prepare-for-fast-read-char stream
 470     (let ((res (make-string 80))
 471           (len 80)
 472           (index 0))
 473       (loop
 474        (let ((ch (sb-int:fast-read-char nil nil)))
 475          (cond (ch
 476                 (when (char= ch #\newline)
 477                   (sb-int:done-with-fast-read-char)
 478                   (return (values (sb-kernel:shrink-vector res index) nil)))
 479                 (when (= index len)
 480                   (setq len (* len 2))
 481                   (let ((new (make-string len)))
 482                     (replace new res)
 483                     (setq res new)))
 484                 (setf (schar res index) ch)
 485                 (incf index))
 486                ((zerop index)
 487                 (sb-int:done-with-fast-read-char)
 488                 (return (values (sb-impl::eof-or-lose stream eof-error-p
 489                                                       eof-value)
 490                                 t)))
 491                ;; Since FAST-READ-CHAR already hit the eof char, we
 492                ;; shouldn't do another READ-CHAR.
 493                (t
 494                 (sb-int:done-with-fast-read-char)
 495                 (return (values (sb-kernel:shrink-vector res index) t)))))))))
 496
 497 (defun %ansi-stream-read-sequence (seq stream start %end)
 498   (declare (type sequence seq)
 499            (type sb-kernel:ansi-stream stream)
 500            (type sb-int:index start)
 501            (type sb-kernel:sequence-end %end)
 502            (values sb-int:index))
 503   (let ((end (or %end (length seq))))
 504     (declare (type sb-int:index end))
 505     (etypecase seq
 506       (list
 507        (let ((read-function
 508               (if (subtypep (stream-element-type stream) 'character)
 509                   #'%ansi-stream-read-char
 510                   #'%ansi-stream-read-byte)))
 511          (do ((rem (nthcdr start seq) (rest rem))
 512               (i start (1+ i)))
 513              ((or (endp rem) (>= i end)) i)
 514            (declare (type list rem)
 515                     (type sb-int:index i))
 516            (let ((el (funcall read-function stream nil :eof nil)))
 517              (when (eq el :eof)
 518                (return i))
 519              (setf (first rem) el)))))
 520       (vector
 521        (sb-kernel:with-array-data ((data seq) (offset-start start)
 522                                    (offset-end end))
 523          (typecase data
 524            ((or (simple-array (unsigned-byte 8) (*))
 525                 (simple-array (signed-byte 8) (*))
 526                 simple-string)
 527             (let* ((numbytes (- end start))
 528                    (bytes-read (sb-sys:read-n-bytes stream
 529                                                     data
 530                                                     offset-start
 531                                                     numbytes
 532                                                     nil)))
 533               (if (< bytes-read numbytes)
 534                   (+ start bytes-read)
 535                   end)))
 536            (t
 537             (let ((read-function
 538                    (if (subtypep (stream-element-type stream) 'character)
 539                        #'%ansi-stream-read-char
 540                        #'%ansi-stream-read-byte)))
 541               (do ((i offset-start (1+ i)))
 542                   ((>= i offset-end) end)
 543                 (declare (type sb-int:index i))
 544                 (let ((el (funcall read-function stream nil :eof nil)))
 545                   (when (eq el :eof)
 546                     (return (+ start (- i offset-start))))
 547                   (setf (aref data i) el)))))))))))
 548
 549
 550 (defun %ansi-stream-write-string (string stream start end)
 551   (declare (type string string)
 552            (type sb-kernel:ansi-stream stream)
 553            (type sb-int:index start end))
 554
 555   ;; Note that even though you might expect, based on the behavior of
 556   ;; things like AREF, that the correct upper bound here is
 557   ;; (ARRAY-DIMENSION STRING 0), the ANSI glossary definitions for
 558   ;; "bounding index" and "length" indicate that in this case (i.e.
 559   ;; for the ANSI-specified functions WRITE-STRING and WRITE-LINE
 560   ;; which are implemented in terms of this function), (LENGTH STRING)
 561   ;; is the required upper bound. A foolish consistency is the
 562   ;; hobgoblin of lesser languages..
 563   (unless (<= 0 start end (length string))
 564     (error "~@<bad bounding indices START=~W END=~W for ~2I~_~S~:>"
 565            start
 566            end
 567            string))
 568
 569   (if (sb-kernel:array-header-p string)
 570       (sb-kernel:with-array-data ((data string) (offset-start start)
 571                                   (offset-end end))
 572         (funcall (sb-kernel:ansi-stream-sout stream)
 573                  stream data offset-start offset-end))
 574       (funcall (sb-kernel:ansi-stream-sout stream) stream string start end))
 575   string)
 576
 577 (defun %ansi-stream-write-sequence (seq stream start %end)
 578   (declare (type sequence seq)
 579            (type sb-kernel:ansi-stream stream)
 580            (type sb-int:index start)
 581            (type sb-kernel:sequence-end %end)
 582            (values sequence))
 583   (let ((end (or %end (length seq))))
 584     (declare (type sb-int:index end))
 585     (etypecase seq
 586       (list
 587        (let ((write-function
 588               (if (subtypep (stream-element-type stream) 'character)
 589                   ;; TODO: Replace these with ansi-stream specific
 590                   ;; functions too.
 591                   #'write-char
 592                   #'write-byte)))
 593          (do ((rem (nthcdr start seq) (rest rem))
 594               (i start (1+ i)))
 595              ((or (endp rem) (>= i end)) seq)
 596            (declare (type list rem)
 597                     (type sb-int:index i))
 598            (funcall write-function (first rem) stream))))
 599       (string
 600        (%ansi-stream-write-string seq stream start end))
 601       (vector
 602        (let ((write-function
 603               (if (subtypep (stream-element-type stream) 'character)
 604                   ;; TODO: Replace these with ansi-stream specific
 605                   ;; functions too.
 606                   #'write-char
 607                   #'write-byte)))
 608          (do ((i start (1+ i)))
 609              ((>= i end) seq)
 610            (declare (type sb-int:index i))
 611            (funcall write-function (aref seq i) stream)))))))
 612
 613
 614 ;;;
 615 ;;; USER-LEVEL FUNCTIONS
 616 ;;;
 617
 618 (defmethod open-stream-p ((stream simple-stream))
 619   (any-stream-instance-flags stream :input :output))
 620
 621 (defmethod input-stream-p ((stream simple-stream))
 622   (any-stream-instance-flags stream :input))
 623
 624 (defmethod output-stream-p ((stream simple-stream))
 625   (any-stream-instance-flags stream :output))
 626
 627 (defmethod stream-element-type ((stream simple-stream))
 628   '(unsigned-byte 8))
 629
 630 (defun interactive-stream-p (stream)
 631   "Return true if Stream does I/O on a terminal or other interactive device."
 632   (etypecase stream
 633     (simple-stream
 634      (any-stream-instance-flags stream :interactive))
 635     (ansi-stream
 636      (funcall (sb-kernel:ansi-stream-misc stream) stream :interactive-p))
 637     (fundamental-stream
 638      nil)))
 639
 640 (defun (setf interactive-stream-p) (flag stream)
 641   (typecase stream
 642     (simple-stream
 643      (if flag
 644          (add-stream-instance-flags stream :interactive)
 645          (remove-stream-instance-flags stream :interactive)))
 646     (t
 647      (error 'simple-type-error
 648             :datum stream
 649             :expected-type 'simple-stream
 650             :format-control "Can't set interactive flag on ~S."
 651             :format-arguments (list stream)))))
 652
 653 (defun file-string-length (stream object)
 654   (declare (type (or string character) object) (type stream stream))
 655   "Return the delta in STREAM's FILE-POSITION that would be caused by writing
 656    OBJECT to STREAM. Non-trivial only in implementations that support
 657    international character sets."
 658   (typecase stream
 659     (simple-stream (%simple-stream-file-string-length stream object))
 660     (t
 661      (etypecase object
 662        (character 1)
 663        (string (length object))))))
 664
 665 (defun stream-external-format (stream)
 666   "Returns Stream's external-format."
 667   (etypecase stream
 668     (simple-stream
 669      (with-stream-class (simple-stream)
 670        (sm external-format stream)))
 671     (ansi-stream
 672      :default)
 673     (fundamental-stream
 674      :default)))
 675
 676 (defun open (filename &rest options
 677              &key (direction :input)
 678              (element-type 'character element-type-given)
 679              if-exists if-does-not-exist
 680              (external-format :default)
 681              class mapped input-handle output-handle
 682              &allow-other-keys)
 683   "Return a stream which reads from or writes to Filename.
 684   Defined keywords:
 685    :direction - one of :input, :output, :io, or :probe
 686    :element-type - type of object to read or write, default BASE-CHAR
 687    :if-exists - one of :error, :new-version, :rename, :rename-and-delete,
 688                        :overwrite, :append, :supersede or NIL
 689    :if-does-not-exist - one of :error, :create or NIL
 690    :external-format - :default
 691   See the manual for details.
 692
 693   The following are simple-streams-specific additions:
 694    :class - class of stream object to be created
 695    :mapped - T to open a memory-mapped file
 696    :input-handle - a stream or Unix file descriptor to read from
 697    :output-handle - a stream or Unix file descriptor to write to"
 698   (declare (ignore external-format input-handle output-handle
 699                    if-exists if-does-not-exist))
 700   (let ((class (or class 'sb-sys::file-stream))
 701         (options (copy-list options))
 702         (filespec (merge-pathnames filename)))
 703     (cond ((eq class 'sb-sys::file-stream)
 704            (remf options :class)
 705            (remf options :mapped)
 706            (remf options :input-handle)
 707            (remf options :output-handle)
 708            (apply #'open-fd-stream filespec options))
 709           ((subtypep class 'simple-stream)
 710            (when element-type-given
 711              (error "Can't create simple-streams with an element-type."))
 712            (when (and (eq class 'file-simple-stream) mapped)
 713              (setq class 'mapped-file-simple-stream)
 714              (setf (getf options :class) 'mapped-file-simple-stream))
 715            (when (subtypep class 'file-simple-stream)
 716              (when (eq direction :probe)
 717                (setq class 'probe-simple-stream)))
 718            (apply #'make-instance class :filename filespec options))
 719           ((subtypep class 'sb-gray:fundamental-stream)
 720            (remf options :class)
 721            (remf options :mapped)
 722            (remf options :input-handle)
 723            (remf options :output-handle)
 724            (make-instance class :lisp-stream
 725                           (apply #'open-fd-stream filespec options))))))
 726
 727
 728 (declaim (inline read-byte read-char read-char-no-hang unread-char))
 729
 730 (defun read-byte (stream &optional (eof-error-p t) eof-value)
 731   "Returns the next byte of the Stream."
 732   (let ((stream (sb-impl::in-synonym-of stream)))
 733     (etypecase stream
 734       (simple-stream
 735        (%simple-stream-read-byte stream eof-error-p eof-value))
 736       (ansi-stream
 737        (%ansi-stream-read-byte stream eof-error-p eof-value t))
 738       (fundamental-stream
 739        (let ((char (sb-gray:stream-read-byte stream)))
 740          (if (eq char :eof)
 741              (sb-impl::eof-or-lose stream eof-error-p eof-value)
 742              char))))))
 743
 744 (defun read-char (&optional (stream *standard-input*) (eof-error-p t)
 745                             eof-value recursive-p)
 746   "Inputs a character from Stream and returns it."
 747   (let ((stream (sb-impl::in-synonym-of stream)))
 748     (etypecase stream
 749       (simple-stream
 750        (%simple-stream-read-char stream eof-error-p eof-value recursive-p t))
 751       (ansi-stream
 752        (%ansi-stream-read-char stream eof-error-p eof-value t))
 753       (fundamental-stream
 754        (let ((char (sb-gray:stream-read-char stream)))
 755          (if (eq char :eof)
 756              (sb-impl::eof-or-lose stream eof-error-p eof-value)
 757              char))))))
 758
 759 (defun read-char-no-hang (&optional (stream *standard-input*) (eof-error-p t)
 760                                     eof-value recursive-p)
 761   "Returns the next character from the Stream if one is availible, or nil."
 762   (declare (ignore recursive-p))
 763   (let ((stream (sb-impl::in-synonym-of stream)))
 764     (etypecase stream
 765       (simple-stream
 766        (%check-simple-stream stream :input)
 767        (with-stream-class (simple-stream)
 768          (funcall-stm-handler j-read-char stream eof-error-p eof-value nil)))
 769       (ansi-stream
 770        (if (funcall (sb-kernel:ansi-stream-misc stream) stream :listen)
 771            (%ansi-stream-read-char stream eof-error-p eof-value t)
 772            nil))
 773       (fundamental-stream
 774        (let ((char (sb-gray:stream-read-char-no-hang stream)))
 775          (if (eq char :eof)
 776              (sb-impl::eof-or-lose stream eof-error-p eof-value)
 777              char))))))
 778
 779 (defun unread-char (character &optional (stream *standard-input*))
 780   "Puts the Character back on the front of the input Stream."
 781   (let ((stream (sb-impl::in-synonym-of stream)))
 782     (etypecase stream
 783       (simple-stream
 784        (%simple-stream-unread-char stream character))
 785       (ansi-stream
 786        (%ansi-stream-unread-char character stream))
 787       (fundamental-stream
 788        (sb-gray:stream-unread-char stream character))))
 789   nil)
 790
 791 (declaim (notinline read-byte read-char read-char-no-hang unread-char))
 792
 793 (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
 794                             (eof-error-p t) eof-value recursive-p)
 795   "Peeks at the next character in the input Stream.  See manual for details."
 796   (let ((stream (sb-impl::in-synonym-of stream)))
 797     (etypecase stream
 798       (simple-stream
 799        (%simple-stream-peek-char stream peek-type eof-error-p eof-value
 800                                  recursive-p))
 801       (ansi-stream
 802        (let ((char (%ansi-stream-read-char stream eof-error-p eof-value t)))
 803           (cond ((eq char eof-value) char)
 804                 ((characterp peek-type)
 805                  (do ((char char (%ansi-stream-read-char stream eof-error-p
 806                                                          eof-value t)))
 807                      ((or (eq char eof-value) (char= char peek-type))
 808                       (unless (eq char eof-value)
 809                         (%ansi-stream-unread-char char stream))
 810                       char)))
 811                 ((eq peek-type t)
 812                  (do ((char char (%ansi-stream-read-char stream eof-error-p
 813                                                          eof-value t)))
 814                      ((or (eq char eof-value)
 815                           (not (sb-int:whitespace-char-p char)))
 816                       (unless (eq char eof-value)
 817                         (%ansi-stream-unread-char char stream))
 818                       char)))
 819                 (t
 820                  (%ansi-stream-unread-char char stream)
 821                  char))))
 822       (fundamental-stream
 823        (cond ((characterp peek-type)
 824               (do ((char (sb-gray:stream-read-char stream)
 825                          (sb-gray:stream-read-char stream)))
 826                   ((or (eq char :eof) (char= char peek-type))
 827                    (cond ((eq char :eof)
 828                           (sb-impl::eof-or-lose stream eof-error-p eof-value))
 829                          (t
 830                           (sb-gray:stream-unread-char stream char)
 831                           char)))))
 832              ((eq peek-type t)
 833               (do ((char (sb-gray:stream-read-char stream)
 834                          (sb-gray:stream-read-char stream)))
 835                   ((or (eq char :eof) (not (sb-int:whitespace-char-p char)))
 836                    (cond ((eq char :eof)
 837                           (sb-impl::eof-or-lose stream eof-error-p eof-value))
 838                          (t
 839                           (sb-gray:stream-unread-char stream char)
 840                           char)))))
 841              (t
 842               (let ((char (sb-gray:stream-peek-char stream)))
 843                 (if (eq char :eof)
 844                     (sb-impl::eof-or-lose stream eof-error-p eof-value)
 845                     char))))))))
 846
 847 (defun listen (&optional (stream *standard-input*) (width 1))
 848   "Returns T if Width octets are available on the given Stream.  If Width
 849   is given as 'character, check for a character."
 850   ;; WIDTH is number of octets which must be available; any value
 851   ;; other than 1 is treated as 'character.
 852   (let ((stream (sb-impl::in-synonym-of stream)))
 853     (etypecase stream
 854       (simple-stream
 855        (%simple-stream-listen stream width))
 856       (ansi-stream
 857        (or (/= (the fixnum (sb-kernel:ansi-stream-in-index stream))
 858                sb-impl::+ansi-stream-in-buffer-length+)
 859             ;; Test for T explicitly since misc methods return :EOF sometimes.
 860             (eq (funcall (sb-kernel:ansi-stream-misc stream) stream :listen)
 861                 t)))
 862       (fundamental-stream
 863        (sb-gray:stream-listen stream)))))
 864
 865
 866 (defun read-line (&optional (stream *standard-input*) (eof-error-p t)
 867                             eof-value recursive-p)
 868   "Returns a line of text read from the Stream as a string, discarding the
 869   newline character."
 870   (declare (ignore recursive-p))
 871   (let ((stream (sb-impl::in-synonym-of stream)))
 872     (etypecase stream
 873       (simple-stream
 874        (%simple-stream-read-line stream eof-error-p eof-value recursive-p))
 875       (ansi-stream
 876        (%ansi-stream-read-line stream eof-error-p eof-value))
 877       (fundamental-stream
 878        (multiple-value-bind (string eof) (sb-gray:stream-read-line stream)
 879          (if (and eof (zerop (length string)))
 880              (values (sb-impl::eof-or-lose stream eof-error-p eof-value) t)
 881              (values string eof)))))))
 882
 883 (defun read-sequence (seq stream &key (start 0) (end nil) partial-fill)
 884   "Destructively modify SEQ by reading elements from STREAM.
 885   SEQ is bounded by START and END. SEQ is destructively modified by
 886   copying successive elements into it from STREAM. If the end of file
 887   for STREAM is reached before copying all elements of the subsequence,
 888   then the extra elements near the end of sequence are not updated, and
 889   the index of the next element is returned."
 890   (let ((stream (sb-impl::in-synonym-of stream))
 891         (end (or end (length seq))))
 892     (etypecase stream
 893       (simple-stream
 894        (with-stream-class (simple-stream stream)
 895          (%simple-stream-read-sequence stream seq start end partial-fill)))
 896       (ansi-stream
 897        (%ansi-stream-read-sequence seq stream start end))
 898       (fundamental-stream
 899        (sb-gray:stream-read-sequence stream seq start end)))))
 900
 901 (defun clear-input (&optional (stream *standard-input*) buffer-only)
 902   "Clears any buffered input associated with the Stream."
 903   (let ((stream (sb-impl::in-synonym-of stream)))
 904     (etypecase stream
 905       (simple-stream
 906        (%simple-stream-clear-input stream buffer-only))
 907       (ansi-stream
 908        (setf (sb-kernel:ansi-stream-in-index stream)
 909              sb-impl::+ansi-stream-in-buffer-length+)
 910        (funcall (sb-kernel:ansi-stream-misc stream) stream :clear-input))
 911       (fundamental-stream
 912        (sb-gray:stream-clear-input stream))))
 913   nil)
 914
 915 (defun write-byte (integer stream)
 916   "Outputs an octet to the Stream."
 917   (let ((stream (sb-impl::out-synonym-of stream)))
 918     (etypecase stream
 919       (simple-stream
 920        (%simple-stream-write-byte stream integer))
 921       (ansi-stream
 922        (funcall (sb-kernel:ansi-stream-bout stream) stream integer))
 923       (fundamental-stream
 924        (sb-gray:stream-write-byte stream integer))))
 925   integer)
 926
 927 (defun write-char (character &optional (stream *standard-output*))
 928   "Outputs the Character to the Stream."
 929   (let ((stream (sb-impl::out-synonym-of stream)))
 930     (etypecase stream
 931       (simple-stream
 932        (%simple-stream-write-char stream character))
 933       (ansi-stream
 934        (funcall (sb-kernel:ansi-stream-out stream) stream character))
 935       (fundamental-stream
 936        (sb-gray:stream-write-char stream character))))
 937   character)
 938
 939 (defun write-string (string &optional (stream *standard-output*)
 940                             &key (start 0) (end nil))
 941   "Outputs the String to the given Stream."
 942   (let ((stream (sb-impl::out-synonym-of stream))
 943         (end (or end (length string))))
 944     (etypecase stream
 945       (simple-stream
 946        (%simple-stream-write-string stream string start end)
 947        string)
 948       (ansi-stream
 949        (%ansi-stream-write-string string stream start end))
 950       (fundamental-stream
 951        (sb-gray:stream-write-string stream string start end)))))
 952
 953 (defun write-line (string &optional (stream *standard-output*)
 954                           &key (start 0) end)
 955   (declare (type string string))
 956   ;; FIXME: Why is there this difference between the treatments of the
 957   ;; STREAM argument in WRITE-STRING and WRITE-LINE?
 958   (let ((stream (sb-impl::out-synonym-of stream))
 959         (end (or end (length string))))
 960     (etypecase stream
 961       (simple-stream
 962        (%check-simple-stream stream :output)
 963        (with-stream-class (simple-stream stream)
 964          (funcall-stm-handler-2 j-write-chars string stream start end)
 965          (funcall-stm-handler-2 j-write-char #\Newline stream)))
 966       (ansi-stream
 967        (%ansi-stream-write-string string stream start end)
 968        (funcall (sb-kernel:ansi-stream-out stream) stream #\Newline))
 969       (fundamental-stream
 970        (sb-gray:stream-write-string stream string start end)
 971        (sb-gray:stream-terpri stream))))
 972   string)
 973
 974 (defun write-sequence (seq stream &key (start 0) (end nil))
 975   "Write the elements of SEQ bounded by START and END to STREAM."
 976   (let ((stream (sb-impl::out-synonym-of stream))
 977         (end (or end (length seq))))
 978     (etypecase stream
 979       (simple-stream
 980        (%simple-stream-write-sequence stream seq start end))
 981       (ansi-stream
 982        (%ansi-stream-write-sequence seq stream start end))
 983       (fundamental-stream
 984        (sb-gray:stream-write-sequence stream seq start end)))))
 985
 986 (defun terpri (&optional (stream *standard-output*))
 987   "Outputs a new line to the Stream."
 988   (let ((stream (sb-impl::out-synonym-of stream)))
 989     (etypecase stream
 990       (simple-stream
 991        (%check-simple-stream stream :output)
 992        (with-stream-class (simple-stream stream)
 993          (funcall-stm-handler-2 j-write-char #\Newline stream)))
 994       (ansi-stream
 995        (funcall (sb-kernel:ansi-stream-out stream) stream #\Newline))
 996       (fundamental-stream
 997        (sb-gray:stream-terpri stream))))
 998   nil)
 999
1000 (defun fresh-line (&optional (stream *standard-output*))
1001   "Outputs a new line to the Stream if it is not positioned at the beginning of
1002    a line.  Returns T if it output a new line, nil otherwise."
1003   (let ((stream (sb-impl::out-synonym-of stream)))
1004     (etypecase stream
1005       (simple-stream
1006        (%simple-stream-fresh-line stream))
1007       (ansi-stream
1008        (when (/= (or (sb-kernel:charpos stream) 1) 0)
1009          (funcall (sb-kernel:ansi-stream-out stream) stream #\Newline)
1010          t))
1011       (fundamental-stream
1012        (sb-gray:stream-fresh-line stream)))))
1013
1014 (defun finish-output (&optional (stream *standard-output*))
1015   "Attempts to ensure that all output sent to the Stream has reached its
1016    destination, and only then returns."
1017   (let ((stream (sb-impl::out-synonym-of stream)))
1018     (etypecase stream
1019       (simple-stream
1020        (%simple-stream-finish-output stream))
1021       (ansi-stream
1022        (funcall (sb-kernel:ansi-stream-misc stream) stream :finish-output))
1023       (fundamental-stream
1024        (sb-gray:stream-finish-output stream))))
1025   nil)
1026
1027 (defun force-output (&optional (stream *standard-output*))
1028   "Attempts to force any buffered output to be sent."
1029   (let ((stream (sb-impl::out-synonym-of stream)))
1030     (etypecase stream
1031       (simple-stream
1032        (%simple-stream-force-output stream))
1033       (ansi-stream
1034        (funcall (sb-kernel:ansi-stream-misc stream) stream :force-output))
1035       (fundamental-stream
1036        (sb-gray:stream-force-output stream))))
1037   nil)
1038
1039 (defun clear-output (&optional (stream *standard-output*))
1040   "Clears the given output Stream."
1041   (let ((stream (sb-impl::out-synonym-of stream)))
1042     (etypecase stream
1043       (simple-stream
1044        (%simple-stream-clear-output stream))
1045       (ansi-stream
1046        (funcall (sb-kernel:ansi-stream-misc stream) stream :clear-output))
1047       (fundamental-stream
1048        (sb-gray:stream-clear-output stream))))
1049   nil)
1050
1051
1052 (defun file-position (stream &optional position)
1053   "With one argument returns the current position within the file
1054    File-Stream is open to.  If the second argument is supplied, then
1055    this becomes the new file position.  The second argument may also
1056    be :start or :end for the start and end of the file, respectively."
1057   (declare (type (or (integer 0 *) (member nil :start :end)) position))
1058   (etypecase stream
1059     (simple-stream
1060      (%simple-stream-file-position stream position))
1061     (ansi-stream
1062      (cond
1063        (position
1064         (setf (sb-kernel:ansi-stream-in-index stream)
1065               sb-impl::+ansi-stream-in-buffer-length+)
1066         (funcall (sb-kernel:ansi-stream-misc stream)
1067                  stream :file-position position))
1068        (t
1069         (let ((res (funcall (sb-kernel:ansi-stream-misc stream)
1070                             stream :file-position nil)))
1071           (when res
1072             (- res
1073                (- sb-impl::+ansi-stream-in-buffer-length+
1074                   (sb-kernel:ansi-stream-in-index stream))))))))))
1075
1076 (defun file-length (stream)
1077   "This function returns the length of the file that File-Stream is open to."
1078   (etypecase stream
1079     (simple-stream
1080      (%simple-stream-file-length stream))
1081     (ansi-stream
1082      (progn (sb-impl::stream-must-be-associated-with-file stream)
1083             (funcall (sb-kernel:ansi-stream-misc stream) stream :file-length)))))
1084
1085 (defun charpos (&optional (stream *standard-output*))
1086   "Returns the number of characters on the current line of output of the given
1087   Stream, or Nil if that information is not availible."
1088   (let ((stream (sb-impl::out-synonym-of stream)))
1089     (etypecase stream
1090       (simple-stream
1091        (%check-simple-stream stream :output)
1092        (with-stream-class (simple-stream) (sm charpos stream)))
1093       (ansi-stream
1094        (funcall (sb-kernel:ansi-stream-misc stream) stream :charpos))
1095       (fundamental-stream
1096        (sb-gray:stream-line-column stream)))))
1097
1098 (defun line-length (&optional (stream *standard-output*))
1099   "Returns the number of characters in a line of output of the given
1100   Stream, or Nil if that information is not availible."
1101   (let ((stream (sb-impl::out-synonym-of stream)))
1102     (etypecase stream
1103       (simple-stream
1104        (%check-simple-stream stream :output)
1105        ;; TODO (sat 2003-04-02): a way to specify a line length would
1106        ;; be good, I suppose.  Returning nil here means
1107        ;; sb-pretty::default-line-length is used.
1108        nil)
1109       (ansi-stream
1110        (funcall (sb-kernel:ansi-stream-misc stream) stream :line-length))
1111       (fundamental-stream
1112        (sb-gray:stream-line-length stream)))))
1113
1114 (defun wait-for-input-available (stream &optional timeout)
1115   "Waits for input to become available on the Stream and returns T.  If
1116   Timeout expires, Nil is returned."
1117   (let ((stream (sb-impl::in-synonym-of stream)))
1118     (etypecase stream
1119       (fixnum
1120        (sb-sys:wait-until-fd-usable stream :input timeout))
1121       (simple-stream
1122        (%check-simple-stream stream :input)
1123        (with-stream-class (simple-stream stream)
1124          (or (< (sm buffpos stream) (sm buffer-ptr stream))
1125              (wait-for-input-available (sm input-handle stream) timeout))))
1126       (two-way-stream
1127        (wait-for-input-available (two-way-stream-input-stream stream) timeout))
1128       (synonym-stream
1129        (wait-for-input-available (symbol-value (synonym-stream-symbol stream))
1130                                  timeout))
1131       (sb-sys::file-stream
1132        (or (< (sb-impl::fd-stream-in-index stream)
1133               (length (sb-impl::fd-stream-in-buffer stream)))
1134            (wait-for-input-available (sb-sys:fd-stream-fd stream) timeout))))))
1135
1136 ;; Make PATHNAME and NAMESTRING work
1137 (defun sb-int:file-name (stream &optional new-name)
1138   (typecase stream
1139     (file-simple-stream
1140      (with-stream-class (file-simple-stream stream)
1141        (cond (new-name
1142               (%simple-stream-file-rename stream new-name))
1143              (t
1144               (%simple-stream-file-name stream)))))
1145     (sb-sys::file-stream
1146      (cond (new-name
1147             (setf (sb-impl::fd-stream-pathname stream) new-name)
1148             (setf (sb-impl::fd-stream-file stream)
1149                   (sb-int:unix-namestring new-name nil))
1150             t)
1151            (t
1152             (sb-impl::fd-stream-pathname stream))))))
1153
1154 ;;; bugfix
1155
1156 ;;; TODO: Rudi 2003-01-12: What is this for?  Incorporate into sbcl or
1157 ;;; remove it.
1158 #+nil
1159 (defun cl::stream-misc-dispatch (stream operation &optional arg1 arg2)
1160   (declare (type fundamental-stream stream) ;; this is a lie
1161            (ignore arg2))
1162   (case operation
1163     (:listen
1164      (ext:stream-listen stream))
1165     (:unread
1166      (ext:stream-unread-char stream arg1))
1167     (:close
1168      (close stream))
1169     (:clear-input
1170      (ext:stream-clear-input stream))
1171     (:force-output
1172      (ext:stream-force-output stream))
1173     (:finish-output
1174      (ext:stream-finish-output stream))
1175     (:element-type
1176      (stream-element-type stream))
1177     (:interactive-p
1178      (interactive-stream-p stream))
1179     (:line-length
1180      (ext:stream-line-length stream))
1181     (:charpos
1182      (ext:stream-line-column stream))
1183     (:file-length
1184      (file-length stream))
1185     (:file-position
1186      (file-position stream arg1))))