[Openmcl-cvs-notifications] r8584 - in /trunk/source/level-1: l1-streams.lisp l1-sysio.lisp
gb at clozure.com
gb at clozure.com
Mon Feb 25 06:18:32 EST 2008
Author: gb
Date: Mon Feb 25 06:18:32 2008
New Revision: 8584
Log:
OPTIMAL-BUFFER-SIZE: factor in element-type, so that we map from
octets to elements correctly. Try to use fd-kind-specific means
to determine I/O chunk size (for output-wait.)
Deprecate use of ELEMENTS-PER-BUFFER options.
Add deadline field to IOBLOCK struct; requires some bootstrapping.
Modified:
trunk/source/level-1/l1-streams.lisp
trunk/source/level-1/l1-sysio.lisp
Modified: trunk/source/level-1/l1-streams.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-streams.lisp (original)
+++ trunk/source/level-1/l1-streams.lisp Mon Feb 25 06:18:32 2008
@@ -3270,8 +3270,19 @@
(:unicode . :unicode)))
=
=
-(defun optimal-buffer-size (fd)
- (or (nth-value 6 (%fstat fd)) *elements-per-buffer*))
+(defun optimal-buffer-size (fd element-type)
+ (let* ((octets (case (%unix-fd-kind fd)
+ (:pipe (#_fpathconf fd #$_PC_PIPE_BUF))
+ (:socket (int-getsockopt fd #$SOL_SOCKET #$SO_SNDLOWAT))
+ ((:character-special :tty) (#_fpathconf fd #$_PC_MAX_IN=
PUT))
+ (t (or (nth-value 6 (%fstat fd)) *elements-per-buffer*)=
))))
+ (case (subtag-bytes (element-type-subtype element-type) 1)
+ (1 octets)
+ (2 (ash octets -1))
+ (4 (ash octets -2))
+ (8 (ash octets -3)))))
+
+ =
=
=
;;; Note that we can get "bivalent" streams by specifiying :character-p t
@@ -3279,7 +3290,6 @@
(defun make-fd-stream (fd &key
(direction :input)
(interactive t)
- (elements-per-buffer (optimal-buffer-size fd))
(element-type 'character)
(class 'fd-stream)
(sharing :private)
@@ -3289,39 +3299,40 @@
encoding
line-termination
auto-close)
- (when line-termination
- (setq line-termination
- (cdr (assoc line-termination *canonical-line-termination-convent=
ions*))))
- (when basic
- (setq class (map-to-basic-stream-class-name class))
- (setq basic (subtypep (find-class class) 'basic-stream)))
- (let* ((in-p (member direction '(:io :input)))
- (out-p (member direction '(:io :output)))
- (class-name (select-stream-class class in-p out-p character-p))
- (class (find-class class-name))
- (stream
- (make-ioblock-stream class
- :insize (if in-p elements-per-buffer)
- :outsize (if out-p elements-per-buffer)
- :device fd
- :interactive interactive
- :element-type element-type
- :advance-function (if in-p
- (select-stream-advance=
-function class direction))
- :listen-function (if in-p 'fd-stream-listen)
- :eofp-function (if in-p 'fd-stream-eofp)
- :force-output-function (if out-p
- (select-stream-fo=
rce-output-function class direction))
- :close-function 'fd-stream-close
- :sharing sharing
- :character-p character-p
- :encoding encoding
- :line-termination line-termination)))
- (if auto-close
- (terminate-when-unreachable stream
- (lambda (stream)
- (close stream :abort t))))
- stream))
+ (let* ((elements-per-buffer (optimal-buffer-size fd element-type)))
+ (when line-termination
+ (setq line-termination
+ (cdr (assoc line-termination *canonical-line-termination-conve=
ntions*))))
+ (when basic
+ (setq class (map-to-basic-stream-class-name class))
+ (setq basic (subtypep (find-class class) 'basic-stream)))
+ (let* ((in-p (member direction '(:io :input)))
+ (out-p (member direction '(:io :output)))
+ (class-name (select-stream-class class in-p out-p character-p))
+ (class (find-class class-name))
+ (stream
+ (make-ioblock-stream class
+ :insize (if in-p elements-per-buffer)
+ :outsize (if out-p elements-per-buffer)
+ :device fd
+ :interactive interactive
+ :element-type element-type
+ :advance-function (if in-p
+ (select-stream-advanc=
e-function class direction))
+ :listen-function (if in-p 'fd-stream-list=
en)
+ :eofp-function (if in-p 'fd-stream-eofp)
+ :force-output-function (if out-p
+ (select-stream-f=
orce-output-function class direction))
+ :close-function 'fd-stream-close
+ :sharing sharing
+ :character-p character-p
+ :encoding encoding
+ :line-termination line-termination)))
+ (if auto-close
+ (terminate-when-unreachable stream
+ (lambda (stream)
+ (close stream :abort t))))
+ stream)))
=
=
;;; Fundamental streams.
@@ -5596,7 +5607,6 @@
(t :create)))
(external-format :default)
(class 'file-stream)
- (elements-per-buffer *elements-per-buffer*)
(sharing :private)
(basic t))
"Return a stream which reads from or writes to FILENAME.
@@ -5615,7 +5625,6 @@
element-type
if-exists
if-does-not-exist
- elements-per-buffer
class
external-format
sharing
Modified: trunk/source/level-1/l1-sysio.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-sysio.lisp (original)
+++ trunk/source/level-1/l1-sysio.lisp Mon Feb 25 06:18:32 2008
@@ -724,12 +724,10 @@
element-type
if-exists
if-does-not-exist
- elements-per-buffer
class
external-format
sharing
basic)
-
(let* ((temp-name nil)
(dir (pathname-directory filename))
(filename (if (eq (car dir) :relative)
@@ -783,7 +781,6 @@
(if (not (eq fd-kind :file))
(make-fd-stream fd :direction direction
:element-type element-type
- :elements-per-buffer elements-per-buffer
:sharing sharing
:basic basic)
(progn
@@ -795,6 +792,7 @@
(io-p (eq direction :io))
(char-p (or (eq element-type 'character)
(subtypep element-type 'character)))
+ (elements-per-buffer (optimal-buffer-size fd elemen=
t-type))
(real-external-format
(if char-p
(normalize-external-format :file external-format)
More information about the Openmcl-cvs-notifications
mailing list