;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.113
;;; Reason:
;;;  You should be able to have two processes that use a TCP stream, one that reads
;;;  and one that writes.  Unfortunately, the way the socket was handled made this
;;;  work poorly -- the reader might handle a write reply, for example, but the
;;;  writer wouldn't notice the write buffer was available.  This has been fixed.
;;; Written 18-Nov-87 13:18:03 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.113, Experimental Local-File 73.2, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:18:20
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defflavor tcp-stream-mixin
	 ((socket nil)				;The tcp-socket
	  (open nil)				;T if user has issued open
	  (closing nil)				;T if remote side has closed
	  (auto-push nil)			;T if open with auto-push
	  (bytes-read 0)			;total bytes read on this socket
	  (bytes-written 0)			;total bytes written on this socket
	  (timeout nil)				;T if send timed out
	  )
	 ()
  (:method-combination (:daemon-with-or :base-flavor-last :listen))
  (:gettable-instance-variables socket)
  (:inittable-instance-variables socket auto-push)
  )

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:19:42
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :wait-for-reply) (&optional function &rest args)
  (process-wait "TCP socket I/O"
		#'(lambda (tcp-socket func arg-list)
		    (or (send tcp-socket :listen)
			(and func (apply func arg-list))))
		socket function args))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:19:37
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :handle-replies) (&optional no-hang-p)
  (loop
    (cond ((send socket :listen)					;Activity on the socket
	   (let ((item (send socket :read-data)))
	     (case (first item)
	       (:open
		(send self :build-buffers)
		(return :open))
	       (:write-reply
		(incf bytes-written (fill-pointer (second item)))
		(send self :write-reply (second item))
		(return :write-reply))
	       (:data
		(incf bytes-read (fill-pointer (second item)))
		(send self :read-reply (second item))
		(when (eq (third item) :eof)
		  (setq closing t))
		(return :read-reply))
	       (:closing						;Remote side has closed
		(setq closing t)
		(return :remote-close))
	       (:reset
		(setq closing t)
		(setq open nil)
		(dolist (b (third item))
		  (send self :write-reply b))
		;;(cerror "Continue, treating as end-of-file" "Connection reset remotely")
		(return :reset))
	       (:close							;Socket closed out from under us
		(setq closing t)
		(setq open nil)
		;;(cerror "Continue, treating as end-of-file" "Connection reset locally")
		(return :local-close))
	       ((:network-unreachable :host-unreachable :protocol-unreachable :port-unreachable)
		(setq closing t)
		(setq open nil)
		(send socket :abort)
		(return :unreachable))
	       (:timeout
		(setq timeout t)
		(return :timeout))
	       (otherwise
		;;Ignore it
		))))
	  (no-hang-p							;No activity and no-hang
	   (return nil))
	  (t								;No activity -- wait
	   (send self :wait-for-reply)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:19:56
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :next-input-buffer) (&optional no-hang-p)
  (declare (values buffer start end))
  (loop
    (cond ((not (fifo-empty-p input-buffer-fifo))
	   (let ((buffer (pop-fifo input-buffer-fifo)))
	     (return (values buffer 0 (fill-pointer buffer)))))
	  ((send self :handle-all-replies))
	  ((not open)
	   (return nil))
	  (closing
	   (return nil))
	  (no-hang-p
	   (return nil))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (send self :wait-for-reply
		      #'(lambda (b o c to)
			  (or (not (fifo-empty-p (cdr b)))
			      (not (cdr o))
			      (cdr c)
			      (cdr to)))
		      (locf input-buffer-fifo)
		      (locf open)
		      (locf closing)
		      (locf timeout))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:20:00
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :new-output-buffer) ()
  (declare (values buffer start end))
  (loop
    (cond (output-buffer-list
	   (return (values (pop output-buffer-list) 0 output-buffer-size)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (send self :wait-for-reply
		      #'(lambda (x y)
			  (or (cdr x) (cdr y)))
		      (locf output-buffer-list)
		      (locf timeout))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:20:01
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :tyi) (&optional eof)
  (loop
    (cond (untyi-char
	   (return (prog1 untyi-char (setq untyi-char nil))))
	  (tyi-buffer
	   (let* ((buffer tyi-buffer)
		  (byte (aref buffer 0)))
	     (setq tyi-buffer nil)
	     (send socket :receive buffer)
	     (return byte)))
	  ((or closing (not open))
	   (if eof
	       (global:signal 'sys:end-of-file :format-string "End of File on TCP stream")
	     (return nil)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (send self :wait-for-reply
		      #'(lambda (u b o c to)
			  (or (cdr u) (cdr b) (not (cdr o)) (cdr c) (cdr to)))
		      (locf untyi-char)
		      (locf tyi-buffer)
		      (locf open)
		      (locf closing)
		      (locf timeout))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#48 at 18-Nov-87 13:20:03
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :tyo) (byte)
  (loop
    (cond ((not open)
	   (return nil))
	  (tyo-buffer
	   (let ((buffer tyo-buffer))
	     (setq tyo-buffer nil)
	     (setf (aref buffer 0) byte)
	     (setf (fill-pointer buffer) 1)
	     (send socket :write-data buffer)
	     (return t)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (send self :wait-for-reply
		      #'(lambda (b o to)
			  (or (cdr b) (not (cdr o)) (cdr to)))
		      (locf tyo-buffer)
		      (locf open)
		      (locf timeout))))))

))