;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.233
;;; Reason:
;;;  When the semantics of a TCP socket were changed such that (:close NIL) meant
;;;  :discard rather than :normal, (tcp:tcp-test) should have changed too.  Also,
;;;  print sockets in order 0 --> N rather than reverse.
;;; Written 13-Apr-88 12:28:51 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 1
;;; with Experimental System 123.232, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.USER; TCP-TEST.LISP#52 at 13-Apr-88 12:28:57
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; TCP-TEST  "


(defun handle-sockets (send-list receive-list print-statistics-p loopback-p
		       &aux (socket-fifo (make-fifo)) socket-list opens-out)
  (declare (special total-sends send-size sends-out receive-size receives-out check-data-p))
  (declare (special socket-list))
  ;;Build a fifo containing one copy of each socket
  (dolist (socket send-list)
    (move-to-end-of-fifo socket socket-fifo))
  (dolist (socket receive-list)
    (move-to-end-of-fifo socket socket-fifo))
  (setq opens-out (length (fifo-as-list socket-fifo)))
  (setq socket-list (nreverse (mapcar #'(lambda (x) (cons x (make-socket-statistics)))
				      (fifo-as-list socket-fifo))))
  (unwind-protect
      (do ()
	  ((fifo-empty-p socket-fifo))
	(let ((socket nil)			;The socket we are currently looking at
	      (elt nil))			;The read-data element
	  (process-wait "Data"
			#'(lambda () (or socket
					 (setq socket
					       (multiple-connection-listen (fifo-as-list socket-fifo))))))
	  ;;Found a socket; look at another one first next time
	  (move-to-end-of-fifo socket socket-fifo)
	  (setq elt (send socket :read-data))
	  (case (first elt)
	    (:open
	     (handle-open-reply socket)
	     (decf opens-out)
	     (when (zerop opens-out)
	       (startup-io receive-list send-list)))
	    (:data
	     (handle-read-reply socket elt))
	    (:write-reply
	     (handle-write-reply socket elt))
	    (:closing
	     (handle-closing socket elt)
	     (unless (member socket send-list)
	       (send socket :close :normal)))
	    ((:reset :closed)
	     (let ((stats (cdr (assoc socket socket-list :test #'eq)))
		   (now (zl:time)))
	       (unless (ss-open-reply-time stats)
		 (setf (ss-open-reply-time stats) now))
	       (setf (ss-close-reply-time stats) now)
	       (remove-from-fifo socket socket-fifo)))
	    (:timeout
	     (if loopback-p
		 (send socket :reset-timeout)
	       (let ((stats (cdr (assoc socket socket-list :test #'eq)))
		     (now (zl:time)))
		 (cond ((ss-open-reply-time stats)
			(setf (ss-closed stats) t)
			(send socket :abort))
		       (t
			(setf (ss-open-reply-time stats) now)
			(setf (ss-close-reply-time stats) now)
			(remove-from-fifo socket socket-fifo)
			(decf opens-out)
			(when (zerop opens-out)
			  (startup-io receive-list send-list))))))))))
    (multiple-connection-kill-gauges (mapcar #'car socket-list))
    (let ((now (zl:time)))
      (dolist (socket (fifo-as-list socket-fifo))
	(let ((stats (cdr (assoc socket socket-list :test #'eq))))
	  (unless (ss-open-reply-time stats)
	    (setf (ss-open-reply-time stats) now))
	  (setf (ss-close-reply-time stats) now)
	  (send socket :abort))))
    (when print-statistics-p
      (print-statistics socket-list)))
  socket-list)

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; TCP-TEST.LISP#52 at 13-Apr-88 12:29:01
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; TCP-TEST  "


(defun handle-write-reply (socket elt)
  (declare (special total-sends send-size sends-out receive-size receives-out check-data-p))
  (declare (special socket-list))
  (let* ((stats (cdr (assoc socket socket-list :test #'eq)))
	 (buffer (second elt))
	 (count (1+ (ss-total-sends stats))))
    (decf (ss-sends-out stats))
    (incf (ss-total-sends stats))
    (incf (ss-total-bytes-sent stats) (length buffer))
    (cond ((ss-closed stats))
	  ((<= count (- total-sends sends-out))
	   (when check-data-p
	     (do ((i 0 (1+ i))
		  (size (length buffer))
		  (byte (ss-last-send-byte stats) (1+ byte)))
		 ((= i size)
		  (setf (ss-last-send-byte stats) (logand byte #xff)))
	       (setf (aref buffer i) byte)))
	   (send socket :write-data buffer)
	   (incf (ss-sends-out stats)))
	  ((< count total-sends))
	  ((= count total-sends)
	   (send socket :close :normal))
	  (t
	   (error "too many sends?")))))

))