Changeset 4890 for trunk


Ignore:
Timestamp:
Jul 20, 2006, 9:43:40 AM (15 years ago)
Author:
gb
Message:

First (rough) cut at making streams "private" (effectively always locked by the
"owning" thread) to reduce some locking overhead. More to come, some of which
will be a little tricky to bootstrap.

Location:
trunk/ccl/level-1
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-boot-2.lisp

    r3972 r4890  
    8383(def-ccl-pointers fd-streams ()
    8484  (setq *stdin* (make-fd-stream 0
     85                                :private nil
    8586                                :direction :input
    8687                                :interactive (not *batch-flag*)))
    87   (setq *stdout* (make-fd-stream 1 :direction :output))
    88 
    89   (setq *stderr* (make-fd-stream 2 :direction :output))
     88  (setq *stdout* (make-fd-stream 1 :direction :output :private nil))
     89
     90  (setq *stderr* (make-fd-stream 2 :direction :output :private nil))
    9091  (if *batch-flag*
    9192    (let* ((tty-fd (let* ((fd (fd-open "/dev/tty" #$O_RDWR)))
     
    9697         *terminal-input* (make-fd-stream tty-fd
    9798                                          :direction :input
    98                                           :interactive t)
    99          *terminal-output* (make-fd-stream tty-fd :direction :output)
     99                                          :interactive t
     100                                          :private nil)
     101         *terminal-output* (make-fd-stream tty-fd :direction :output :private nil)
    100102         *terminal-io* (make-echoing-two-way-stream
    101103                        *terminal-input* *terminal-output*))
  • trunk/ccl/level-1/l1-sockets.lisp

    r4857 r4890  
    569569                    keepalive reuse-address nodelay broadcast linger
    570570                    local-port local-host backlog class out-of-band-inline
    571                     local-filename remote-filename)
     571                    local-filename remote-filename private)
    572572  "Create and return a new socket."
    573573  (declare (dynamic-extent keys))
     
    575575                   keepalive reuse-address nodelay broadcast linger
    576576                   local-port local-host backlog class out-of-band-inline
    577                    local-filename remote-filename))
     577                   local-filename remote-filename private))
    578578  (ecase address-family
    579579    ((:file) (apply #'make-file-socket keys))
     
    666666
    667667
    668 (defun make-tcp-stream (fd &key format eol (class 'tcp-stream) &allow-other-keys)
     668(defun make-tcp-stream (fd &key format eol (class 'tcp-stream) private &allow-other-keys)
    669669  (declare (ignore eol))                ;???
    670670  (let ((element-type (ecase format
     
    676676                    :class class
    677677                    :direction :io
    678                     :element-type element-type)))
    679 
    680 (defun make-file-socket-stream (fd &key format eol (class 'file-socket-stream)  &allow-other-keys)
     678                    :element-type element-type
     679                    :private private)))
     680
     681(defun make-file-socket-stream (fd &key format eol (class 'file-socket-stream)  private &allow-other-keys)
    681682  (declare (ignore eol))                ;???
    682683  (let ((element-type (ecase format
     
    688689                    :class class
    689690                    :direction :io
    690                     :element-type element-type)))
     691                    :element-type element-type
     692                    :private private)))
    691693
    692694(defun make-tcp-listener-socket (fd &rest keys &key backlog &allow-other-keys)
  • trunk/ccl/level-1/l1-streams.lisp

    r4885 r4890  
    386386    ,@body))
    387387
    388 ; ioblock must really be an ioblock or you will crash
     388;;; ioblock must really be an ioblock or you will crash
     389;;; Also: the expression "ioblock" is evaluated multiple times.
     390
     391(declaim (inline check-ioblock-owner))
     392(defun check-ioblock-owner (ioblock)
     393  (let* ((owner (ioblock-owner ioblock)))
     394    (if owner
     395      (or (eq owner *current-process*)
     396          (error "Stream ~s is private to ~s" (ioblock-stream ioblock) owner)))))
     397
    389398(defmacro with-ioblock-input-locked ((ioblock) &body body)
    390   `(with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
    391                                    (ioblock-inbuf-lock ,ioblock)))
    392      ,@body))
     399  `(if (check-ioblock-owner ,ioblock)
     400    (progn ,@body)
     401    (with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
     402                                  (ioblock-inbuf-lock ,ioblock)))
     403      ,@body)))
     404
    393405(defmacro with-ioblock-output-locked ((ioblock) &body body)
    394   `(with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
    395                                    (ioblock-outbuf-lock ,ioblock)))
    396      ,@body))
     406  `(if (check-ioblock-owner ,ioblock)
     407    (progn ,@body)
     408    (with-ioblock-lock-grabbed ((locally (declare (optimize (speed 3) (safety 0)))
     409                                  (ioblock-outbuf-lock ,ioblock)))
     410      ,@body)))
    397411
    398412(defmacro with-ioblock-output-locked-maybe ((ioblock) &body body)
    399   `(with-ioblock-lock-grabbed-maybe ((locally (declare (optimize (speed 3) (safety 0)))
    400                                        (ioblock-outbuf-lock ,ioblock)))
    401      ,@body))
     413  `(if (check-ioblock-owner ,ioblock)
     414    (progn ,@body)
     415    (with-ioblock-lock-grabbed-maybe ((locally (declare (optimize (speed 3) (safety 0)))
     416                                        (ioblock-outbuf-lock ,ioblock)))
     417      ,@body)))
    402418
    403419(defun %ioblock-advance (ioblock read-p)
     
    887903                            element-shift
    888904                            interactive
     905                            private
    889906                            &allow-other-keys)
    890907  (declare (ignorable element-shift))
     
    894911                          ioblock))
    895912                      (stream-create-ioblock stream))))
     913    (when private
     914      (setf (ioblock-owner ioblock) *current-process*))
    896915    (when insize
    897916      (unless (ioblock-inbuf ioblock)
     
    903922                                :size in-size-in-octets
    904923                                :limit insize))
    905           (setf (ioblock-inbuf-lock ioblock) (make-lock))
     924          (unless private
     925            (setf (ioblock-inbuf-lock ioblock) (make-lock)))
    906926          (setf (ioblock-element-shift ioblock) (max 0 (ceiling (log  (/ in-size-in-octets insize) 2))))
    907927          )))
     
    924944                                  :limit outsize
    925945                                  :size out-size-in-octets))
    926             (setf (ioblock-outbuf-lock ioblock) (make-lock))
     946            (unless private
     947              (setf (ioblock-outbuf-lock ioblock) (make-lock)))
    927948            (setf (ioblock-element-shift ioblock) (max 0 (ceiling (log (/ out-size-in-octets outsize) 2))))
    928949            ))))
     
    9801001                          (elements-per-buffer *elements-per-buffer*)
    9811002                          (element-type 'character)
    982                           (class 'fd-stream))
     1003                          (class 'fd-stream)
     1004                          (private t))
    9831005  (let* ((in-p (member direction '(:io :input)))
    9841006         (out-p (member direction '(:io :output)))
     
    9981020                         :force-output-function (if out-p
    9991021                                                  (select-stream-force-output-function class))
    1000                          :close-function 'fd-stream-close)))
     1022                         :close-function 'fd-stream-close
     1023                         :private private)))
    10011024 
    10021025;;;  Fundamental streams.
     
    18001823  (declare (dynamic-extent args))
    18011824  (apply #'make-ioblock :stream stream args))
     1825
     1826(defmethod stream-owner ((stream stream))
     1827  )
     1828
     1829(defmethod stream-owner ((stream buffered-stream-mixin))
     1830  (let* ((ioblock (stream-ioblock stream nil)))
     1831    (and ioblock (ioblock-owner ioblock))))
     1832
    18021833
    18031834(defclass buffered-input-stream-mixin
     
    24632494                      (external-format :default)
    24642495                      (class *default-file-stream-class*)
    2465                       (elements-per-buffer *elements-per-buffer*))
     2496                      (elements-per-buffer *elements-per-buffer*)
     2497                      (private t))
    24662498  "Return a stream which reads from or writes to FILENAME.
    24672499  Defined keywords:
     
    24822514                          elements-per-buffer
    24832515                          class
    2484                           external-format))
     2516                          external-format
     2517                          private))
    24852518      (retry-open ()
    24862519                  :report (lambda (stream) (format stream "Retry opening ~s" filename))
  • trunk/ccl/level-1/l1-sysio.lisp

    r2500 r4890  
    508508                         elements-per-buffer
    509509                         class
    510                          external-format)
     510                         external-format
     511                         private)
    511512
    512513  (let* ((temp-name nil)
     
    544545                   (setq native-truename (%create-file filename)))
    545546                  ((memq direction '(:output :io))
    546                    #|                   ;
    547                                         ; this prevents us from writing a file that is open for anything           
    548                                         ; but does not protect against reading a file that is open for :output
     547                   #| ;;
     548                   ;; this prevents us from writing a file that is open for anything           
     549                   ;;l but does not protect against reading a file that is open for :output
    549550                   (when (and bits (eq direction :output)(neq 0 (logand bits #x81)))
    550551                   (signal-file-error EBUSY filename))
     
    568569              (make-fd-stream fd :direction direction
    569570                              :element-type element-type
    570                               :elements-per-buffer elements-per-buffer)
     571                              :elements-per-buffer elements-per-buffer
     572                              :private private)
    571573              (let* ((in-p (member direction '(:io :input)))
    572574                     (out-p (member direction '(:io :output)))
     
    611613                                   'output-file-force-output))
    612614                               :device fd
    613                                :external-format real-external-format))
     615                               :external-format real-external-format
     616                               :private private))
    614617                     (ioblock (stream-ioblock fstream)))
    615618                (setf (stream-filename fstream) (namestring pathname)
Note: See TracChangeset for help on using the changeset viewer.