;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.117
;;; Reason:
;;;  Bug in (make-broadcast-stream):  If you send a broadcast stream a
;;;  :send-if-handles <xx> operation, each stream receives a
;;;  :send-if-handles :send-if-handles <xx> message.
;;; Written 28-Jun-88 16:16:41 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.112, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1761, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.IO; QIO.LISP#237 at 28-Jun-88 16:17:24
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; QIO  "

(defun make-broadcast-stream (&rest streams)
  "Return an I//O stream which passes all operations to all of the STREAMS.
Thus, output directed to the broadcast stream will go to multiple places."
  (if (null streams) 'null-stream
    (let-closed ((broadcast-stream-streams (copylist streams))
		 (which-operations (loop with wo = (send (car streams) :which-operations)
					 with copyp = t
					 for stream in (cdr streams)
					 do (loop with wo2 = (send stream :which-operations)
						  for op in wo
						  unless (memq op wo2)
						    do (if copyp (setq wo (copylist wo)))
						       (setq copyp nil)
						       (setq wo (delq op wo)))
					 finally (return wo))))
      (function (lambda (&rest args)
		  (cond ((eq (car args) :which-operations) which-operations)
			((eq (car args) :operation-handled-p)
			 (memq (cadr args) which-operations))
			((eq (car args) :send-if-handles)
			 (do ((l broadcast-stream-streams (cdr l)))
			     ((null (cdr l))	;Last one gets to return multiple values
			      (lexpr-send (car l) :send-if-handles (cdr args)))
			   (lexpr-send (car l) :send-if-handles (cdr args))))
			(t
			 (do ((l broadcast-stream-streams (cdr l)))
			     ((null (cdr l))	;Last one gets to return multiple values
			      (apply (car l) args))
			   (apply (car l) args)))))))))

))