(fd -1 :type fixnum)
;; controls when the output buffer is flushed
(buffering :full :type (member :full :line :none))
+ ;; controls whether the input buffer must be cleared before output
+ ;; (must be done for files, not for sockets, pipes and other data
+ ;; sources where input and output aren't related). non-NIL means
+ ;; don't clear input buffer.
+ (dual-channel-p nil)
;; character position (if known)
(char-pos nil :type (or index null))
;; T if input is waiting on FD. :EOF if we hit EOF.
size))
(flush-output-buffer ,stream-var)))
,(unless (eq (car buffering) :none)
- `(when (> (fd-stream-ibuf-tail ,stream-var)
- (fd-stream-ibuf-head ,stream-var))
+ `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+ (> (fd-stream-ibuf-tail ,stream-var)
+ (fd-stream-ibuf-head ,stream-var)))
(file-position ,stream-var (file-position ,stream-var))))
,(if restart
`(catch 'output-nothing
,size))
(flush-output-buffer ,stream-var)))
,(unless (eq (car buffering) :none)
- `(when (> (fd-stream-ibuf-tail ,stream-var)
- (fd-stream-ibuf-head ,stream-var))
+ `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+ (> (fd-stream-ibuf-tail ,stream-var)
+ (fd-stream-ibuf-head ,stream-var)))
(file-position ,stream-var (file-position ,stream-var))))
,(if restart
`(catch 'output-nothing
(let ((start (or start 0))
(end (or end (length (the (simple-array * (*)) thing)))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail fd-stream)
- (fd-stream-ibuf-head fd-stream))
+ (when (and (not (fd-stream-dual-channel-p fd-stream))
+ (> (fd-stream-ibuf-tail fd-stream)
+ (fd-stream-ibuf-head fd-stream)))
(file-position fd-stream (file-position fd-stream)))
(let* ((len (fd-stream-obuf-length fd-stream))
(tail (fd-stream-obuf-tail fd-stream))
(return-from fd-stream-resync
(funcall (symbol-function (eighth entry)) stream)))))
+;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp
(defmacro define-external-format (external-format size output-restart
out-expr in-expr)
(let* ((name (first external-format))
(let ((start (or start 0))
(end (or end (length string))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail stream)
- (fd-stream-ibuf-head stream))
+ (when (and (not (fd-stream-dual-channel-p stream))
+ (> (fd-stream-ibuf-tail stream)
+ (fd-stream-ibuf-head stream)))
(file-position stream (file-position stream)))
(when (< end start)
(error ":END before :START!"))
(let ((start (or start 0))
(end (or end (length string))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail fd-stream)
- (fd-stream-ibuf-head fd-stream))
+ (when (and (not (fd-stream-dual-channel-p fd-stream))
+ (> (fd-stream-ibuf-tail fd-stream)
+ (fd-stream-ibuf-head fd-stream)))
(file-position fd-stream (file-position fd-stream)))
(when (< end start)
(error ":END before :START!"))
(setf (sap-ref-8 sap tail) bits))
(code-char byte))
-(define-external-format (:ascii :us-ascii :ansi_x3.4-1968)
+(define-external-format (:ascii :us-ascii :ansi_x3.4-1968
+ :iso-646 :iso-646-us :|646|)
1 t
(if (>= bits 128)
(stream-encoding-error-and-handle stream bits)
(when (and character-stream-p
(eq (fd-stream-external-format fd-stream) :default))
+ (/show0 "/getting default external format")
(setf (fd-stream-external-format fd-stream)
- (intern (or (alien-funcall
- (extern-alien "nl_langinfo"
- (function c-string int))
- sb!unix:codeset)
- "LATIN-1")
- "KEYWORD")))
- (dolist (entry *external-formats*
- (setf (fd-stream-external-format fd-stream) :latin-1))
- (when (member (fd-stream-external-format fd-stream) (first entry))
- (return)))
-
+ (default-external-format))
+ (/show0 "cold-printing defaulted external-format:")
+ #!+sb-show
+ (cold-print (fd-stream-external-format fd-stream))
+ (/show0 "matching to known aliases")
+ (dolist (entry *external-formats*
+ (restart-case
+ (error "Invalid external-format ~A"
+ (fd-stream-external-format fd-stream))
+ (use-default ()
+ :report "Set external format to LATIN-1"
+ (setf (fd-stream-external-format fd-stream) :latin-1))))
+ (/show0 "cold printing known aliases:")
+ #!+sb-show
+ (dolist (alias (first entry)) (cold-print alias))
+ (/show0 "done cold-printing known aliases")
+ (when (member (fd-stream-external-format fd-stream) (first entry))
+ (/show0 "matched")
+ (return)))
+ (/show0 "/default external format ok"))
+
(when input-p
(multiple-value-bind (routine type size read-n-characters
normalized-external-format)
(sb!sys:serve-all-events)))
(:element-type
(fd-stream-element-type fd-stream))
+ (:external-format
+ (fd-stream-external-format fd-stream))
(:interactive-p
(= 1 (the (member 0 1)
(sb!unix:unix-isatty (fd-stream-fd fd-stream)))))
(if (zerop mode)
nil
(truncate size (fd-stream-element-size fd-stream)))))
+ ;; FIXME: I doubt this is correct in the presence of Unicode,
+ ;; since fd-stream FILE-POSITION is measured in bytes.
+ (:file-string-length
+ (etypecase arg1
+ (character 1)
+ (string (length arg1))))
(:file-position
(fd-stream-file-position fd-stream arg1))))
delete-original
pathname
input-buffer-p
+ dual-channel-p
(name (if file
(format nil "file ~S" file)
(format nil "descriptor ~W" fd)))
:delete-original delete-original
:pathname pathname
:buffering buffering
+ :dual-channel-p dual-channel-p
:external-format external-format
:timeout timeout)))
(set-fd-stream-routines stream element-type input output input-buffer-p)
:original original
:delete-original delete-original
:pathname pathname
+ :dual-channel-p nil
:input-buffer-p t
:auto-close t))
(:probe
t)
(t
(fd-stream-pathname stream)))))
-\f
-;;;; international character support (which is trivial for our simple
-;;;; character sets)
-
-;;;; (Those who do Lisp only in English might not remember that ANSI
-;;;; requires these functions to be exported from package
-;;;; COMMON-LISP.)
-
-(defun file-string-length (stream object)
- (declare (type (or string character) object) (type fd-stream stream))
- #!+sb-doc
- "Return the delta in STREAM's FILE-POSITION that would be caused by writing
- OBJECT to STREAM. Non-trivial only in implementations that support
- international character sets."
- (declare (ignore stream))
- (etypecase object
- (character 1)
- (string (length object))))
-
-(defun stream-external-format (stream)
- (declare (type fd-stream stream))
- #!+sb-doc
- "Return the actual external format for fd-streams, otherwise :DEFAULT."
- (if (typep stream 'fd-stream)
- (fd-stream-external-format stream)
- :default))
projects / sbcl.git / blobdiff