;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Private patches made by bobp
;;; Reason:
;;;  
;;; Written 29-May-86 14:44:07 by bobp (Bob Powell) at site LMI Cambridge
;;; while running on Poindexter from band 2
;;; with Experimental System 110.246, Experimental Lambda-Diag 7.23, Experimental Local-File 68.8, Experimental FILE-Server 18.4, Experimental Unix-Interface 9.1, Experimental ZMail 65.14, Experimental Object Lisp 3.4, Experimental Tape 6.38, Experimental Site Data Editor 3.3, Experimental Tiger 24.0, Experimental KERMIT 31.3, Experimental Window-Maker 1.1, Experimental Gateway 4.8, Experimental TCP-Kernel 39.7, Experimental TCP-User 62.8, Experimental TCP-Server 45.5, Experimental MEDIUM-RESOLUTION-COLOR 3.4, Experimental MICRO-COMPILATION-TOOLS 3.2, Experimental IMicro 10.0, microcode 1509, SDU Boot Tape 3.10, SDU ROM 103, Alpha IV.



; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#365 at 29-May-86 14:44:12
#8R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(DEFUN LAMBDA-TRANSMIT-INT-PKT (INT-PKT &OPTIONAL HOST SUBNET (broadcast-if-necessary t)
				&aux other-local-procs hardware-p local-proc
				     out-of-this-machine-via-share
				(free-int-pkt t))
  (if (null host) (setq host (pkt-dest-address int-pkt)))
  (if (null subnet) (setq subnet (pkt-dest-subnet int-pkt)))
  
  (COND ((AND (NOT (= SUBNET MY-SUBNET))
	      (NOT (MEMBER SUBNET MY-OTHER-SUBNETS)))
	 (AND ( SUBNET (ARRAY-LENGTH ROUTING-TABLE))
	      (SETQ SUBNET 0))
	 (SETQ HOST (AR-1 ROUTING-TABLE SUBNET))))
  (SETF (INT-PKT-WORD-COUNT INT-PKT) (1+ (PKT-NWORDS INT-PKT)))
  (ASET HOST INT-PKT (1- (INT-PKT-WORD-COUNT INT-PKT)))
  (if (not (int-pkt-in-correct-area-p int-pkt))
      (ferror "Attempt to transmit non-interrupt packet ~A." INT-PKT))
  (if (BIT-TEST #o200 (PKT-OPCODE INT-PKT))
      (SETQ DATA-PKTS-OUT (1+ DATA-PKTS-OUT)))
  (COND ((= host my-address)
	 (without-interrupts
	   (setq free-int-pkt nil)
	   (setf (int-pkt-thread int-pkt) fake-receive-list)
	   (incf (int-pkt-word-count int-pkt) 2)
	   (setf (int-pkt-hardware-dest int-pkt) my-address)
	   (setf (int-pkt-bit-count int-pkt) ethernet:chaos-ethernet-type)
	   (setq fake-receive-list int-pkt))
	 )
	((and (null broadcast-if-necessary)
	      (zerop host)))
	((AND si:*share-code-ready* (SI:SHARE-MODE-ACTIVE-P))
	 (COND ((ZEROP HOST)
		(SETQ HARDWARE-P (EQ SI:*ETHERNET-HARDWARE-CONTROLLER* SI:*MY-OP*))
		(if (zerop (pkt-dest-address int-pkt)) ; really broadcast ?
		    (SETQ OTHER-LOCAL-PROCS SI:*OTHER-PROCESSORS*)
		  (unless hardware-p
		    (setq out-of-this-machine-via-share t)
		    (SETQ LOCAL-PROC SI:*ETHERNET-HARDWARE-CONTROLLER*))))
		  
	       ;;if he's local, just send to him
	       ((SETQ LOCAL-PROC (SI:PROCESSOR-FOR-HOST-IF-ON-MY-NUBUS HOST)))
		  
	       ;;it's definitely going out of this machine - give it to
	       ;;the hardware controller
	       ((EQ SI:*ETHERNET-HARDWARE-CONTROLLER* SI:*MY-OP*)
		(SETQ HARDWARE-P T))
	       (T
		(setq out-of-this-machine-via-share t)
		(SETQ LOCAL-PROC SI:*ETHERNET-HARDWARE-CONTROLLER*))))
	(T
	 (SETQ HARDWARE-P T)))
	 
  (DOLIST (OP OTHER-LOCAL-PROCS)
    (si:TRANSMIT-INT-PKT-TO-SHARING-HOST INT-PKT OP out-of-this-machine-via-share))
	 
  (when (not (and (eq chaos:my-address #.(address-parse "bobp"))
		  (eq host #.(address-parse "drac"))
		  (not (eq (pkt-source-address int-pkt) #.(address-parse "bobp")))))

    (IF LOCAL-PROC
	(si:TRANSMIT-INT-PKT-TO-SHARING-HOST INT-PKT LOCAL-PROC out-of-this-machine-via-share)))

  (when hardware-p
    (let ((ether-address (ethernet:get-ethernet-address host)))
      (cond ((null ether-address)
	     (INCF ETHERNET:*ETHERNET-CHAOS-PKTS-NOT-TRANSMITTED-LACKING-ETHERNET-ADDRESS*))
	    (t
	     (setq free-int-pkt nil)
	     (transmit-int-pkt-on-ethernet
	       int-pkt ether-address ethernet:chaos-ethernet-type)
	     (incf ethernet:*ethernet-chaos-pkts-transmitted*)
	     (incf pkts-transmitted)))))
  (if free-int-pkt
      (free-int-pkt int-pkt))
  )

))