(FILECREATED "16-Dec-83 14:25:29" {PHYLUM}<LISPCORE>LIBRARY>GATEWAY.;6 38787  

      changes to:  (VARS GATEWAYCOMS)
		   (FNS \BUILD.NS.ROUTING.PACKET)

      previous date: "16-NOV-83 10:52:04" {PHYLUM}<LISPCORE>LIBRARY>GATEWAY.;4)


(* Copyright (c) 1983 by Schlumberger Technology Corporation)

(PRETTYCOMPRINT GATEWAYCOMS)

(RPAQQ GATEWAYCOMS ((FNS GATEWAY GATEWAY.BYE \INIT.GATEWAY)
		    (COMS (* Pup Gateway)
			  (FNS \BUILD.PUP.ROUTING.PACKET \GATEWAY.FORWARD.PUP \UPDATECHECKSUM 
			       \HANDLE.PUP.ADDRLOOKUP \HANDLE.PUP.ALTOTIMEREQ \HANDLE.PUP.MISC 
			       \HANDLE.PUP.MISC.BACKGROUND \HANDLE.PUP.NAMELOOKUP \HANDLE.PUP.ROUTING 
			       \PUPGATESERVER \PUPGATESERVERDYING \PUPGATE.BROADCAST \PUPMISCSERVER)
			  (VARS (\PUP.ROUTEDBAD 0)
				(\PUP.ROUTEDPUPS 0)
				GATEWAYSERVICES))
		    (COMS (* NS Gateway)
			  (FNS \GATEWAY.FORWARD.XIP \NSGATESERVER \NSGATESERVERDYING 
			       \NSGATE.BROADCAST \BUILD.NS.ROUTING.PACKET \HANDLE.NS.ROUTING)
			  (VARS (\XIP.ROUTEDBAD 0)
				(\XIP.ROUTEDGOOD 0)))
		    (COMS (* Utilities for handling lookup requests)
			  (FNS AddressFromEntry BCPLStringFromFile LOADBITS MAKEOCTALSTRING 
			       NameFromAddress NetDirAddressLookup NetDirNameLookup PortCompare 
			       PortFromAddress PrintNameBlock SearchNetDirForAddress 
			       SearchNetDirForName StringCompare))
		    (COMS (* Currently unused)
			  (FNS MapNameTable NameFromEntry))
		    (INITVARS (\GATEWAYFLG)
			      (\PUP.MISC.BACKGROUND.INTERVAL 300000)
			      (EXTRA10MBTRANSLATIONLST)
			      (LOCALNETWORKLST))
		    (CURSORS GATEWAYCURSOR)
		    (DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS \TIMEPUPLENGTH)
			      (RECORDS PUPROUTINGINFO TIMEPUPCONTENTS)
			      (GLOBALVARS \PUP.ROUTEDBAD \PUP.ROUTEDPUPS \XIP.ROUTEDBAD 
					  \XIP.ROUTEDGOOD)
			      (MACROS WORDIN WORDOUT)
			      (FILES (SOURCE)
				     ETHERRECORDS)
			      (FILES (LOADCOMP)
				     LLETHER LLNS))
		    (FILES PUPIDSERVER)))
