;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.120
;;; Reason:
;;;  It is possible to have machines on the same physical network on different Chaos subnets.
;;;  The way this used to work was that Chaos passed the subnet # through its route table and
;;;  got a 0, which would cause the packet to be broadcast.  There are a few problems with
;;;  that -- causes unnecessary network loading and packet forwarding.  New solutions:
;;;  chaos:transmit-int-pkt will attempt address translation on the original destination
;;;  address if the subnet routing failed.  chaos:receive-int-pkt will not attempt to
;;;  forward a packet that arrives on the broadcast address.
;;; Written 23-Nov-87 12:44:54 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.119, 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.CHAOS; CHSNCP.LISP#402 at 23-Nov-87 12:45:37
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(defun transmit-int-pkt (int-pkt &optional host subnet (broadcast-if-necessary t)
			 &aux byte-count address interface)
  (unless (net:check-packet (net:original-array int-pkt))
    (error "Attempt to transmit non-interrupt packet ~A." int-pkt))

  (when (null host)
    (setq host (pkt-dest-address int-pkt)))
  (when (null subnet)
    (setq subnet (pkt-dest-subnet int-pkt)))
  
  (unless (or (= subnet my-subnet) (member subnet my-other-subnets))
    (when (>= subnet (array-length routing-table))
      (setq subnet 0))
    (setq host (aref routing-table subnet)))
  
  (setq byte-count (* 2 (pkt-nwords int-pkt)))
  
  (when (bit-test #o200 (pkt-opcode int-pkt))
    (incf data-pkts-out))
  
  (setf (ldb (byte 8 0) (aref int-pkt 0)) 0)	;Set header version to 0

  (cond ((null *chaos-stream*)			;Chaos not enabled
	 (net:free-packet int-pkt))

	((and broadcast-if-necessary
	      (zerop host)
	      (zerop (pkt-dest-address int-pkt)))
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :broadcast
	       int-pkt
	       byte-count))

	;;Maybe this case should be handled by some sort of "default gateway" mechanism.
	((and si:*ethernet-hardware-controller*
	      (not (eq si:*ethernet-hardware-controller* si:*my-op*))
	      (si:share-mode-active-p))
	 ;;Here if there is Ethernet hardware and it is owned by another processor
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :send
	       int-pkt
	       byte-count
	       si:share-interface
	       si:*ethernet-hardware-controller*))
	
	((multiple-value-setq (address interface)
	   (send *chaos-stream*
		 :translate-address
		 ;;If host is 0 and not a broadcast packet, routing failed.  Still, the unknown
		 ;;Chaos subnet MIGHT be on our physical network, so do address translation...
		 (if (zerop host) (pkt-dest-address int-pkt) host)
		 nil
		 (pkt-source-address int-pkt)))
	 ;;Here if there is no Ethernet hardware, but packet goes to processor on our backplane,
	 ;;OR there is Ethernet hardware and we own it,
	 ;;OR the packet is addressed to this host
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :send
	       int-pkt
	       byte-count
	       interface
	       address))
	
	(t
	 (incf (chaos-packets-sent-discarded *chaos-stream*))
	 (incf (chaos-bytes-sent-discarded *chaos-stream*) byte-count)
	 (net:free-packet int-pkt)))
  )

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#402 at 23-Nov-87 12:46:18
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN RECEIVE-INT-PKT (INT-PKT &optional broadcast-p &AUX (OP (PKT-OPCODE INT-PKT)) CONN ACKN)
  (COND ((and (NOT (ZEROP (LDB (byte 8 0) (AREF INT-PKT 0))))
	      (memq *header-version-action* '(:NOTIFY :RESPECT)))
	 (if (eq *header-version-action* :notify)
	     (tv:notify nil "Got non-zero header version from address: #o~O"
			(pkt-source-address int-pkt)))
	 (NET:FREE-PACKET INT-PKT))
	((= OP RUT-OP)
	 (DO ((I FIRST-DATA-WORD-IN-PKT (+ I 2))
	      (N (floor (PKT-NBYTES INT-PKT) 4) (1- N))
	      (GATEWAY (PKT-SOURCE-ADDRESS INT-PKT))
	      (N-SUBNETS (ARRAY-LENGTH ROUTING-TABLE))
	      (SUBNET) (COST))
	     ((ZEROP N) (NET:FREE-PACKET INT-PKT))
	   (SETQ SUBNET (AREF INT-PKT I) COST (AREF INT-PKT (1+ I)))
	   (WHEN (AND (< SUBNET N-SUBNETS)
		      ( COST (AREF ROUTING-TABLE-COST SUBNET))
		      (NULL (AREF ROUTING-TABLE-TYPE SUBNET)))
	     (SETF (AREF ROUTING-TABLE SUBNET) GATEWAY)
	     (SETF (AREF ROUTING-TABLE-COST SUBNET) COST))))
	((AND (= OP BRD-OP) (ZEROP (PKT-DEST-ADDRESS INT-PKT)))
	 (RECEIVE-BRD INT-PKT))
	(( (PKT-DEST-ADDRESS INT-PKT) MY-ADDRESS)	;Packet to be forwarded
	 (COND (broadcast-p
		(net:free-packet int-pkt))
	       ((OR (= (PKT-FWD-COUNT INT-PKT) 17)
		    (> (PKT-NBYTES INT-PKT) MAX-DATA-BYTES-PER-PKT))
		(NET:FREE-PACKET INT-PKT)
		(INCF PKTS-OVER-FORWARDED))
	       (T (SETF (PKT-FWD-COUNT INT-PKT) (1+ (PKT-FWD-COUNT INT-PKT)))
		  (INCF PKTS-FORWARDED)
		  (TRANSMIT-INT-PKT INT-PKT nil nil nil))))
	(T (RECORD-INT-PKT-HEADER INT-PKT)
	   (AND (BIT-TEST #o200 OP) (INCF DATA-PKTS-IN))
	   (COND
	     ((= OP RFC-OP) (RECEIVE-RFC INT-PKT))
	     ((= OP LOS-OP) (RECEIVE-LOS INT-PKT))
	     ((= OP CLS-OP) (RECEIVE-CLS INT-PKT))
	     ((= OP MNT-OP) (NET:FREE-PACKET INT-PKT))
	     ((AND (OR (NULL (SETQ CONN (PKT-DEST-CONN INT-PKT)))
		       ( (PKT-DEST-INDEX-NUM INT-PKT) (LOCAL-INDEX-NUM CONN))
		       ( (PKT-SOURCE-ADDRESS INT-PKT) (FOREIGN-ADDRESS CONN)))
		   (NOT (SETQ CONN (CDR (ASSQ (PKT-DEST-INDEX-NUM INT-PKT)
					      DISTINGUISHED-PORT-CONN-TABLE)))))
	      (TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP
				    (IF CONN "You are not connected to this index"
				      "No such index exists")))
	     ((PROG2 (SETF (TIME-LAST-RECEIVED CONN) (ZL:TIME))
		     (= OP OPN-OP))
	      (RECEIVE-OPN CONN INT-PKT))
	     ((= OP FWD-OP) (RECEIVE-FWD CONN INT-PKT))
	     ((= OP ANS-OP) (RECEIVE-ANS CONN INT-PKT))
	     ((= OP UNC-OP) (RECEIVE-UNC CONN INT-PKT))
	     ((NOT (OR (= OP SNS-OP) (= OP STS-OP)
		       (= OP EOF-OP) ( OP DAT-OP)))
	      (TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP "Illegal opcode"))
	     ((NOT (= (PKT-SOURCE-INDEX-NUM INT-PKT) (FOREIGN-INDEX-NUM CONN)))
	      (IF (= OP SNS-OP) (NET:FREE-PACKET INT-PKT)	;Ignore SNS if not open
		(TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP
				      "That is not your index number for this connection")))
	     ;; Below here can be SNS, STS, EOF, or DAT, all packets having ack fields.
	     ((NOT (EQ (STATE CONN) 'OPEN-STATE))
	      (IF (= OP SNS-OP) (NET:FREE-PACKET INT-PKT)	;Ignore SNS if not open
		(TRANSMIT-LOS-INT-PKT INT-PKT LOS-OP "Connection not open")))
	     (T
	      ;; Below here, this INT-PKT contains a normal acknowledgement field.
	      (SETQ ACKN (PKT-ACK-NUM INT-PKT))	;Acknowledgement field
	      (RECEIPT CONN ACKN)		;Clear receipted packets from send list
	      (COND ((OR (>= OP DAT-OP) (= OP EOF-OP))
		     (RECEIVE-EOF-OR-DAT CONN INT-PKT))
		    ((= OP SNS-OP) (RECEIVE-SNS CONN INT-PKT))
		    ((= OP STS-OP) (RECEIVE-STS CONN INT-PKT))
		    (T (FERROR NIL "should not get here"))))))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#402 at 23-Nov-87 12:46:49
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(defun receive-chaos-pkt (int-pkt interface stream source destination broadcast-p)
  (declare (ignore stream))
  (declare (ignore destination))
  (incf pkts-received)				;Increment counter looked at by Hostat
  (let* ((packet (net:original-array int-pkt))
	 (header (net:ni-rcvd-header-length interface))
	 (trailer (net:ni-rcvd-trailer-length interface))
	 (total-words (/ (+ header trailer) 2)))
    (unless (zerop header)
      (setq int-pkt (make-array (- (array-length packet) total-words)
				:element-type '(unsigned-byte 16)
				:displaced-to packet
				:displaced-index-offset (/ header 2)
				:fill-pointer (- (fill-pointer int-pkt) total-words)))))
  (cond ((set-word-count int-pkt)
	 (and (/= (pkt-dest-address int-pkt) my-address)	;Packet to be forwarded
	      (eq interface si:share-interface)	                ;And came from other processor
	      (let ((elt (assoc source net:*processor-forwarding-alist*)))
		(when elt
		  (setf (cdr elt) t))))		;Note that we are that processor's gateway
	 (without-interrupts
	   (receive-int-pkt int-pkt broadcast-p)))
	(t
	 ;;packet appears to be a loser.
	 (net:free-packet int-pkt))))

))
