Changeset 6092


Ignore:
Timestamp:
Mar 28, 2007, 6:41:23 AM (13 years ago)
Author:
gb
Message:

Handle DRIBBLE state per-process and here.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/level-1/l1-processes.lisp

    r5977 r6092  
    136136                         :initarg :allocation-quantum
    137137                         :reader process-allocation-quantum
    138                          :type (satisfies valid-allocation-quantum-p)))
    139  
     138                         :type (satisfies valid-allocation-quantum-p))
     139     (dribble-stream :initform nil)
     140     (dribble-saved-terminal-io :initform nil))
    140141  (:primary-p t))
    141142
     
    185186
    186187
    187 (defglobal *initial-process*
     188(defstatic *initial-process*
    188189    (let* ((p (make-process
    189190               "Initial"
     
    197198  "Bound in each process, to that process itself.")
    198199
    199 (defglobal *interactive-abort-process* *initial-process*)
     200(defstatic *interactive-abort-process* *initial-process*)
    200201
    201202
     
    383384                  (if defenv
    384385                    (eq :global (%cdr (assq s (defenv.specials defenv)))))))
    385       (error "~s not defined with ~s" s 'defglobal))
     386      (error "~s not defined with ~s" s 'defstatic))
    386387    s))
    387388
     
    633634  (when (eq p *current-process*)
    634635    (quit)))
     636
     637(defmethod process-stop-dribbling ((p process))
     638  (with-slots (dribble-stream dribble-saved-terminal-io) p
     639    (when dribble-stream
     640      (close dribble-stream)
     641      (setq dribble-stream nil))
     642    (when dribble-saved-terminal-io
     643      (setq *terminal-io* dribble-saved-terminal-io
     644            dribble-saved-terminal-io nil))))
     645
     646(defmethod process-dribble ((p process) path)
     647  (with-slots (dribble-stream dribble-saved-terminal-io) p
     648    (process-stop-dribbling p)
     649    (when path
     650      (let* ((in (two-way-stream-input-stream *terminal-io*))
     651             (out (two-way-stream-output-stream *terminal-io*))
     652             (f (open path :direction :output :if-exists :append
     653                      :if-does-not-exist :create)))
     654        (without-interrupts
     655         (setq dribble-stream f
     656               dribble-saved-terminal-io *terminal-io*
     657               *terminal-io* (make-echoing-two-way-stream
     658                              (make-echo-stream in f)
     659                              (make-broadcast-stream out f)))))
     660      path)))
Note: See TracChangeset for help on using the changeset viewer.