(DEFINEQ

(GATEWAY
  [LAMBDA (FLG)                                              (* bvm: "13-NOV-83 00:20")
    (SELECTQ
      FLG
      [(ON RESTART)
	(PROG NIL
	  RETRY
	      (COND
		([OR (NLISTP LOCALNETWORKLST)
		     (CDDR LOCALNETWORKLST)
		     (NOT (for TRIPLE in LOCALNETWORKLST
			     always (SELECTQ (CAR TRIPLE)
					     [(3 10)
					       (AND (LISTP (SETQ TRIPLE (CDR TRIPLE)))
						    (OR (NULL (CAR TRIPLE))
							(FIXP (CAR TRIPLE)))
						    [OR (NULL (SETQ TRIPLE (CDR TRIPLE)))
							(AND (LISTP TRIPLE)
							     (OR (NULL (CAR TRIPLE))
								 (FIXP (CAR TRIPLE]
						    (NULL (CDR TRIPLE]
					     (SELECTQ (CDR TRIPLE)
						      ((3 10)
                                                             (* Old style, let's fix it)
							[/SETATOMVAL (QUOTE LOCALNETWORKLST)
								     (for PAIR in LOCALNETWORKLST
									collect (LIST (CDR PAIR)
										      (CAR PAIR)
										      (CAR PAIR]
							(GO RETRY))
						      NIL]
		  (ERROR "Need to set LOCALNETWORKLST correctly"))
		(T (SETQ \GATEWAYFLG T)
		   (RESTART.ETHER]
      (OFF (SETQ \GATEWAYFLG NIL)
	   (for SERVICE in GATEWAYSERVICES do (DEL.PROCESS SERVICE))
	   (DISMISS 5000)                                    (* Wait for cleanups)
	   (RESTART.ETHER))
      (NIL)
      (BYE (GATEWAY.BYE))
      (\ILLEGAL.ARG FLG))
    (COND
      (\GATEWAYFLG (QUOTE ON))
      (T (QUOTE OFF])

(GATEWAY.BYE
  (LAMBDA NIL                                                (* ejs: " 5-AUG-83 20:21")

          (* * Save processor cycles and the screen)


    (RESETLST (RESETSAVE (VIDEOCOLOR T))
	      (RESETSAVE (SETDISPLAYHEIGHT 0))
	      (RESETSAVE (CURSOR GATEWAYCURSOR))
	      (until (READP)
		 do (ADJUSTCURSORPOSITION (ITIMES (RAND -1 1)
						  20Q)
					  (ITIMES (RAND -1 1)
						  20Q))
		    (BLOCK 1750Q)))))

(\INIT.GATEWAY
  [LAMBDA (EXTRA10MBTRANSLATIONLST)                          (* bvm: "13-NOV-83 00:04")

          (* * Start the Pup gateway. LOCALNETWORKLST is a list of dotted pairs (NET# . NETTYPE), where nettype is either 3 
	  or 10.. EXTRA10MBTRANSLATIONLST is a list of (PUPHOST# . NSHOSTNUMBER) pairs, NSHOSTNUMBER being an instance of 
	  the NSHOSTNUMBER typerecord)


    (COND
      ((NEQ \MACHINETYPE \DOLPHIN)
	(ERROR "Pup Gateway runs only on Dolphins"))
      ((NOT (FIND.PROCESS (QUOTE \10MBWATCHER)))
	(ERROR "Either you don't have a 10MB Ethernet in this machine," 
	       " or you did not start Lisp with LISP/Z X3DOLPHINLISPMC.EB/M"))
      ((NOT (FIND.PROCESS (QUOTE \3MBWATCHER)))
	(ERROR "There's no 3 MB Ethernet!")))
    (DEL.PROCESS (QUOTE \PUPGATELISTENER))
    (DEL.PROCESS (QUOTE \NSGATELISTENER))
    (for SERVERNAME in GATEWAYSERVICES bind PROC when (SETQ PROC (FIND.PROCESS SERVERNAME))
       do (SUSPEND.PROCESS PROC))
    (SETQ \PUP.ROUTING.TABLE (CONS))
    (SETQ \NS.ROUTING.TABLE (CONS))
    (COND
      ((IGREATERP (LENGTH LOCALNETWORKLST)
		  2)
	(ERROR "We only support one 3 and one 10 MB network now")))
                                                             (* Ram the routing table down our throats)
    [for ROUTE in LOCALNETWORKLST bind NDB NET
       do (SETQ NDB (SELECTC (CAR ROUTE)
			     (3 \3MBLOCALNDB)
			     (10 \10MBLOCALNDB)
			     (ERROR "CDR of NETLST entry must be 3 or 10")))
	  [COND
	    ((SETQ NET (CADR ROUTE))
	      (NCONC1 \PUP.ROUTING.TABLE
		      (create ROUTING
			      RTNET# ← NET
			      RTHOPCOUNT ← 0
			      RTNDB ← NDB
			      RTTIMER ←(SETUPTIMER 0)
			      RTRECENT ← T))
	      (replace (NDB NDBPUPNET#) of NDB with NET)
	      (replace (NDB NDBPUPHOST#) of NDB with (\SERIALNUMBER]
	  (COND
	    ((SETQ NET (CADDR ROUTE))
	      (NCONC1 \NS.ROUTING.TABLE
		      (create ROUTING
			      RTNET# ← NET
			      RTHOPCOUNT ← 0
			      RTNDB ← NDB
			      RTTIMER ←(SETUPTIMER 0)
			      RTRECENT ← T))
	      (replace (NDB NDBNSNET#) of NDB with NET]
    [PROGN                                                   (* This hardly seems necessary)
	   (replace (NDB NDBTRANSLATIONS) of \10MBLOCALNDB with (CONS))
	   (for ENTRY in EXTRA10MBTRANSLATIONLST do (PUTASSOC (CAR ENTRY)
							      (LIST (CDR ENTRY)
								    (CLOCK 0))
							      (fetch (NDB NDBTRANSLATIONS)
								 of \10MBLOCALNDB]
    (SETQ NETDIRSTREAM (OPENSTREAM (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
				   (QUOTE INPUT)
				   (QUOTE OLD)))
    (for SERVERNAME in GATEWAYSERVICES bind PROC do (COND
						      ((SETQ PROC (FIND.PROCESS SERVERNAME))
							(RESTART.PROCESS PROC))
						      (T (ADD.PROCESS (LIST SERVERNAME)
								      (QUOTE RESTARTABLE)
								      (QUOTE SYSTEM)
								      (QUOTE AFTEREXIT)
								      (QUOTE DELETE])
)



(* Pup Gateway)

(DEFINEQ

(\BUILD.PUP.ROUTING.PACKET
  [LAMBDA (PUP GATESOC OLDPUPFLG DYING)                      (* bvm: "13-NOV-83 00:13")

          (* * Create a routing info Pup to be broadcast over all networks)


    (PROG [(BYTE 0)
	   (MYHOST# (LOGAND 255 \LOCALPUPNETHOST))
	   (MYNET# (LOGAND 255 (LRSH \LOCALPUPNETHOST 8]
          (COND
	    (OLDPUPFLG (replace (PUP PUPTYPE) of PUP with \PT.GATEWAYRESPONSE))
	    (T (SETUPPUP PUP 0 \PUPSOCKET.ROUTING \PT.GATEWAYRESPONSE NIL GATESOC)))
          [\MAP.ROUTING.TABLE \PUP.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
				  (PUTPUPBYTE PUP BYTE (fetch (ROUTING RTNET#) of NETWORK))
				  (PUTPUPBYTE PUP (\ADDBASE BYTE 1)
					      MYNET#)
				  (PUTPUPBYTE PUP (\ADDBASE BYTE 2)
					      MYHOST#)
				  [PUTPUPBYTE PUP (\ADDBASE BYTE 3)
					      (COND
						(DYING \RT.INFINITY)
						(T (fetch (ROUTING RTHOPCOUNT) of NETWORK]
				  (SETQ BYTE (\ADDBASE BYTE 4]
          (replace (PUP PUPLENGTH) of PUP with (IPLUS \PUPOVLEN BYTE])

(\GATEWAY.FORWARD.PUP
  [LAMBDA (PUP)                                              (* bvm: "10-NOV-83 23:01")

          (* * Pup forwarding for Interlisp gateways)


    (PROG (CSUM NDB TRANSPORT)
          (COND
	    ([AND \PUP.CHECKSUMFLG (NEQ (SETQ CSUM (fetch PUPCHECKSUM of PUP))
					MASKWORD1'S)
		  (NEQ CSUM (\CHECKSUM (fetch PUPCHECKSUMBASE of PUP)
				       (SUB1 (FOLDHI (fetch PUPLENGTH of PUP)
						     BYTESPERWORD]
	      (add \PUP.ROUTEDBAD 1)
	      (AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
					 NIL "Gateway: Discarding Pup with bad checksum: "))
	      (\PUPERROR PUP \PUPE.GATEWAY.BADPUP "Packet discarded because checksum bad"))
	    [(SETQ NDB (\ROUTE.PUP PUP T))                   (* Update the hop count, rechecksum and transmit)
	      (SETQ TRANSPORT (fetch PUPTCONTROL of PUP))
	      (COND
		((IGEQ (add TRANSPORT (CONSTANT (LLSH 1 4)))
		       (CONSTANT (LLSH 15 4)))
		  (add \PUP.ROUTEDBAD 1)
		  (AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
					     NIL "Gateway: Discarding looping Pup: "))
		  (\PUPERROR PUP \PUPE.LOOPED "Discarding Pup because too many gateway hops"))
		(T (BITBLT (SCREENBITMAP)
			   0 0 (SCREENBITMAP)
			   0 0 16 16 (QUOTE INVERT)
			   (QUOTE REPLACE))
		   [COND
		     ((AND \PUP.CHECKSUMFLG (NEQ CSUM MASKWORD1'S))
		       (replace PUPCHECKSUM of PUP
			  with (\UPDATECHECKSUM CSUM (fetch PUPTCONTROL of PUP)
						TRANSPORT
						(IDIFFERENCE (FOLDLO (SUB1 (fetch PUPLENGTH
									      of PUP))
								     BYTESPERWORD)
							     (PROG1 1 
                                                             (* (INDEXF (fetch PUPTCONTROL of PUP)))]
		   (replace PUPTCONTROL of PUP with TRANSPORT)
		   (add \PUP.ROUTEDPUPS 1)
		   (replace EPREQUEUE of PUP with (QUOTE FREE))
		   (AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUT)
					      NIL "Gateway: Forwarding Pup: "))
		   (TRANSMIT.ETHERPACKET NDB PUP)
		   (BLOCK)
		   (BITBLT (SCREENBITMAP)
			   0 0 (SCREENBITMAP)
			   0 0 16 16 (QUOTE INVERT)
			   (QUOTE REPLACE]
	    (T (add \PUP.ROUTEDBAD 1)
	       (AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
					  NIL "Gateway: Discarding Pup addressed to wrong gateway: "))
	       (\PUPERROR PUP \PUPE.WRONG.GATEWAY 
			  "Packet discarded because I'm not the gateway you want"])

(\UPDATECHECKSUM
  [LAMBDA (OLDCSUM OLDWORD NEWWORD #AFTERWORDS)              (* bvm: "10-NOV-83 23:03")

          (* * Compute a new checksum from OLDCSUM that results from changing OLDWORD to NEWWORD when there are #AFTERWORDS 
	  after the changed word)



          (* * (ONESCOMPLEMENTADD OLDCSUM (LEFTCYCLE (ONESCOMPLEMENTSUBTRACT NEWWORD OLDWORD) #AFTERWORDS)))


    MASKWORD1'S])

(\HANDLE.PUP.ADDRLOOKUP
  (LAMBDA (MISCSOC PUP)                                      (* ejs: " 6-AUG-83 07:07")

          (* * Address lookup)


    (DECLARE (GLOBALVARS \ETHERPORTS))
    (PROG ((PORT (CONS (GETPUPWORD PUP 0)
		       (\MAKENUMBER (GETPUPWORD PUP 1)
				    (GETPUPWORD PUP 2))))
	   NAME)
          (SETQ NAME (NetDirAddressLookup PORT))
          (SWAPPUPPORTS PUP)
          (COND
	    (NAME                                            (* Found it!)
		  (replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
		  (PUTPUPSTRING PUP NAME)
		  (replace (PUP PUPTYPE) of PUP with \PT.ADDRRESPONSE))
	    (T (replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
	       (replace (PUP PUPTYPE) of PUP with \PT.NAME/ADDRERROR)))
          (SENDPUP MISCSOC PUP)
          (\RELEASE.ETHERPACKET PUP))))

(\HANDLE.PUP.ALTOTIMEREQ
  [LAMBDA (MISCSOC PUP)                                      (* bvm: "16-NOV-83 10:48")

          (* * Alto time request)


    (PROG [(DATA (fetch (PUP PUPCONTENTS) of PUP))
	   (TIME (ALTO.TO.LISP.DATE (IDATE]
          (SWAPPUPPORTS PUP)
          (replace TIMEPUPVALUEHI of DATA with (\HINUM TIME))
          (replace TIMEPUPVALUELO of DATA with (\LONUM TIME))
          (COND
	    ((MINUSP \TimeZoneComp)
	      (replace TIMEPUPEASTP of DATA with T)
	      (replace TIMEPUPHOURS of DATA with (IMINUS \TimeZoneComp)))
	    (T (replace TIMEPUPEASTP of DATA with NIL)
	       (replace TIMEPUPHOURS of DATA with \TimeZoneComp)))
          (replace TIMEPUPMINUTES of DATA with 0)
          (replace TIMEPUPBEGINDST of DATA with \BeginDST)
          (replace TIMEPUPENDDST of DATA with \EndDST)
          (replace (PUP PUPTYPE) of PUP with \PT.ALTOTIMERESPONSE)
          (replace (PUP PUPLENGTH) of PUP with (CONSTANT (IPLUS \PUPOVLEN \TIMEPUPLENGTH)))
          (SENDPUP MISCSOC PUP)
          (\RELEASE.ETHERPACKET PUP])

(\HANDLE.PUP.MISC
  (LAMBDA (MISCSOC PUP)                                      (* ejs: " 6-AUG-83 07:53")

          (* * Handle a request for miscellaneous services)


    (SELECTC (fetch (PUP PUPTYPE) of PUP)
	     (\PT.NAMELOOKUP (\HANDLE.PUP.NAMELOOKUP MISCSOC PUP))
	     (\PT.ADDRLOOKUP (\HANDLE.PUP.ADDRLOOKUP MISCSOC PUP))
	     (\PT.ALTOTIMEREQUEST (\HANDLE.PUP.ALTOTIMEREQ MISCSOC PUP))
	     NIL)))

(\HANDLE.PUP.MISC.BACKGROUND
  (LAMBDA (MISCSOCKET)                                       (* edited: " 9-AUG-83 09:19")

          (* * Background processing for the miscserver)


    (DECLARE (GLOBALVARS NETDIRSTREAM))

          (* * Check for a new version of the pup-network.directory having arrived while we were sleeping)


    (COND
      ((IGREATERP (FILENAMEFIELD (INFILEP (QUOTE {DSK}PUP-NETWORK.DIRECTORY))
				 (QUOTE VERSION))
		  (FILENAMEFIELD (fetch (STREAM FULLFILENAME) of NETDIRSTREAM)
				 (QUOTE VERSION)))
	(CLOSEF NETDIRSTREAM)
	(SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
						(QUOTE INPUT)
						(QUOTE OLD))))))))

(\HANDLE.PUP.NAMELOOKUP
  (LAMBDA (MISCSOC PUP)                                      (* ejs: " 6-AUG-83 07:07")

          (* * Name lookup)


    (DECLARE (GLOBALVARS \ETHERPORTS))
    (PROG ((NAME (GETPUPSTRING PUP))
	   PORTS)
          (SETQ PORTS (OR (GETHASH (MKATOM NAME)
				   \ETHERPORTS)
			  (PUTHASH (MKATOM NAME)
				   (NetDirNameLookup NAME)
				   \ETHERPORTS)))
          (SWAPPUPPORTS PUP)
          (COND
	    (PORTS                                           (* Found it!)
		   (bind (I ← 0) for PORT in PORTS
		      do (PUTPUPWORD PUP I (CAR PORT))
			 (PUTPUPWORD PUP (ADD1 I)
				     (\HINUM (CDR PORT)))
			 (PUTPUPWORD PUP (IPLUS I 2)
				     (\LONUM (CDR PORT)))
			 (SETQ I (\ADDBASE I 3))
		      finally (replace (PUP PUPLENGTH) of PUP with (IPLUS \PUPOVLEN (LLSH I 1)))
			      (replace (PUP PUPTYPE) of PUP with \PT.NAMERESPONSE)))
	    (T (replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
	       (replace (PUP PUPTYPE) of PUP with \PT.NAME/ADDRERROR)))
          (SENDPUP MISCSOC PUP)
          (\RELEASE.ETHERPACKET PUP))))

(\HANDLE.PUP.ROUTING
  [LAMBDA (PUP GATESOC)                                      (* bvm: " 6-NOV-83 17:34")

          (* * Handle a pup received on the gateway socket)


    (SELECTC (fetch (PUP PUPTYPE) of PUP)
	     [\PT.GATEWAYRESPONSE (COND
				    ((NEQ (fetch (PUP PUPSOURCE) of PUP)
					  \LOCALPUPNETHOST)
				      (\HANDLE.PUP.ROUTING.INFO PUP]
	     (\PT.GATEWAYREQUEST [COND
				   ((AND (ZEROP (fetch (PUP PUPSOURCENET) of PUP))
					 (ZEROP (fetch (PUP PUPDESTHOST) of PUP)))
				     (replace (PUP PUPSOURCENET) of PUP with (fetch (PUP PUPDESTNET)
										of PUP]
				 (\BUILD.PUP.ROUTING.PACKET PUP GATESOC T)
				 (SWAPPUPPORTS PUP)
				 (SENDPUP GATESOC PUP))
	     (COND
	       (PUPTRACEFLG (PRINTPUP PUP (QUOTE GET)
				      NIL "Gateway: Received non-gateway Pup on gateway socket"])

(\PUPGATESERVER
  [LAMBDA NIL                                                (* bvm: "13-NOV-83 00:19")
    (PROG ((SOCKET (OPENPUPSOCKET \PUPSOCKET.ROUTING T))
	   (TIMER (SETUPTIMER 0))
	   PUP EVENT)
          (RESETSAVE NIL (LIST (QUOTE \PUPGATESERVERDYING)
			       SOCKET))
          (SETQ EVENT (PUPSOCKETEVENT SOCKET))
      LP  (COND
	    ((SETQ PUP (GETPUP SOCKET))
	      (\HANDLE.PUP.ROUTING PUP)
	      (BLOCK))
	    ((EQ (AWAIT.EVENT EVENT \RT.AGEINTERVAL)
		 EVENT)                                      (* Waiting for pup to arrive or timer to expire--pup 
							     arrived.)
	      (GO LP)))
          (COND
	    ((TIMEREXPIRED? TIMER)
	      (\AGE.ROUTING.TABLE \PUP.ROUTING.TABLE)
	      (SETUPTIMER \RT.AGEINTERVAL TIMER)
	      (\PUPGATE.BROADCAST SOCKET)))
          (GO LP])

(\PUPGATESERVERDYING
  [LAMBDA (SOCKET)                                           (* bvm: "13-NOV-83 00:14")
                                                             (* Called when \PUPGATESERVER is deleted)
    (COND
      ((NULL \GATEWAYFLG)                                    (* Tell everyone we're not a gateway anymore)
	(\PUPGATE.BROADCAST SOCKET T])

(\PUPGATE.BROADCAST
  [LAMBDA (SOCKET DYING)                                     (* bvm: "13-NOV-83 00:14")

          (* * Broadcast our routing table. If DYING, say we are maxhops away)


    (PROG ((PUP (ALLOCATE.PUP)))                             (* NOTE: this code is wrong if our routing table doesn't
							     fit in one pup!)
          (\BUILD.PUP.ROUTING.PACKET PUP SOCKET NIL DYING)
          [\MAP.ROUTING.TABLE \PUP.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
				  (COND
				    ((ZEROP (fetch (ROUTING RTHOPCOUNT) of NETWORK))
				      (replace (PUP PUPDESTNET) of PUP with (fetch (ROUTING RTNET#)
									       of NETWORK))
				      (replace (PUP PUPSOURCENET) of PUP with (fetch (ROUTING RTNET#)
										 of NETWORK))
				      (SENDPUP SOCKET PUP)
				      (BLOCK]
          (\RELEASE.ETHERPACKET PUP])

(\PUPMISCSERVER
  [LAMBDA NIL                                                (* bvm: "14-SEP-83 15:15")

          (* * The miscsellaneous services socket)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG ((SOCKET (OPENPUPSOCKET \PUPSOCKET.MISCSERVICES T))
	   (TIMER (SETUPTIMER \PUP.MISC.BACKGROUND.INTERVAL))
	   EVENT PUP)
          (SETQ EVENT (PUPSOCKETEVENT SOCKET))
          (SETQ NETDIRSTREAM (OPENSTREAM (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
					 (QUOTE INPUT)
					 (QUOTE OLD)))
      LP  (COND
	    ((SETQ PUP (GETPUP SOCKET))
	      (\HANDLE.PUP.MISC SOCKET PUP)
	      (BLOCK))
	    ((EQ (AWAIT.EVENT EVENT TIMER T)
		 EVENT)                                      (* Wait for a Pup)
	      (GO LP))
	    (T (\HANDLE.PUP.MISC.BACKGROUND SOCKET)
	       (SETUPTIMER \PUP.MISC.BACKGROUND.INTERVAL TIMER)))
          (GO LP])
)

(RPAQQ \PUP.ROUTEDBAD 0)

(RPAQQ \PUP.ROUTEDPUPS 0)

(RPAQQ GATEWAYSERVICES (\PUP.ID.SERVER \PUPGATESERVER \NSGATESERVER \PUPMISCSERVER))



(* NS Gateway)

(DEFINEQ

(\GATEWAY.FORWARD.XIP
  [LAMBDA (XIP)                                              (* bvm: "10-NOV-83 23:01")

          (* * XIP forwarding for Interlisp gateways)


    (PROG (CSUM NDB TRANSPORT)
          (COND
	    ([AND \NS.CHECKSUMFLG (NEQ (SETQ CSUM (fetch XIPCHECKSUM of XIP))
				       MASKWORD1'S)
		  (NEQ CSUM (\CHECKSUM (fetch XIPCHECKSUMBASE of XIP)
				       (SUB1 (FOLDHI (fetch XIPLENGTH of XIP)
						     BYTESPERWORD]
	      (add \XIP.ROUTEDBAD 1)
	      (AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
					 NIL "Gateway: Discarding XIP with bad checksum: "))
	      (\XIPERROR XIP \XIPE.GATEWAY.CHECKSUM))
	    [(SETQ NDB (\ROUTE.XIP XIP T))                   (* Update the hop count, rechecksum and transmit)
	      (SETQ TRANSPORT (fetch XIPTCONTROL of XIP))
	      (COND
		((IGEQ (add TRANSPORT 1)
		       15)
		  (add \XIP.ROUTEDBAD 1)
		  (AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
					     NIL "Gateway: Discarding looping XIP: "))
		  (\XIPERROR XIP \XIPE.LOOPED))
		(T (BITBLT (SCREENBITMAP)
			   0 0 (SCREENBITMAP)
			   0 0 16 16 (QUOTE INVERT)
			   (QUOTE REPLACE))
		   [COND
		     ((AND \NS.CHECKSUMFLG (NEQ CSUM MASKWORD1'S))
		       (replace XIPCHECKSUM of XIP
			  with (\UPDATECHECKSUM CSUM (fetch XIPTCONTROL of XIP)
						TRANSPORT
						(IDIFFERENCE (FOLDLO (SUB1 (fetch XIPLENGTH
									      of XIP))
								     BYTESPERWORD)
							     (PROG1 2 
                                                             (* (INDEXF (fetch XIPTCONTROL of XIP)))]
		   (replace XIPTCONTROL of XIP with TRANSPORT)
		   (add \XIP.ROUTEDGOOD 1)
		   (replace EPREQUEUE of XIP with (QUOTE FREE))
		   (AND XIPTRACEFLG (PRINTXIP XIP (QUOTE PUT)
					      NIL "Gateway: Forwarding XIP: "))
		   (TRANSMIT.ETHERPACKET NDB XIP)
		   (BLOCK)
		   (BITBLT (SCREENBITMAP)
			   0 0 (SCREENBITMAP)
			   0 0 16 16 (QUOTE INVERT)
			   (QUOTE REPLACE]
	    (T (add \XIP.ROUTEDBAD 1)
	       (AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
					  NIL "Gateway: Discarding XIP addressed to wrong gateway: "))
	       (\XIPERROR XIP \XIPE.NOROUTE])

(\NSGATESERVER
  [LAMBDA NIL                                                (* bvm: "13-NOV-83 00:19")
    (PROG ((SOCKET (OPENNSOCKET \NS.WKS.RoutingInformation T))
	   (TIMER (SETUPTIMER 0))
	   XIP EVENT)
          (RESETSAVE NIL (LIST (QUOTE \NSGATESERVERDYING)
			       SOCKET))
          (SETQ EVENT (NSOCKETEVENT SOCKET))
      LP  (COND
	    ((SETQ XIP (GETXIP SOCKET))
	      (\HANDLE.NS.ROUTING XIP)
	      (BLOCK))
	    ((EQ (AWAIT.EVENT EVENT \RT.AGEINTERVAL)
		 EVENT)                                      (* Waiting for pup to arrive or timer to expire--pup 
							     arrived.)
	      (GO LP)))
          (COND
	    ((TIMEREXPIRED? TIMER)
	      (\AGE.ROUTING.TABLE \XIP.ROUTING.TABLE)
	      (SETUPTIMER \RT.AGEINTERVAL TIMER)
	      (\NSGATE.BROADCAST SOCKET)))
          (GO LP])

(\NSGATESERVERDYING
  [LAMBDA (SOCKET)                                           (* bvm: "13-NOV-83 00:16")
                                                             (* Called when \NSGATESERVER is deleted)
    (COND
      ((NULL \GATEWAYFLG)                                    (* Tell everyone we're not a gateway anymore)
	(\NSGATE.BROADCAST SOCKET T])

(\NSGATE.BROADCAST
  [LAMBDA (SOCKET DYING)                                     (* bvm: "13-NOV-83 00:19")
    (PROG ((XIP (ALLOCATE.XIP)))                             (* Note: wrong if our routing table takes up more than 
							     one packet)
          (\BUILD.NS.ROUTING.PACKET XIP SOCKET NIL DYING)
          [\MAP.ROUTING.TABLE \NS.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
				  (COND
				    ((ZEROP (fetch (ROUTING RTHOPCOUNT) of NETWORK))
				      (replace (XIP XIPDESTNET) of XIP with (fetch (ROUTING RTNET#)
									       of NETWORK))
				      (replace (XIP XIPSOURCENET) of XIP with (fetch (ROUTING RTNET#)
										 of NETWORK))
				      (SENDXIP SOCKET XIP)
				      (BLOCK]
          (\RELEASE.ETHERPACKET XIP])

(\BUILD.NS.ROUTING.PACKET
  [LAMBDA (XIP GATESOC OLDXIPFLG DYING)                      (* bvm: "16-Dec-83 14:14")

          (* * Create a routing info XIP to be broadcast over all networks or as a reply to a routing request)


    (PROG ((BASE (fetch XIPCONTENTS of XIP))
	   (LENGTH (ADD1 \XIPOVLEN)))
          (replace XIPTYPE of XIP with \XIPT.ROUTINGINFO)
          (COND
	    ((NOT OLDXIPFLG)
	      (replace XIPSOURCENSADDRESS of XIP with (\LOCALNSADDRESS))
	      (replace XIPSOURCESOCKET of XIP with (fetch (NSOCKET ID#) of GATESOC))
	      (replace XIPDESTHOST of XIP with BROADCASTNSHOSTNUMBER)
	      (replace XIPDESTNET of XIP with 0)
	      (replace XIPDESTSOCKET of XIP with \NS.WKS.RoutingInformation)))
          (\PUTBASE BASE 0 \XROUTINGINFO.OP.RESPONSE)
          (SETQ BASE (\ADDBASE BASE 1))
          [\MAP.ROUTING.TABLE \NS.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
				  (replace (NSROUTINGINFO NET#) of BASE with (fetch (ROUTING RTNET#)
										of NETWORK))
				  [replace (NSROUTINGINFO #HOPS) of BASE
				     with (COND
					    (DYING \RT.INFINITY)
					    (T (ADD1 (fetch (ROUTING RTHOPCOUNT) of NETWORK]
				  (SETQ BASE (\ADDBASE BASE \NS.ROUTINGINFO.WORDS))
				  (add LENGTH (UNFOLD \NS.ROUTINGINFO.WORDS BYTESPERWORD]
          (replace (XIP XIPLENGTH) of XIP with LENGTH])

(\HANDLE.NS.ROUTING
  [LAMBDA (XIP GATESOC)                                      (* bvm: " 6-NOV-83 18:06")

          (* * Handle a XIP received on the gateway socket)


    (SELECTC (AND (EQ (fetch (XIP XIPTYPE) of XIP)
		      \XIPT.ROUTINGINFO)
		  (fetch XIPFIRSTDATAWORD of XIP))
	     [\XROUTINGINFO.OP.RESPONSE (COND
					  ((EQNSHOSTNUMBER (fetch (XIP XIPSOURCEHOST) of XIP)
							   (\LOCALNSHOSTNUMBER))
					    (RELEASE.XIP XIP))
					  (T (\HANDLE.NS.ROUTING.INFO XIP]
	     (\XROUTINGINFO.OP.REQUEST [COND
					 ((AND (ZEROP (fetch (XIP XIPSOURCENET) of XIP))
					       (ZEROP (fetch (XIP XIPDESTHOST) of XIP)))
					   (replace (XIP XIPSOURCENET) of XIP
					      with (fetch (XIP XIPDESTNET) of XIP]
				       (SWAPXIPADDRESSES XIP)
				       (\BUILD.NS.ROUTING.PACKET XIP GATESOC T)
				       (SENDXIP GATESOC XIP))
	     (PROGN (COND
		      (XIPTRACEFLG (PRINTXIP XIP (QUOTE GET)
					     NIL 
					    "Gateway: Received non-gateway Pup on gateway socket")))
		    (RELEASE.XIP XIP])
)

(RPAQQ \XIP.ROUTEDBAD 0)

(RPAQQ \XIP.ROUTEDGOOD 0)



(* Utilities for handling lookup requests)

(DEFINEQ

(AddressFromEntry
  (LAMBDA (ADDRESS)                                          (* ejs: " 5-AUG-83 15:31")

          (* * Given the address of an entry block in the network directory, return the address of the address block in the 
	  directory)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (COND
      (ADDRESS (SETFILEPTR NETDIRSTREAM (LLSH (ADD1 ADDRESS)
					      1))
	       (WORDIN NETDIRSTREAM)))))

(BCPLStringFromFile
  (LAMBDA (STREAM)                                           (* ejs: " 5-AUG-83 11:34")

          (* * Produce a string from the BCPL string in STREAM starting at current place in file)


    (PROG ((STRING (ALLOCSTRING (BIN STREAM))))
          (\BINS STREAM (fetch (STRINGP BASE) of STRING)
		 (fetch (STRINGP OFFST) of STRING)
		 (fetch (STRINGP LENGTH) of STRING))
          (RETURN STRING))))

(LOADBITS
  [LAMBDA (INTEGERLST RIGHTBIT SIZE)                         (* ejs: "14-SEP-83 13:15")
    (PROG (INTEGER WHICH REALBIT OVERFLOW)
          [SETQ INTEGER (CAR (FNTH (REVERSE INTEGERLST)
				   (ADD1 (SETQ WHICH (IQUOTIENT RIGHTBIT 16]
          (SETQ REALBIT (IDIFFERENCE RIGHTBIT (ITIMES 16 WHICH)))
          (RETURN (COND
		    [(NOT (IGEQ (SETQ OVERFLOW (IDIFFERENCE (IPLUS REALBIT (SUB1 SIZE))
							    16))
				0))
		      (LOGAND (LRSH INTEGER REALBIT)
			      (SUB1 (EXPT 2 SIZE]
		    (T (LOGOR (LOGAND (LRSH INTEGER REALBIT)
				      (SUB1 (EXPT 2 SIZE)))
			      (LLSH (LOADBITS INTEGERLST (ITIMES 16 (ADD1 WHICH))
					      (ADD1 OVERFLOW))
				    (IDIFFERENCE 16 REALBIT])

(MAKEOCTALSTRING
  [LAMBDA (WORDS)                                            (* ejs: "14-SEP-83 13:29")

          (* * Convert three 16 bit words to an octal string)


    (PROG ((STRING (ALLOCSTRING 16)))
          [for B from 0 to 47 by 3 as I from 1 do (\PUTBASEBYTE (fetch (STRINGP BASE) of STRING)
								(IPLUS (fetch (STRINGP OFFST)
									  of STRING)
								       (IDIFFERENCE 16 I))
								(IPLUS (CHARCODE 0)
								       (LOADBITS WORDS B 3]
          (for C instring STRING as I from 1 until (NEQ (CHARCODE 0)
							C)
	     finally (SUBSTRING STRING I NIL STRING))
          (RETURN STRING])

(NameFromAddress
  [LAMBDA (ADDRESS ONEFLG)                                   (* bvm: "10-NOV-83 23:07")

          (* * Given the address of an address block, return a name like ETHERHOSTNAME would)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (SOCKET NET/HOST (ADDRESSLIST (CONS)))
          (COND
	    ((NULL ADDRESS)
	      (RETURN)))
      LOOP[COND
	    ((AND (NUMBERP ADDRESS)
		  (NOT (ZEROP ADDRESS)))
	      (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDRESS 1)
					      4))
	      (SETQ NET/HOST (WORDIN NETDIRSTREAM))
	      (SETQ SOCKET (\MAKENUMBER (WORDIN NETDIRSTREAM)
					(WORDIN NETDIRSTREAM)))
	      (TCONC ADDRESSLIST (CONS NET/HOST SOCKET))
	      (SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
	      (SETQ ADDRESS (WORDIN NETDIRSTREAM)))
	    (T (RETURN (CAR ADDRESSLIST]
          (COND
	    (ONEFLG (RETURN (CAR ADDRESSLIST)))
	    (T (GO LOOP])

(NetDirAddressLookup
  (LAMBDA (PORT)                                             (* ejs: " 6-AUG-83 06:51")

          (* * Digest a pup network directory and lookup a port)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (ENTRYADDRESS ADDRBLOCKCNT ADDRBLOCKTABLE)
          (COND
	    ((OR (NULL NETDIRSTREAM)
		 (NOT (OPENP NETDIRSTREAM)))
	      (SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
						      (QUOTE INPUT)
						      (QUOTE OLD))
					    (QUOTE INPUT)))))
          (SETFILEPTR NETDIRSTREAM 4)
          (SETQ ADDRBLOCKCNT (WORDIN NETDIRSTREAM))
          (SETQ ADDRBLOCKTABLE (WORDIN NETDIRSTREAM))
          (RETURN (NameFromEntry (SearchNetDirForAddress PORT ADDRBLOCKTABLE ADDRBLOCKCNT))))))

(NetDirNameLookup
  (LAMBDA (NAME)                                             (* ejs: " 6-AUG-83 06:09")

          (* * Digest a pup network directory and lookup a name)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (ENTRYADDRESS (NAMEBLOCKCNT (CREATECELL \FIXP))
			(NAMEBLOCKTABLE (CREATECELL \FIXP)))
          (COND
	    ((OR (NULL NETDIRSTREAM)
		 (NOT (OPENP NETDIRSTREAM)))
	      (SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
						      (QUOTE INPUT)
						      (QUOTE OLD))
					    (QUOTE INPUT)))))
          (SETQ NAMEBLOCKCNT (WORDCONTENTS (MAPWORD 0 NETDIRSTREAM)))
          (SETQ NAMEBLOCKTABLE (WORDCONTENTS (MAPWORD 1 NETDIRSTREAM)))
          (RETURN (PortFromAddress (AddressFromEntry (SearchNetDirForName NAME NAMEBLOCKTABLE 
									  NAMEBLOCKCNT)))))))

(PortCompare
  (LAMBDA (PORT1 PORT2)                                      (* ejs: " 6-AUG-83 06:22")

          (* * Compare two ports for equality. A port is a (NET/HOST . SOCKET) dotted pair)


    (COND
      ((ILESSP (CAR PORT1)
	       (CAR PORT2))
	(QUOTE LESS))
      ((IGREATERP (CAR PORT1)
		  (CAR PORT2))
	(QUOTE GREATER))
      ((ILESSP (CDR PORT1)
	       (CDR PORT2))
	(QUOTE LESS))
      ((IGREATERP (CDR PORT1)
		  (CDR PORT2))
	(QUOTE GREATER))
      (T (QUOTE EQ)))))

(PortFromAddress
  (LAMBDA (ADDRESS ONEFLG)                                   (* ejs: " 6-AUG-83 06:37")

          (* * Given the address of an address block, return a port, like ETHERPORT would)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (SOCKET NET/HOST (ADDRESSLIST (CONS)))
          (COND
	    ((NULL ADDRESS)
	      (RETURN)))
      LOOP(COND
	    ((AND (NUMBERP ADDRESS)
		  (NOT (ZEROP ADDRESS)))
	      (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDRESS 1)
					      4))
	      (SETQ NET/HOST (WORDIN NETDIRSTREAM))
	      (SETQ SOCKET (\MAKENUMBER (WORDIN NETDIRSTREAM)
					(WORDIN NETDIRSTREAM)))
	      (TCONC ADDRESSLIST (CONS NET/HOST SOCKET))
	      (SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
	      (SETQ ADDRESS (WORDIN NETDIRSTREAM)))
	    (T (RETURN (CAR ADDRESSLIST))))
          (COND
	    (ONEFLG (RETURN (CAAR ADDRESSLIST)))
	    (T (GO LOOP))))))

(PrintNameBlock
  (LAMBDA (A)
    (DECLARE (GLOBALVARS NETDIRSTREAM))                      (* ejs: " 6-AUG-83 19:18")
    (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH A 1)
				    4))
    (PRINT (BCPLStringFromFile NETDIRSTREAM))))

(SearchNetDirForAddress
  (LAMBDA (PORT BLOCK LENGTH)                                (* ejs: " 6-AUG-83 06:57")

          (* * Binary search for name in the name block)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (PORT1 PROBE ADDR DONE (BOTTOM 0)
		 (TOP (SUB1 LENGTH)))
          (until (OR (AND (EQ (IDIFFERENCE TOP BOTTOM)
			      1)
			  (NOT (EQUAL PORT PORT1)))
		     DONE)
	     eachtime (SETQ PROBE (LRSH (IPLUS TOP BOTTOM)
					1))
	     do (SETFILEPTR NETDIRSTREAM (LLSH (IPLUS PROBE BLOCK)
					       1))
		(SETQ ADDR (WORDIN NETDIRSTREAM))
		(SETQ PORT1 (PortFromAddress ADDR T))
		(SELECTQ (PortCompare PORT PORT1)
			 (EQ (SETQ DONE T))
			 (LESS (SETQ TOP PROBE))
			 (SETQ BOTTOM PROBE)))
          (RETURN (COND
		    (DONE (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
							  2))
			  (WORDIN NETDIRSTREAM))
		    (T NIL))))))

(SearchNetDirForName
  (LAMBDA (NAME BLOCK LENGTH)                                (* ejs: " 6-AUG-83 19:34")

          (* * Binary search for name in the name block)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (PROG (STRING PROBE ADDR DONE (BOTTOM 0)
		  (TOP (SUB1 LENGTH)))
          (bind FAIL? FAIL until (OR FAIL DONE) eachtime (SETQ PROBE (LRSH (IPLUS TOP BOTTOM)
									   1))
	     do (SETFILEPTR NETDIRSTREAM (LLSH (IPLUS PROBE BLOCK)
					       1))
		(SETQ ADDR (WORDIN NETDIRSTREAM))
		(SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
						4))
		(SETQ STRING (BCPLStringFromFile NETDIRSTREAM))
		(COND
		  (FAIL? (SETQ FAIL T)))
		(SELECTQ (StringCompare NAME STRING)
			 (EQ (SETQ DONE T))
			 (LESS (COND
				 ((EQ TOP PROBE)
				   (SETQ TOP BOTTOM)
				   (SETQ FAIL? T))
				 (T (SETQ TOP PROBE))))
			 (COND
			   ((EQ BOTTOM PROBE)
			     (SETQ BOTTOM TOP)
			     (SETQ FAIL? T))
			   (T (SETQ BOTTOM PROBE)))))
          (RETURN (COND
		    (DONE (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
							  2))
			  (WORDIN NETDIRSTREAM))
		    (T NIL))))))

(StringCompare
  [LAMBDA (S1 S2)                                            (* bvm: "28-OCT-83 16:29")
    (PROG (S1BASE S1LEN S1OFFSET S2BASE S2LEN S2OFFSET C1 C2)
          [COND
	    ((LITATOM S1)
	      (SETQ S1BASE (fetch (LITATOM PNAMEBASE) of S1))
	      (SETQ S1OFFSET 1)
	      (SETQ S1LEN (fetch (LITATOM PNAMELENGTH) of S1)))
	    (T (OR (STRINGP S1)
		   (SETQ S1 (MKSTRING S1)))
	       (SETQ S1BASE (fetch (STRINGP BASE) of S1))
	       (SETQ S1OFFSET (fetch (STRINGP OFFST) of S1))
	       (SETQ S1LEN (fetch (STRINGP LENGTH) of S1]
          [COND
	    ((LITATOM S2)
	      (SETQ S2BASE (fetch (LITATOM PNAMEBASE) of S2))
	      (SETQ S2OFFSET 1)
	      (SETQ S2LEN (fetch (LITATOM PNAMELENGTH) of S2)))
	    (T (OR (STRINGP S2)
		   (SETQ S2 (MKSTRING S2)))
	       (SETQ S2BASE (fetch (STRINGP BASE) of S2))
	       (SETQ S2OFFSET (fetch (STRINGP OFFST) of S2))
	       (SETQ S2LEN (fetch (STRINGP LENGTH) of S2]
          (RETURN (for I from 0 do (COND
				     [(IGEQ I S1LEN)
				       (RETURN (COND
						 ((EQ S1LEN S2LEN)
						   (QUOTE EQ))
						 (T (QUOTE LESS]
				     ((IGEQ I S2LEN)
				       (RETURN (QUOTE GREATER)))
				     [(EQ (SETQ C1 (\GETBASEBYTE S1BASE (IPLUS I S1OFFSET)))
					  (SETQ C2 (\GETBASEBYTE S2BASE (IPLUS I S2OFFSET]
				     (T [COND
					  ((AND (IGEQ C1 (CHARCODE a))
						(ILEQ C1 (CHARCODE z)))
					    (SETQ C1 (IDIFFERENCE C1 (IDIFFERENCE (CHARCODE a)
										  (CHARCODE A]
					[COND
					  ((AND (IGEQ C2 (CHARCODE a))
						(ILEQ C2 (CHARCODE z)))
					    (SETQ C2 (IDIFFERENCE C2 (IDIFFERENCE (CHARCODE a)
										  (CHARCODE A]
					(COND
					  ((EQ C1 C2))
					  ((ILESSP C1 C2)
					    (RETURN (QUOTE LESS)))
					  (T (RETURN (QUOTE GREATER])
)



(* Currently unused)

(DEFINEQ

(MapNameTable
  (LAMBDA (FN)
    (DECLARE (GLOBALVARS NETDIRSTREAM))                      (* ejs: " 6-AUG-83 19:15")
    (PROG (NAMEBLOCKTABLE NAMEBLOCKCNT)
          (SETFILEPTR NETDIRSTREAM 0)
          (SETQ NAMEBLOCKCNT (WORDIN NETDIRSTREAM))
          (SETQ NAMEBLOCKTABLE (WORDIN NETDIRSTREAM))
          (for I from 1 to NAMEBLOCKCNT
	     do (SETFILEPTR NETDIRSTREAM (LLSH NAMEBLOCKTABLE 1))
		(APPLY FN (LIST (WORDIN NETDIRSTREAM)))
		(SETQ NAMEBLOCKTABLE (ADD1 NAMEBLOCKTABLE))))))

(NameFromEntry
  (LAMBDA (ADDRESS)                                          (* ejs: " 6-AUG-83 06:29")

          (* * Given the address of an entry block, return the primary name)


    (DECLARE (GLOBALVARS NETDIRSTREAM))
    (COND
      (ADDRESS (SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
	       (SETFILEPTR NETDIRSTREAM (LLSH (IPLUS (WORDIN NETDIRSTREAM)
						     2)
					      1))
	       (BCPLStringFromFile NETDIRSTREAM)))))
)

(RPAQ? \GATEWAYFLG )

(RPAQ? \PUP.MISC.BACKGROUND.INTERVAL 300000)

(RPAQ? EXTRA10MBTRANSLATIONLST )

(RPAQ? LOCALNETWORKLST )
(RPAQ GATEWAYCURSOR (CURSORCREATE (READBITMAP) 0 15))
(16 16
"@@@@"
"OOOO"
"OOOO"
"D@@@"
"DOO@"
"DHA@"
"GJM@"
"@HA@"
"@HAN"
"@HAB"
"@OOB"
"@@@B"
"OOOO"
"OOOO"
"@@@@"
"@@@@")(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \TIMEPUPLENGTH 10)

(CONSTANTS \TIMEPUPLENGTH)
)

[DECLARE: EVAL@COMPILE 

(BLOCKRECORD PUPROUTINGINFO (                                (* Format of each entry in a pup routing info packet.
							     We only actually use NET# and #HOPS)
			     (NET# BYTE)
			     (GATENET# BYTE)
			     (GATEHOST# BYTE)
			     (#HOPS BYTE)))

(BLOCKRECORD TIMEPUPCONTENTS ((TIMEPUPVALUEHI WORD)
			      (TIMEPUPVALUELO WORD)
			      (TIMEPUPEASTP FLAG)
			      (TIMEPUPHOURS BITS 7)
			      (TIMEPUPMINUTES BITS 8)
			      (TIMEPUPBEGINDST WORD)
			      (TIMEPUPENDDST WORD))          (* format of alto time response)
			     )
]

(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \PUP.ROUTEDBAD \PUP.ROUTEDPUPS \XIP.ROUTEDBAD \XIP.ROUTEDGOOD)
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS WORDIN DMACRO (= . \WIN))

(PUTPROPS WORDOUT DMACRO (= . \WOUT))
)

(FILESLOAD (SOURCE)
	   ETHERRECORDS)

(FILESLOAD (LOADCOMP)
	   LLETHER LLNS)
)
(FILESLOAD PUPIDSERVER)
(PUTPROPS GATEWAY COPYRIGHT ("Schlumberger Technology Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1958 6844 (GATEWAY 1968 . 3413) (GATEWAY.BYE 3415 . 3862) (\INIT.GATEWAY 3864 . 6842)) 
(6869 18931 (\BUILD.PUP.ROUTING.PACKET 6879 . 7904) (\GATEWAY.FORWARD.PUP 7906 . 10288) (
\UPDATECHECKSUM 10290 . 10699) (\HANDLE.PUP.ADDRLOOKUP 10701 . 11573) (\HANDLE.PUP.ALTOTIMEREQ 11575
 . 12775) (\HANDLE.PUP.MISC 12777 . 13218) (\HANDLE.PUP.MISC.BACKGROUND 13220 . 13919) (
\HANDLE.PUP.NAMELOOKUP 13921 . 15072) (\HANDLE.PUP.ROUTING 15074 . 15953) (\PUPGATESERVER 15955 . 
16779) (\PUPGATESERVERDYING 16781 . 17161) (\PUPGATE.BROADCAST 17163 . 18062) (\PUPMISCSERVER 18064 . 
18929)) (19106 25883 (\GATEWAY.FORWARD.XIP 19116 . 21309) (\NSGATESERVER 21311 . 22135) (
\NSGATESERVERDYING 22137 . 22514) (\NSGATE.BROADCAST 22516 . 23320) (\BUILD.NS.ROUTING.PACKET 23322 . 
24791) (\HANDLE.NS.ROUTING 24793 . 25881)) (25996 36305 (AddressFromEntry 26006 . 26433) (
BCPLStringFromFile 26435 . 26889) (LOADBITS 26891 . 27606) (MAKEOCTALSTRING 27608 . 28308) (
NameFromAddress 28310 . 29198) (NetDirAddressLookup 29200 . 29970) (NetDirNameLookup 29972 . 30816) (
PortCompare 30818 . 31319) (PortFromAddress 31321 . 32214) (PrintNameBlock 32216 . 32456) (
SearchNetDirForAddress 32458 . 33352) (SearchNetDirForName 33354 . 34472) (StringCompare 34474 . 36303
)) (36335 37321 (MapNameTable 36345 . 36864) (NameFromEntry 36866 . 37319)))))
STOP