src/code/ansi-stream.lisp

   1 ;;;; the abstract class ANSI-STREAM
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!IMPL")
  13 \f
  14 ;;; HOW THE ANSI-STREAM STRUCTURE IS USED
  15 ;;;
  16 ;;; Many of the slots of the ANSI-STREAM structure contain functions
  17 ;;; which are called to perform some operation on the stream. Closed
  18 ;;; streams have #'CLOSED-FLAME in all of their function slots. If
  19 ;;; one side of an I/O or echo stream is closed, the whole stream is
  20 ;;; considered closed. The functions in the operation slots take
  21 ;;; arguments as follows:
  22 ;;;
  23 ;;; In:                 Stream, Eof-Errorp, Eof-Value
  24 ;;; Bin:                Stream, Eof-Errorp, Eof-Value
  25 ;;; N-Bin:              Stream, Buffer, Start, Numbytes, Eof-Errorp
  26 ;;; Out:                Stream, Character
  27 ;;; Bout:               Stream, Integer
  28 ;;; Sout:               Stream, String, Start, End
  29 ;;; Misc:               Stream, Operation, &Optional Arg1, Arg2
  30 ;;;
  31 ;;; In order to save space, some of the less common stream operations
  32 ;;; are handled by just one function, the MISC method. This function
  33 ;;; is passed a keyword which indicates the operation to perform.
  34 ;;; The following keywords are used:
  35 ;;;  :listen            - Return the following values:
  36 ;;;                          t if any input waiting.
  37 ;;;                          :eof if at eof.
  38 ;;;                          nil if no input is available and not at eof.
  39 ;;;  :unread            - Unread the character Arg.
  40 ;;;  :close             - Do any stream specific stuff to close the stream.
  41 ;;;                       The methods are set to closed-flame by the close
  42 ;;;                       function, so that need not be done by this
  43 ;;;                       function.
  44 ;;;  :clear-input       - Clear any unread input
  45 ;;;  :finish-output,
  46 ;;;  :force-output      - Cause output to happen
  47 ;;;  :clear-output      - Clear any undone output
  48 ;;;  :element-type      - Return the type of element the stream deals with.
  49 ;;;  :line-length       - Return the length of a line of output.
  50 ;;;  :charpos           - Return current output position on the line.
  51 ;;;  :file-length       - Return the file length of a file stream.
  52 ;;;  :file-position     - Return or change the current position of a
  53 ;;;                       file stream.
  54 ;;;  :file-name         - Return the name of an associated file.
  55 ;;;  :interactive-p     - Is this an interactive device?
  56 ;;;
  57 ;;; In order to do almost anything useful, it is necessary to
  58 ;;; define a new type of structure that includes stream, so that the
  59 ;;; stream can have some state information.
  60 ;;;
  61 ;;; THE STREAM IN-BUFFER:
  62 ;;;
  63 ;;; The IN-BUFFER in the stream holds characters or bytes that
  64 ;;; are ready to be read by some input function. If there is any
  65 ;;; stuff in the IN-BUFFER, then the reading function can use it
  66 ;;; without calling any stream method. Any stream may put stuff in
  67 ;;; the IN-BUFFER, and may also assume that any input in the IN-BUFFER
  68 ;;; has been consumed before any in-method is called. If a text
  69 ;;; stream has in IN-BUFFER, then the first character should not be
  70 ;;; used to buffer normal input so that it is free for unreading into.
  71 ;;;
  72 ;;; When the ANSI-STREAM-IN-BUFFER slot, and its index, is only
  73 ;;; accessed by the normal stream functions, the number of function
  74 ;;; calls is halved, thus potentially doubling the speed of simple
  75 ;;; operations. If the FAST-READ-CHAR and FAST-READ-BYTE macros are
  76 ;;; used, nearly all function call overhead is removed, vastly
  77 ;;; speeding up these important operations.
  78 \f
  79 ;;; the size of a stream in-buffer
  80 ;;;
  81 ;;; KLUDGE: The EVAL-WHEN wrapper isn't needed except when using CMU
  82 ;;; CL as a cross-compilation host. Without it, cmucl-2.4.19 issues
  83 ;;; full WARNINGs (not just STYLE-WARNINGs!) when processing this
  84 ;;; file, and when processing other files which use ANSI-STREAM.
  85 ;;; -- WHN 2000-12-13
  86 (eval-when (:compile-toplevel :load-toplevel :execute)
  87   (defconstant +ansi-stream-in-buffer-length+ 512))
  88
  89 (deftype ansi-stream-in-buffer ()
  90   `(simple-array (unsigned-byte 8) (,+ansi-stream-in-buffer-length+)))
  91
  92 (deftype ansi-stream-cin-buffer ()
  93   `(simple-array character (,+ansi-stream-in-buffer-length+)))
  94
  95 ;;; base class for ANSI standard streams (as opposed to the Gray
  96 ;;; streams extension)
  97 (defstruct (ansi-stream (:constructor nil)
  98                         (:copier nil))
  99
 100   ;; input buffer
 101   ;;
 102   ;; (If a stream does not have an input buffer, then the IN-BUFFER
 103   ;; slot must must be NIL, and the IN-INDEX must be
 104   ;; +ANSI-STREAM-IN-BUFFER-LENGTH+.)
 105   (in-buffer nil :type (or ansi-stream-in-buffer null))
 106   (cin-buffer nil :type (or ansi-stream-cin-buffer null))
 107   (in-index +ansi-stream-in-buffer-length+
 108             :type (integer 0 #.+ansi-stream-in-buffer-length+))
 109
 110   ;; buffered input functions
 111   (in #'ill-in :type function)                  ; READ-CHAR function
 112   (bin #'ill-bin :type function)                ; byte input function
 113   ;; 'n-bin' might not transfer bytes to the consumer.
 114   ;; A character FD-STREAM uses this method to transfer octets from the
 115   ;; source buffer into characters of the destination buffer.
 116   (n-bin #'ill-bin :type function)              ; n-byte input function
 117
 118   ;; output functions
 119   (out #'ill-out :type function)                ; WRITE-CHAR function
 120   (bout #'ill-bout :type function)              ; byte output function
 121   (sout #'ill-out :type function)               ; string output function
 122
 123   ;; other, less-used methods
 124   (misc #'no-op-placeholder :type function)
 125
 126   ;; Absolute character position, acting also as a generalized boolean
 127   ;; in lieu of testing FORM-TRACKING-STREAM-P to see if we must
 128   ;; maintain correctness of the slot in ANSI-STREAM-UNREAD-CHAR.
 129   (input-char-pos nil))
 130
 131 (def!method print-object ((x ansi-stream) stream)
 132   (print-unreadable-object (x stream :type t :identity t)))
 133
 134 (defmacro with-standard-io-syntax (&body body)
 135   #!+sb-doc
 136   "Bind the reader and printer control variables to values that enable READ
 137    to reliably read the results of PRINT. These values are:
 138
 139          *PACKAGE*                        the COMMON-LISP-USER package
 140          *PRINT-ARRAY*                    T
 141          *PRINT-BASE*                     10
 142          *PRINT-CASE*                     :UPCASE
 143          *PRINT-CIRCLE*                   NIL
 144          *PRINT-ESCAPE*                   T
 145          *PRINT-GENSYM*                   T
 146          *PRINT-LENGTH*                   NIL
 147          *PRINT-LEVEL*                    NIL
 148          *PRINT-LINES*                    NIL
 149          *PRINT-MISER-WIDTH*              NIL
 150          *PRINT-PPRINT-DISPATCH*          the standard pprint dispatch table
 151          *PRINT-PRETTY*                   NIL
 152          *PRINT-RADIX*                    NIL
 153          *PRINT-READABLY*                 T
 154          *PRINT-RIGHT-MARGIN*             NIL
 155          *READ-BASE*                      10
 156          *READ-DEFAULT-FLOAT-FORMAT*      SINGLE-FLOAT
 157          *READ-EVAL*                      T
 158          *READ-SUPPRESS*                  NIL
 159          *READTABLE*                      the standard readtable
 160   SB-EXT:*SUPPRESS-PRINT-ERRORS*          NIL
 161 "
 162   (let ((name (make-symbol "THUNK")))
 163     `(dx-flet ((,name () ,@body))
 164        (%with-standard-io-syntax #',name))))