Changeset 8584


Ignore:
Timestamp:
Feb 25, 2008, 11:18:32 AM (12 years ago)
Author:
gb
Message:

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.

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-streams.lisp

    r8537 r8584  
    32753275
    32763276
    3277 (defun optimal-buffer-size (fd)
    3278   (or (nth-value 6 (%fstat fd)) *elements-per-buffer*))
     3277(defun optimal-buffer-size (fd element-type)
     3278  (let* ((octets (case (%unix-fd-kind fd)
     3279                   (:pipe (#_fpathconf fd #$_PC_PIPE_BUF))
     3280                   (:socket (int-getsockopt fd #$SOL_SOCKET #$SO_SNDLOWAT))
     3281                   ((:character-special :tty) (#_fpathconf fd #$_PC_MAX_INPUT))
     3282                   (t (or (nth-value 6 (%fstat fd)) *elements-per-buffer*)))))
     3283    (case (subtag-bytes (element-type-subtype element-type) 1)
     3284      (1 octets)
     3285      (2 (ash octets -1))
     3286      (4 (ash octets -2))
     3287      (8 (ash octets -3)))))
     3288
     3289   
    32793290
    32803291
     
    32843295                          (direction :input)
    32853296                          (interactive t)
    3286                           (elements-per-buffer (optimal-buffer-size fd))
    32873297                          (element-type 'character)
    32883298                          (class 'fd-stream)
     
    32943304                          line-termination
    32953305                          auto-close)
    3296   (when line-termination
    3297     (setq line-termination
    3298           (cdr (assoc line-termination *canonical-line-termination-conventions*))))
    3299   (when basic
    3300     (setq class (map-to-basic-stream-class-name class))
    3301     (setq basic (subtypep (find-class class) 'basic-stream)))
    3302   (let* ((in-p (member direction '(:io :input)))
    3303          (out-p (member direction '(:io :output)))
    3304          (class-name (select-stream-class class in-p out-p character-p))
    3305          (class (find-class class-name))
    3306          (stream
    3307           (make-ioblock-stream class
    3308                                :insize (if in-p elements-per-buffer)
    3309                                :outsize (if out-p elements-per-buffer)
    3310                                :device fd
    3311                                :interactive interactive
    3312                                :element-type element-type
    3313                                :advance-function (if in-p
    3314                                                     (select-stream-advance-function class direction))
    3315                                :listen-function (if in-p 'fd-stream-listen)
    3316                                :eofp-function (if in-p 'fd-stream-eofp)
    3317                                :force-output-function (if out-p
    3318                                                          (select-stream-force-output-function class direction))
    3319                                :close-function 'fd-stream-close
    3320                                :sharing sharing
    3321                                :character-p character-p
    3322                                :encoding encoding
    3323                                :line-termination line-termination)))
    3324     (if auto-close
    3325        (terminate-when-unreachable stream
    3326                                    (lambda (stream)
    3327                                      (close stream :abort t))))
    3328     stream))
     3306  (let* ((elements-per-buffer (optimal-buffer-size fd element-type)))
     3307    (when line-termination
     3308      (setq line-termination
     3309            (cdr (assoc line-termination *canonical-line-termination-conventions*))))
     3310    (when basic
     3311      (setq class (map-to-basic-stream-class-name class))
     3312      (setq basic (subtypep (find-class class) 'basic-stream)))
     3313    (let* ((in-p (member direction '(:io :input)))
     3314           (out-p (member direction '(:io :output)))
     3315           (class-name (select-stream-class class in-p out-p character-p))
     3316           (class (find-class class-name))
     3317           (stream
     3318            (make-ioblock-stream class
     3319                                 :insize (if in-p elements-per-buffer)
     3320                                 :outsize (if out-p elements-per-buffer)
     3321                                 :device fd
     3322                                 :interactive interactive
     3323                                 :element-type element-type
     3324                                 :advance-function (if in-p
     3325                                                     (select-stream-advance-function class direction))
     3326                                 :listen-function (if in-p 'fd-stream-listen)
     3327                                 :eofp-function (if in-p 'fd-stream-eofp)
     3328                                 :force-output-function (if out-p
     3329                                                          (select-stream-force-output-function class direction))
     3330                                 :close-function 'fd-stream-close
     3331                                 :sharing sharing
     3332                                 :character-p character-p
     3333                                 :encoding encoding
     3334                                 :line-termination line-termination)))
     3335      (if auto-close
     3336        (terminate-when-unreachable stream
     3337                                    (lambda (stream)
     3338                                      (close stream :abort t))))
     3339      stream)))
    33293340
    33303341 
     
    56065617                      (external-format :default)
    56075618                      (class 'file-stream)
    5608                       (elements-per-buffer *elements-per-buffer*)
    56095619                      (sharing :private)
    56105620                      (basic t))
     
    56255635                          if-exists
    56265636                          if-does-not-exist
    5627                           elements-per-buffer
    56285637                          class
    56295638                          external-format
  • trunk/source/level-1/l1-sysio.lisp

    r8237 r8584  
    726726                         if-exists
    727727                         if-does-not-exist
    728                          elements-per-buffer
    729728                         class
    730729                         external-format
    731730                         sharing
    732731                         basic)
    733 
    734732  (let* ((temp-name nil)
    735733         (dir (pathname-directory filename))
     
    785783              (make-fd-stream fd :direction direction
    786784                              :element-type element-type
    787                               :elements-per-buffer elements-per-buffer
    788785                              :sharing sharing
    789786                              :basic basic)
     
    797794                       (char-p (or (eq element-type 'character)
    798795                                   (subtypep element-type 'character)))
     796                       (elements-per-buffer (optimal-buffer-size fd element-type))
    799797                       (real-external-format
    800798                        (if char-p
Note: See TracChangeset for help on using the changeset viewer.