;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 125.12
;;; Reason:
;;;  Fixes to Chaos routing:
;;;    - packets for this host always go through Loopback interface
;;;    - packets for other processors on same bus go through
;;;      Share interface, even if both this processor and
;;;      the other one have Ethernet interfaces.
;;;    - packets for other processors on same bus go
;;;      directly to that processor, not through the
;;;      Ethernet owner! (matters only to 2X2+ or 3X3)
;;; Written 21-Jul-88 01:20:07 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 3
;;; with System 125.10, ZWEI 125.2, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, Experimental Kermit 36.4, microcode 1761, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#410 at 21-Jul-88 01:45:25
#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 on-behalf-of)
  (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 (= my-address (pkt-source-address int-pkt))
    (setq on-behalf-of (pkt-source-address 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)))
	 ;;Here if this is a real broadcast packet
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :broadcast
	       int-pkt
	       byte-count))

	((= host my-address)
	 ;;Here if packet is for this host
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :send
	       int-pkt
	       byte-count
	       net:*loopback-interface*
	       0))

	((and si:share-interface
	      (not (zerop host))
	      (multiple-value-setq (address interface)
		(send *chaos-stream*
		      :translate-address
		      host
		      si:share-interface
		      on-behalf-of)))
	 ;;Here if to a processor on same bus
	 (incf pkts-transmitted)		;Increment counter looked at by Hostat
	 (send *chaos-stream*
	       :send
	       int-pkt
	       byte-count
	       interface
	       address))

	;;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
		 on-behalf-of))
	 ;;Here if there is Ethernet hardware and we own it and packet goes out of this rack
	 (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)))
  )

))
