;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.74
;;; Reason:
;;;  Attempt to solve the Chaosnet "File Input" and "Host Down" hangs.
;;;  When the remote end sends a STS that indicates that all outstanding packets have
;;;  been received, but that not all are acknowledged, we clear out the send-pkt list.
;;;  If the acknowledgement is lost, we don't retransmit, as there are no packets to
;;;  retransmit.  In this case, we should send a SNS to elicit a STS with updated
;;;  acknowledgment info.  Fix to chaos:retransmission to do exactly that...
;;;  Along same lines: chaos:retransmission should count the firrst packet still on
;;;  the send list as the lowest packet number -- not last packet acknowledged.
;;; Written 25-Oct-87 14:56:43 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.73, Experimental Local-File 73.0, Experimental FILE-Server 22.0, 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.CHAOS; CHSNCP.LISP#393 at 25-Oct-87 15:16:09
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RETRANSMISSION (CONN &AUX TIME (INHIBIT-SCHEDULING-FLAG T))
  (when (MEMQ (STATE CONN) '(OPEN-STATE RFC-SENT-STATE))
    ;;Only if it is open or awaiting a response from RFC
    (when (null (send-pkts conn))
      (when (pktnum-< (send-pkt-acked conn) (pkt-num-sent conn))
	;;No packets to transmit but none on send-list.  Remote end has received all of
	;;our packets but has not acknowledged them all.  Send a SNS to elicit a STS
	(setq inhibit-scheduling-flag nil)
	(let ((pkt (net:allocate-packet)))
	  (setf (pkt-opcode pkt) sns-op)
	  (setf (pkt-nbytes-on-write pkt) 0)
	  (transmit-int-pkt-for-conn conn pkt))
	(setq more-retransmission-needed t))	;Indicate that pkts remain unacknowledged
      (return-from retransmission t))		;And return from this function
    ;; Doing this outside the loop can lose
    ;; because then TIME can be less than (PKT-TIME-TRANSMITTED PKT).
    (SETQ TIME (zl:TIME))			;On the other hand, doing it inside the loop loses
    ;;because if there are enough PKTs pending for a particular CONN, it can
    ;;hang because every time it sends one it has to restart from the beginning
    ;;of the list.  So now we deal with the case mentioned above explicitly.
    (DO-NAMED CONN-DONE
	      () (NIL)
      (LET ((INHIBIT-SCHEDULING-FLAG T))
	(DO* ((PKT (SEND-PKTS CONN) (PKT-LINK PKT))
	      (first-pkt-num (and pkt (pkt-num pkt))))
	     ((NULL PKT) (RETURN-FROM CONN-DONE NIL))
	  (COND ((NOT (EQ CONN (PKT-SOURCE-CONN PKT)))
		 (FERROR "~S in SEND-PKTS list for incorrect CONN:
CONN ~S, (PKT-SOURCE-CONN PKT) ~S." PKT CONN (PKT-SOURCE-CONN PKT))))
	  (SETQ MORE-RETRANSMISSION-NEEDED T)
	  (COND ((TIME-LESSP TIME (PKT-TIME-TRANSMITTED PKT)))	;Dont do this one again.
		(( (TIME-DIFFERENCE TIME (PKT-TIME-TRANSMITTED PKT))
		    (LSH (CONN-RETRANSMISSION-INTERVAL CONN)
			 ;; Retransmit the lowest numbered packet most often
			 (MAX 0 (MIN 5 (1- (pktnum-- (PKT-NUM PKT) first-pkt-num))))))
		 (SETF (PKT-BEING-RETRANSMITTED PKT) T)
		 (SETQ INHIBIT-SCHEDULING-FLAG NIL)
		 (TRANSMIT-PKT PKT T)
		 (INCF PKTS-RETRANSMITTED)
		 (SETQ INHIBIT-SCHEDULING-FLAG T)
		 (COND ((EQ (PKT-BEING-RETRANSMITTED PKT) 'FREE)
			(SETF (PKT-BEING-RETRANSMITTED PKT) NIL)
			(FREE-PKT PKT))
		       (T (SETF (PKT-BEING-RETRANSMITTED PKT) NIL)))
		 (RETURN NIL)))))		;Must always start from beginning of chain if
						; turned on scheduling, since chain could be invalid
      (PROCESS-ALLOW-SCHEDULE))))

))