;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.94
;;; Reason:
;;;  Chaosnet speedup: reinstall %blt to and from int-pkts if lambda or explorer.
;;; Written 4-Nov-87 14:51:51 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.91, 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#398 at 4-Nov-87 14:59:08
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(defun convert-to-pkt (int-pkt &optional (free-pkt-flag t)
		       &aux (pkt (allocate-pkt)) (nw (pkt-nwords int-pkt)))
  "Allocates a new packet, copies the INT-PKT to it, and then deallocates the INT-PKT"
  (select-processor
    ((:lambda :explorer)
     (without-interrupts
       (%blt (%make-pointer-offset dtp-fix int-pkt (si:array-data-offset int-pkt))
	     (%make-pointer-offset dtp-fix pkt (si:array-data-offset pkt))
	     (ceiling nw 2)
	     1)))
    (:cadr
      (copy-array-portion int-pkt 0 nw pkt 0 nw)))
  (setf (fill-pointer (pkt-string pkt)) (pkt-nbytes int-pkt))
  (and free-pkt-flag (net:free-packet int-pkt))
  pkt)

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 14:59:13
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(defun convert-to-int-pkt (pkt &optional (int-pkt (net:allocate-packet))
			   &aux (nw (pkt-nwords pkt)))
  (select-processor
    ((:lambda :explorer)
     (without-interrupts
       (%blt (%make-pointer-offset dtp-fix pkt (si:array-data-offset pkt))
	     (%make-pointer-offset dtp-fix int-pkt (si:array-data-offset int-pkt))
	     (ceiling nw 2)
	     1)))
    (:cadr
      (copy-array-portion pkt 0 nw int-pkt 0 nw)))
  (setf (fill-pointer int-pkt) nw)
  int-pkt)

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 14:59:23
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-EOF-OR-DAT (CONN INT-PKT &AUX PKT PKT-NUM PKTL-NUM PREV)
  (SETQ PKT-NUM (PKT-NUM INT-PKT))
  (COND ((NOT (PKTNUM-< (PKT-NUM-RECEIVED CONN) PKT-NUM))
	 (SETQ PKTS-DUPLICATED (1+ PKTS-DUPLICATED))
	 (TRANSMIT-STS CONN '<-NUM-RCVD int-pkt))	;This is a duplicate, receipt and ignore
	((= PKT-NUM (PKTNUM-1+ (PKT-NUM-RECEIVED CONN)))
	 ;; This is the one we were waiting for add it to READ-PKTS
	 (SETQ PKT (CONVERT-TO-PKT INT-PKT))
	 (AND (NULL (READ-PKTS CONN))
	      (INTERRUPT-CONN :INPUT CONN))
	 (WITHOUT-INTERRUPTS
	   (SETF (PKT-LINK PKT) (RECEIVED-PKTS CONN))	;Link the two lists together
	   (SETF (RECEIVED-PKTS CONN) NIL)
	   (COND ((NULL (READ-PKTS-LAST CONN))
		  (SETF (READ-PKTS CONN) PKT))
		 (T (SETF (PKT-LINK (READ-PKTS-LAST CONN)) PKT)))
	   (DO ((PKTL-NUM (PKT-NUM PKT)
			  (PKTNUM-1+ PKTL-NUM)))
	       ((OR (NULL PKT)
		    ( PKTL-NUM (PKT-NUM PKT)))
		(SETF (PKT-NUM-RECEIVED CONN) (PKTNUM-- PKTL-NUM 1))
		(SETF (RECEIVED-PKTS CONN) PKT)
		(AND PREV (SETF (PKT-LINK PREV) NIL))
		(SETF (READ-PKTS-LAST CONN) PREV))
	     (SETQ PREV PKT)
	     (SETQ PKT (PKT-LINK PKT)))))
	(T (WITHOUT-INTERRUPTS 
	     (DO ((PKTL (RECEIVED-PKTS CONN) (PKT-LINK PKTL))
		  (PREV NIL PKTL))
		 ((NULL PKTL)
		  (SETQ PKT (CONVERT-TO-PKT INT-PKT))
		  (COND ((NULL PREV) (SETF (RECEIVED-PKTS CONN) PKT))
			(T (SETF (PKT-LINK PREV) PKT)))
		  (SETF (PKT-LINK PKT) NIL))
	       (SETQ PKTL-NUM (PKT-NUM PKTL))
	       (COND ((= PKT-NUM PKTL-NUM)	;Same as existing one, forget about it.
		      (TRANSMIT-STS CONN 'ALREADY-ON-RCVD-PKTS int-pkt)	;Send a receipt
		      (RETURN NIL))
		     ((PKTNUM-< PKT-NUM PKTL-NUM)	;This is the place!
		      (SETQ PKT (CONVERT-TO-PKT INT-PKT))
		      (COND ((NULL PREV)
			     (SETF (PKT-LINK PKT) (RECEIVED-PKTS CONN))
			     (SETF (RECEIVED-PKTS CONN) PKT))
			    (T
			     (SETF (PKT-LINK PKT) (PKT-LINK PREV))
			     (SETF (PKT-LINK PREV) PKT)))
		      (RETURN NIL))))))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 14:59:49
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-UNC (CONN INT-PKT &AUX PKT)
  (PROG ()
    (COND ((EQ (STATE CONN) 'FOREIGN-STATE))	;Foreign-protocol state--no checks
	  ((NEQ (STATE CONN) 'OPEN-STATE)
	   (RETURN (TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP "Connection not open")))
	  ((NOT (= (PKT-SOURCE-INDEX-NUM INT-PKT) (FOREIGN-INDEX-NUM CONN)))
	   (RETURN (TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP
			  "That is not your index number for this connection"))))
    (COND (( (LOOP FOR X = (READ-PKTS CONN) THEN (PKT-LINK X)
		    WHILE X
		    COUNT T)
	      (LOCAL-WINDOW-SIZE CONN))
	   ;; There are more packets on the list than the window size.  Discard
	   ;; this packet.  This is so that we do not allocate infinite packet
	   ;; buffers if someone throws lots of UNC packets at us.
	   (NET:FREE-PACKET INT-PKT))
	  (T
	   ;; Convert to regular packet, do INTERRUPT-CONN, and thread it on.
	   (SETQ PKT (CONVERT-TO-PKT INT-PKT))
	   (AND (NULL (READ-PKTS CONN))
		(INTERRUPT-CONN :INPUT CONN))
	   (WITHOUT-INTERRUPTS
	     (SETF (PKT-LINK PKT) (READ-PKTS CONN))
	     (SETF (READ-PKTS CONN) PKT)
	     (AND (NULL (READ-PKTS-LAST CONN))
		  (SETF (READ-PKTS-LAST CONN) PKT)))))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:05
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-RFC (INT-PKT)
  (IF (DUPLICATE-RFC-INT-PKT-P INT-PKT)
      (NET:FREE-PACKET INT-PKT)
    (HANDLE-RFC-PKT (CONVERT-TO-PKT int-pkt nil) int-pkt T)))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:21
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-BRD (INT-PKT &AUX BIT-MAP-LENGTH BYTE-IN-MAP PKT)
  (COND ((AND *RECEIVE-BROADCAST-PACKETS-P*
	      ;; Check the subnet bit map : length in bytes multiple of 4 ?
	      (ZEROP (MOD (SETQ BIT-MAP-LENGTH (PKT-ACK-NUM INT-PKT)) 4))
	      (> BIT-MAP-LENGTH (SETQ BYTE-IN-MAP (TRUNCATE MY-SUBNET 8)))) ; big enuf ?
	 ;; Massage so it looks like an RFC: Delete bit map, decrease byte count
	 (SETF (PKT-ACK-NUM INT-PKT) 0)
	 (INCF *BRD-PKTS-IN*)
	 (SETQ PKT (CONVERT-TO-PKT INT-PKT nil))
	 (SET-PKT-STRING PKT (SUBSTRING (PKT-STRING PKT) BIT-MAP-LENGTH))
	 (HANDLE-RFC-PKT PKT int-pkt NIL))
	(T
	 (NET:FREE-PACKET INT-PKT))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:29
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-CLS (INT-PKT &AUX PKT (INT-FLAG NIL))
  (LET ((CONN (PKT-DEST-CONN INT-PKT)))
    (COND ((NULL CONN)
	   (NET:FREE-PACKET INT-PKT))
	  ((MEMQ (STATE CONN) '(OPEN-STATE RFC-SENT-STATE))
	   (SETQ PKT (CONVERT-TO-PKT INT-PKT))
	   (WITHOUT-INTERRUPTS
	     (FREE-ALL-SEND-PKTS CONN)
	     (FREE-ALL-RECEIVED-PKTS CONN)
	     (SETF (STATE CONN) 'CLS-RECEIVED-STATE)
	     (COND ((NULL (READ-PKTS-LAST CONN))
		    (SETF (READ-PKTS CONN) PKT)
		    (SETQ INT-FLAG T))
		   (T (SETF (PKT-LINK (READ-PKTS-LAST CONN)) PKT)))
	     (SETF (READ-PKTS-LAST CONN) PKT)
	     (SETF (PKT-LINK PKT) NIL))
	   (INTERRUPT-CONN :CHANGE-OF-STATE CONN 'CLS-RECEIVED-STATE)
	   (AND INT-FLAG (INTERRUPT-CONN :INPUT CONN)))
	  (T (TRANSMIT-LOS-INT-PKT INT-PKT
				   LOS-OP
				   "You sent a CLS to the wrong kind of connection.")))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:38
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-LOS (INT-PKT &AUX (PKT (CONVERT-TO-PKT INT-PKT)) MY-INDEX CONN (INT-FLAG NIL))
  (SETQ MY-INDEX (LDB MAXIMUM-INDEX-LOG-2-MINUS-1 (PKT-DEST-INDEX-NUM PKT)))
  (COND ((AND (< MY-INDEX MAXIMUM-INDEX)
	      (SETQ CONN (AREF INDEX-CONN MY-INDEX))
	      (EQ (STATE CONN) 'OPEN-STATE)
	      (= (PKT-SOURCE-ADDRESS INT-PKT) (FOREIGN-ADDRESS CONN))
	      (= (PKT-SOURCE-INDEX-NUM INT-PKT) (FOREIGN-INDEX-NUM CONN)))
	 (WITHOUT-INTERRUPTS
	   (FREE-ALL-SEND-PKTS CONN)
	   (FREE-ALL-RECEIVED-PKTS CONN)
	   (SETF (STATE CONN) 'LOS-RECEIVED-STATE)
	   (COND ((NULL (READ-PKTS-LAST CONN))
		  (SETF (READ-PKTS CONN) PKT)
		  (SETQ INT-FLAG T))
		 (T (SETF (PKT-LINK (READ-PKTS-LAST CONN)) PKT)))
	   (SETF (READ-PKTS-LAST CONN) PKT)
	   (SETF (PKT-LINK PKT) NIL))
	 (INTERRUPT-CONN :CHANGE-OF-STATE CONN 'LOS-RECEIVED-STATE)
	 (AND INT-FLAG (INTERRUPT-CONN :INPUT CONN)))
	(T (SETF (PKT-LINK PKT) LOS-PKTS)
	   (SETQ LOS-PKTS PKT)
	   (SETQ CURRENT-LOS-PKT-COUNT (1+ CURRENT-LOS-PKT-COUNT)))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:47
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-FWD (CONN INT-PKT &AUX PKT)
  (COND ((NEQ (STATE CONN) 'RFC-SENT-STATE)
	 (TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP "An FWD was sent to a non-RFC-SENT index."))
	(T (SETQ PKT (CONVERT-TO-PKT INT-PKT))
	   (SETF (FOREIGN-ADDRESS CONN) (PKT-ACK-NUM PKT))
	   (SETF (PKT-OPCODE PKT) RFC-OP)
	   (TRANSMIT-NORMAL-PKT CONN PKT (PKT-NUM-SENT CONN) (LOCAL-WINDOW-SIZE CONN)))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#398 at 4-Nov-87 15:00:52
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-ANS (CONN INT-PKT &AUX PKT)
    (COND ((NOT (MEMQ (STATE CONN) '(RFC-SENT-STATE BROADCAST-SENT-STATE)))
	   (NET:FREE-PACKET INT-PKT))
	  (T (SETQ PKT (CONVERT-TO-PKT INT-PKT))
             (SETF (STATE CONN) 'ANSWERED-STATE)
	     (SETF (READ-PKTS CONN) PKT)
	     (SETF (PKT-LINK PKT) NIL)
	     (INTERRUPT-CONN :CHANGE-OF-STATE CONN 'ANSWERED-STATE)
	     (INTERRUPT-CONN :INPUT CONN))))

))