;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 121.66
;;; Reason:
;;;  Fix Chaosnet "File Input" and "Host Down" hangs:
;;;  When remote side indicates in a STS that all outstanding packets have been
;;;  received -- but not all are acknowledged, and the subsequent acknowledgement
;;;  is lot, chaos:retransmission can't retransmit, as no packets remain.  It should
;;;  send a SNS to elicit an up-to-date STS.
;;; Written 25-Oct-87 14:48:11 by HLC at site LMI Cambridge
;;; while running on Djinn from band 1
;;; with Experimental System 121.65, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, microcode 1733, SDU ROM 8, 121.35.



; From file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#394 at 25-Oct-87 15:25:36
#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 (allocate-int-pkt)))
	  (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 enuf 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))))

))