"List of available buffers. Each buffer is an sap pointing to
bytes-per-buffer of memory.")
+#!+sb-thread
+(defvar *available-buffers-mutex* (sb!thread:make-mutex
+ :name "lock for *AVAILABLE-BUFFERS*")
+ #!+sb-doc
+ "Mutex for access to *AVAILABLE-BUFFERS*.")
+
+(defmacro with-available-buffers-lock ((&optional) &body body)
+ ;; WITHOUT-INTERRUPTS because streams are low-level enough to be
+ ;; async signal safe, and in particular a C-c that brings up the
+ ;; debugger while holding the mutex would lose badly
+ `(without-interrupts
+ (sb!thread:with-mutex (*available-buffers-mutex*)
+ ,@body)))
+
(defconstant bytes-per-buffer (* 4 1024)
#!+sb-doc
"Number of bytes per buffer.")
;;; Return the next available buffer, creating one if necessary.
#!-sb-fluid (declaim (inline next-available-buffer))
(defun next-available-buffer ()
- (if *available-buffers*
- (pop *available-buffers*)
- (allocate-system-memory bytes-per-buffer)))
+ (with-available-buffers-lock ()
+ (if *available-buffers*
+ (pop *available-buffers*)
+ (allocate-system-memory bytes-per-buffer))))
\f
;;;; the FD-STREAM structure
(simple-stream-perror "couldn't write to ~S" stream errno)))
((eql count length) ; Hot damn, it worked.
(when reuse-sap
- (push base *available-buffers*)))
+ (with-available-buffers-lock ()
+ (push base *available-buffers*))))
((not (null count)) ; sorta worked..
(push (list base
(the index (+ start count))
,resync-function)
*external-formats*)))))
-(define-external-format (:latin-1 :latin1 :iso-8859-1)
+;;; Multiple names for the :ISO{,-}8859-* families are needed because on
+;;; FreeBSD (and maybe other BSD systems), nl_langinfo("LATIN-1") will
+;;; return "ISO8859-1" instead of "ISO-8859-1".
+(define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1)
1 t
(if (>= bits 256)
(stream-encoding-error-and-handle stream bits)
(latin-9-reverse-2 (make-array 16
:element-type '(unsigned-byte 8)
:initial-contents '(#xa6 #xa8 #xbc #xbd 0 0 0 0 #xbe 0 0 0 #xa4 #xb4 #xb8 0))))
- (define-external-format (:latin-9 :latin9 :iso-8859-15)
+ (define-external-format (:latin-9 :latin9 :iso-8859-15 :iso8859-15)
1 t
(setf (sap-ref-8 sap tail)
(if (< bits 256)
;; drop buffers when direction changes
(when (and (fd-stream-obuf-sap fd-stream) (not output-p))
- (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-obuf-sap fd-stream) nil))
+ (with-available-buffers-lock ()
+ (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-obuf-sap fd-stream) nil)))
(when (and (fd-stream-ibuf-sap fd-stream) (not input-p))
- (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-ibuf-sap fd-stream) nil))
+ (with-available-buffers-lock ()
+ (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-ibuf-sap fd-stream) nil)))
(when input-p
(setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
(setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
(when (and character-stream-p
(eq external-format :default))
(/show0 "/getting default external format")
- (setf external-format (default-external-format))
- (/show0 "cold-printing defaulted external-format:")
- #!+sb-show
- (cold-print external-format)
- (/show0 "matching to known aliases")
- (dolist (entry *external-formats*
- (restart-case
- (error "Invalid external-format ~A"
- external-format)
- (use-default ()
- :report "Set external format to LATIN-1"
- (setf external-format :latin-1))))
- (/show0 "cold printing known aliases:")
- #!+sb-show
- (dolist (alias (first entry)) (cold-print alias))
- (/show0 "done cold-printing known aliases")
- (when (member external-format (first entry))
- (/show0 "matched")
- (return)))
- (/show0 "/default external format ok"))
+ (setf external-format (default-external-format)))
(when input-p
(when (or (not character-stream-p) bivalent-stream-p)
(cancel-finalization fd-stream))
(sb!unix:unix-close (fd-stream-fd fd-stream))
(when (fd-stream-obuf-sap fd-stream)
- (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-obuf-sap fd-stream) nil))
+ (with-available-buffers-lock ()
+ (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-obuf-sap fd-stream) nil)))
(when (fd-stream-ibuf-sap fd-stream)
- (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-ibuf-sap fd-stream) nil))
+ (with-available-buffers-lock ()
+ (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-ibuf-sap fd-stream) nil)))
(sb!impl::set-closed-flame fd-stream))
(:clear-input
(setf (fd-stream-unread fd-stream) nil)
;;; This is called whenever a saved core is restarted.
(defun stream-reinit ()
(setf *available-buffers* nil)
- (setf *stdin*
- (make-fd-stream 0 :name "standard input" :input t :buffering :line))
- (setf *stdout*
- (make-fd-stream 1 :name "standard output" :output t :buffering :line))
- (setf *stderr*
- (make-fd-stream 2 :name "standard error" :output t :buffering :line))
- (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
- (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
- (if tty
- (setf *tty*
- (make-fd-stream tty
- :name "the terminal"
- :input t
- :output t
- :buffering :line
- :auto-close t))
- (setf *tty* (make-two-way-stream *stdin* *stdout*))))
+ (with-output-to-string (*error-output*)
+ (setf *stdin*
+ (make-fd-stream 0 :name "standard input" :input t :buffering :line))
+ (setf *stdout*
+ (make-fd-stream 1 :name "standard output" :output t :buffering :line))
+ (setf *stderr*
+ (make-fd-stream 2 :name "standard error" :output t :buffering :line))
+ (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
+ (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
+ (if tty
+ (setf *tty*
+ (make-fd-stream tty
+ :name "the terminal"
+ :input t
+ :output t
+ :buffering :line
+ :auto-close t))
+ (setf *tty* (make-two-way-stream *stdin* *stdout*))))
+ (princ (get-output-stream-string *error-output*) *stderr*))
(values))
\f
;;;; miscellany
projects / sbcl.git / blobdiff