;;; -*- Mode: Common-Lisp; Package: SYS; Base: 10.; Patch-File: T -*-

;;; Reason: Make-concatenated-stream was not handling the :send-if-handles operation properly. [10586]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for SYSTEM version 6.23
;;; Written 10/25/89 14:06:08 by berger,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.22, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.6, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.5, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.14, TV 6.17, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.7,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.5, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.26, CLEH 6.5, IP 3.54,
;;;  Experimental CLX 6.6, CLUE 6.27, X11M 6.15, Experimental BUG 11.15,  microcode 429,
;;;  Band Name: rel6.0 10/23

#!C
; From file STREAMS.LISP#> KERNEL; SYS:
#10R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; STREAMS.#"


(defun make-concatenated-stream (&rest streams)
  "Return a stream which will read from each of the STREAMS, one by one.
Reading from the concatenated stream will first read data from the first STREAM.
When that reaches eof, it will then read data from the second STREAM,
and so on until all the STREAMS are exhausted.  Then the concatenated stream gets eof."
  (let-closed
    ((concatenated-stream-streams (copy-list streams))
     (which-operations
       (and streams 
	 (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
		     (member op wo2 :test #'eq) do (if copyp
						       (setq wo (copy-list wo)))
		     (setq copyp ()) (setq wo (delete op (the list wo) :test #'eq)))
	       finally (return wo))))
     (concatenated-stream-function nil))
    (setq concatenated-stream-function
	  #'(lambda (op &rest args)
	      (prog ()
		 loop
		    (return
		      (case op
			((:tyi :tyi-no-hang :any-tyi-no-hang :any-tyi)
			 (if (null concatenated-stream-streams)
			     (and (car args)
				  (ferror 'end-of-file-1 "End of file on ~S." concatenated-stream-function))
			     (let ((value (send (car concatenated-stream-streams) :tyi)))
			       (if value
				   value
				   (progn
				     (pop concatenated-stream-streams)
				     (go loop))))))
			(:which-operations which-operations)
			(:send-if-handles
			 (and (member (car args) which-operations :test #'eq)
			      (apply concatenated-stream-function args)))
			(:operation-handled-p
			 (not (null (member (car args) which-operations :test #'eq))))
			(:untyi (send (car concatenated-stream-streams) :untyi (car args)))
			(:direction :input)
			(t
			 ;; ; DAB 10-25-89 If the operation can be handled by stream-default-handler, let it do it.
			 (if (member op '(:tyipeek :listen :any-tyi :tyi-no-hang :any-tyi-no-hang
						   :clear-input :finish :close :eof :fresh-line
						   :line-in :string-in :string-line-in :characters
						   :element-type
						   ))
				     (stream-default-handler concatenated-stream-function op (car args) (cdr args))
				     ;;Else let it be handled by the sub-stream. ; DAB 10-25-89
				     (lexpr-send (car streams) op args))
			 
			 ))))))))
))