(FILECREATED "15-Feb-85 22:31:06" {ERIS}<LISPCORE>SOURCES>PUP.;8
 250660Q

      changes to:  (FNS \HANDLE.RAW.PUP \ROUTE.PUP)

      previous date: "30-Jan-85 22:33:23" {ERIS}<LISPCORE>SOURCES>PUP.;7)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PUPCOMS)

(RPAQQ PUPCOMS
 ((E (RESETSAVE (RADIX 8)))
		(COMS (* Low level pup)
		      (DECLARE: DONTCOPY (EXPORT (RECORDS PUP PUPADDRESS)
						 (MACROS \LOCALPUPADDRESS \LOCALPUPHOSTNUMBER 
							 \LOCALPUPNETNUMBER))
				(GLOBALVARS \LOCALPUPNETHOST \OLDPUPHOST#))
		      (FNS \STARTPUP ASSURE.PUP.READY \FIND.LOCALPUPHOSTNUMBER \PROMPT.FOR.PUP.NUMBER 
			   \HANDLE.RAW.PUP \FORWARD.PUP \SETPUPCHECKSUM)
		      (INITVARS (\PUP.CHECKSUMFLG T)
				(\MAX.EPKTS.ON.PUPSOCKET 16)
				(\LOCALPUPNETHOST)
				(\OLDPUPHOST# 0)))
		(COMS (* Pup error stuff)
		      (DECLARE: DONTCOPY (EXPORT (RECORDS ERRORPUP)
						 (CONSTANTS * PUPERRORCODES))
				(GLOBALVARS PUPERRORMESSAGES))
		      (VARS PUPERRORMESSAGES)
		      (FNS \PUPERROR))
		(COMS (* Pup utilities)
		      (FNS SETUPPUP SWAPPUPPORTS GETPUP SENDPUP EXCHANGEPUPS DISCARDPUPS GETPUPWORD 
			   \PUPINIT)
		      (FNS ETHERHOSTNAME ETHERHOSTNUMBER ETHERPORT BESTPUPADDRESS NETDAYTIME0 
			   \PUP.SETTIME \SETNEWTIME0 \NET.SETTIME NETDATE \LOOKUPPORT 
			   \PARSE.PORTCONSTANT \FIXLOCALNET)
		      (FNS PORTSTRING OCTALSTRING)
		      (INITVARS (\ETHERPORTS (HASHARRAY 20))
				(\ETHERTIMEOUT 2000)
				(\MAXETHERTRIES 4)
				(\PUPCOUNTER 0))
		      (GLOBALVARS \ETHERPORTS \PUPCOUNTER))
		(COMS (* Accessing a PUP's contents)
		      (FNS CLEARPUP PUTPUPWORD GETPUPBYTE PUTPUPBYTE GETPUPSTRING GETPUPSTREAM 
			   PUTPUPSTRING READPLIST \STOREPLIST)
		      (MACROS GETPUPWORD PUTPUPWORD GETPUPBYTE PUTPUPBYTE))
		(COMS (FNS \CANONICAL.HOSTNAME CANONICAL.HOSTNAME)
		      (ADDVARS (\HOSTNAMES)
			       (\SYSTEMCACHEVARS \HOSTNAMES))
		      (GLOBALVARS \HOSTNAMES))
		[COMS (* PUP allocation)
		      (EXPORT (MACROS BINDPUPS)
			      (PROP INFO BINDPUPS)
			      (ALISTS (PRETTYPRINTMACROS BINDPUPS]
		(COMS (* Pup routing)
		      (FNS \PUPGATELISTENER \HANDLE.PUP.ROUTING.INFO \ROUTE.PUP \LOCATE.PUPNET 
			   SORT.PUPHOSTS.BY.DISTANCE \PUPNET.CLOSERP PUPNET.DISTANCE)
		      (INITVARS (\PUP.ROUTING.TABLE (CONS))
				(\PUP.ROUTING.TABLE.RADIUS 2)
				(\PUPROUTER.PROBECOUNT 0)
				(\PUPROUTER.PROBETIMER)
				(\PUPROUTER.PROBEINTERVAL 3000)
				(\PUP.READY)
				(\PUP.READY.EVENT (CREATE.EVENT "Pup Ready"))
				(\PUP.READY.LOCK (CREATE.MONITORLOCK "Pup Ready")))
		      (ADDVARS (\SYSTEMCACHEVARS \PUP.READY))
		      (DECLARE: DONTCOPY (RECORDS PUPROUTINGINFO)
				(CONSTANTS \PUP.ROUTINGINFO.WORDS)
				(GLOBALVARS \PUP.ROUTING.TABLE \PUP.ROUTING.TABLE.RADIUS 
					    \PUPROUTER.PROBECOUNT \PUPROUTER.PROBETIMER 
					    \PUPROUTER.PROBEINTERVAL \PUP.READY \PUP.READY.EVENT 
					    \PUP.READY.LOCK)))
		(COMS (* Sockets)
		      (DECLARE: DONTCOPY (RECORDS PUPSOCKET)
				(MACROS \PUPSOCKET.FROM#)
				(GLOBALVARS \PUPSOCKETS.TABLE \MAX.EPKTS.ON.PUPSOCKET 
					    \PUP.CHECKSUMFLG))
		      (INITRECORDS PUPSOCKET)
		      (SYSRECORDS PUPSOCKET)
		      (FNS OPENPUPSOCKET CLOSEPUPSOCKET PUPSOCKETNUMBER PUPSOCKETFROMNUMBER 
			   PUPSOCKETEVENT \FLUSHPUPSOCQUEUE)
		      (FNS \GETMISCSOCKET)
		      (GLOBALVARS \MISC.SOCKET \PUPSOCKETS)
		      (INITVARS (\MISC.SOCKET)
				(\PUPSOCKETS)))
		(DECLARE: DONTCOPY (EXPORT (RECORDS PORT ERRORPUP)
					   (GLOBALVARS \ETHERWAIT1 \ETHERTIMEOUT \MAXETHERTRIES 
						       PUPTRACEFLG LOGINPASSWORDS)
					   (GLOBALVARS PUPTRACEFILE PUPONLYTYPES PUPIGNORETYPES 
						       PUPPRINTMACROS)
					   (CONSTANTS (\PUPOVLEN 22)
						      (\MAX.PUPLENGTH 532)
						      (\TIME.GETPUP 5))
					   (PROP VARTYPE PUPPRINTMACROS)
					   (I.S.OPRS INCHARS)
					   (MACROS \GETPUPWORD \PUTPUPWORD \GETPUPBYTE \PUTPUPBYTE)
					   (CONSTANTS * RAWPUPTYPES)
					   (INITVARS (PUPTYPES RAWPUPTYPES))
					   (CONSTANTS * WELLKNOWNPUPSOCKETS))
			  (CONSTANTS * PUPCONSTANTS)
			  (MACROS PUPDEBUGGING)
			  (ALISTS (PUPPRINTMACROS 136 140 137 139 129 24))
			  (RECORDS TIMEPUPCONTENTS))
		(COMS (* echo utilities)
		      (FNS PUP.ECHOSERVER PUP.ECHOUSER))
		(COMS (* Peeking)
		      (FNS \PEEKPUP \MAYBEPEEKPUP)
		      (INITVARS (\PEEKPUPNUMBER))
		      (DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS \ETHERHOSTLOC)
				(GLOBALVARS \PEEKPUPNUMBER)))
		(COMS (* Debugging assistance)
		      (FNS PRINTPUP PRINTPUPROUTE PRINTPUPDATA PRINTERRORPUP PUPTRACE 
			   \CHANGE.ETHER.TRACING PRINTCONSTANT)
		      (INITVARS (PUPTRACEFLG)
				(PUPTRACEFILE T)
				(PUPTRACETIME))
		      (GLOBALVARS PUPTRACETIME)
		      (ADDVARS (PUPPRINTMACROS)
			       (PUPONLYTYPES)
			       (PUPIGNORETYPES))
		      (ALISTS (PUPPRINTMACROS 4 144 145 147 148)))
		(COMS (FNS \CENTICLOCK)
		      [VARS (\CENTICLOCKFACTOR)
			    (\CENTICLOCKBOX (NCREATE (QUOTE FIXP]
		      (ADDVARS (\SYSTEMCACHEVARS \CENTICLOCKFACTOR))
		      (DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS \CENTICLOCKFACTOR \CENTICLOCKBOX)
				(RECORDS CENTICLOCK)))
		(DECLARE: DONTEVAL@LOAD (P (\PUPINIT)))
		(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
						       LLETHER))))



(* Low level pup)


(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(ACCESSFNS PUP
 [(PUPBASE (LOCF (fetch
 (ETHERPACKET EPBODY) of
 DATUM]
	       [
BLOCKRECORD
 PUPBASE ((PUPLENGTH WORD)
			     (PUPTCONTROL BYTE)
			     (PUPTYPE BYTE)
			     (PUPID FIXP)
			     (PUPDEST WORD)
			     (PUPDESTSOCKET FIXP)
			     (PUPSOURCE WORD)
			     (PUPSOURCESOCKET FIXP)
			     (PUPDATASTART 412Q WORD))
			    (
BLOCKRECORD
 PUPBASE ((NIL WORD)
					  (TYPEWORD WORD)
					  (PUPIDHI WORD)
					  (PUPIDLO WORD)
					  (PUPDESTNET BYTE)
					  (PUPDESTHOST BYTE)
					  (PUPDESTSOCKETHI WORD)
					  (PUPDESTSOCKETLO WORD)
					  (PUPSOURCENET BYTE)
					  (PUPSOURCEHOST BYTE)
					  (PUPSOURCESOCKETHI WORD)
					  (PUPSOURCESOCKETLO WORD))
                                                             (* Temporary extra synonyms)

					 (
SYNONYM
 PUPDESTNET (DESTNET))
					 (
SYNONYM
 PUPDESTHOST (DESTHOST))
					 (
SYNONYM
 PUPDESTSOCKETHI (DESTSKTHI))
					 (
SYNONYM
 PUPDESTSOCKETLO (DESTSKTLO))
					 (
SYNONYM
 PUPSOURCENET (SOURCENET))
					 (
SYNONYM
 PUPSOURCEHOST (SOURCEHOST))
					 (
SYNONYM
 PUPSOURCESOCKETHI (SOURCESKTHI))
					 (
SYNONYM
 PUPSOURCESOCKETLO (SOURCESKTLO)))
			    (
SYNONYM
 PUPDEST (DEST))
			    (
SYNONYM
 PUPDESTSOCKET (DESTSKT))
			    (
SYNONYM
 PUPSOURCE (SOURCE))
			    (
SYNONYM
 PUPSOURCESOCKET (SOURCESKT))
			    (
ACCESSFNS
 PUPDATASTART ((PUPCONTENTS (LOCF DATUM]
	       [
ACCESSFNS
 PUP [(PUPCHECKSUMBASE (fetch
 PUPBASE of
 DATUM))
			   (PUPCHECKSUMLOC (
\ADDBASE
 (fetch
 PUPBASE of
 DATUM)
						     (FOLDLO (
SUB1
 (fetch
 PUPLENGTH of
 DATUM))
							     BYTESPERWORD]
			  (
BLOCKRECORD
 PUPCHECKSUMLOC ((PUPCHECKSUM WORD]
	       (TYPE?
 (type?
 ETHERPACKET DATUM)))

(ACCESSFNS PUPADDRESS
 ((PUPNET# (
LRSH
 DATUM 10Q))
		       (PUPHOST# (
LOGAND
 DATUM 377Q)))
		      (CREATE
 (
IPLUS
 (
LLSH
 PUPNET# 10Q)
				     PUPHOST#)))
]
(DECLARE: EVAL@COMPILE 

(PUTPROPS \LOCALPUPADDRESS MACRO
 (NIL \LOCALPUPNETHOST))

(PUTPROPS \LOCALPUPHOSTNUMBER MACRO
 (NIL (fetch
 PUPHOST# of
 \LOCALPUPNETHOST)))

(PUTPROPS \LOCALPUPNETNUMBER MACRO
 (NIL (fetch
 PUPNET# of
 \LOCALPUPNETHOST)))
)


(* END EXPORTED DEFINITIONS)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \LOCALPUPNETHOST \OLDPUPHOST#)
)
)
(DEFINEQ

(\STARTPUP

  [LAMBDA (EVENT)                                            (* bvm: "26-Jul-84 15:57")

    (for
 SOC in
 \PUPSOCKETS
       do
                                                    (* Flush any pups waiting on existing sockets.

							     Not only are they stale, but they will have the wrong 

							     NDB)

	  (\FLUSHPUPSOCQUEUE
 SOC))
    (ASSURE.PUP.READY
 T])

(ASSURE.PUP.READY

  [LAMBDA (QUIET)                                            (* bvm: "26-Jul-84 15:56")

                                                             (* Assures that Pup software is enabled.

							     PUP is turned off after exit until somebody indicates a 

							     need for it)

    (WITH.MONITOR \PUP.READY.LOCK (COND
		    ((NULL \PUP.READY)
		      (PROG ((NDB \LOCALNDBS)
			     (PROC (FIND.PROCESS (QUOTE \PUPGATELISTENER)))
			     MYHOST#)
			    (COND
			      ((NULL NDB)
				(SETQ \PUP.READY (QUOTE NO))
				(SETQ \LOCALPUPNETHOST 0)
				(AND PROC (DEL.PROCESS PROC))
				(RETURN)))
			LP  (COND
			      ((NEQ (fetch
 NDBPUPHOST# of
 NDB)
				    0)
				(SETQ MYHOST# (fetch
 NDBPUPHOST# of
 NDB)))
			      ([NULL (OR MYHOST# (SETQ MYHOST# (\FIND.LOCALPUPHOSTNUMBER
 NDB EVENT 
											 QUIET]
				(SETQ \LOCALPUPNETHOST 0)    (* Don't know our pup number yet, so wait until somebody

							     actually asks for pup service)

				(\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.PUP))
				(AND PROC (DEL.PROCESS PROC))
				(RETURN))
			      (T (replace
 NDBPUPHOST# of
 NDB with
 MYHOST#)))
			    (COND
			      ((SETQ NDB (fetch
 NDBNEXT of
 NDB))
				(GO LP)))
			    (SETQ \LOCALPUPNETHOST (create
 PUPADDRESS
							   PUPNET# _(fetch
 NDBPUPNET# of
 \LOCALNDBS)
							   PUPHOST# _ MYHOST#))
			    (SETQ \OLDPUPHOST# MYHOST#)
			    [COND
			      (\10MBFLG (\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.3TO10)))
			      (T (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.3TO10]
			    (COND
			      (\GATEWAYFLG (AND PROC (DEL.PROCESS PROC)))
			      (PROC                          (* Restart proc because it contains local timer that is 

							     now garbage)

				    (RESTART.PROCESS PROC))
			      (T (ADD.PROCESS (QUOTE (\PUPGATELISTENER
))
					      (QUOTE RESTARTABLE)
					      (QUOTE SYSTEM)
					      (QUOTE AFTEREXIT)
					      \PUP.READY.EVENT)))
			    (\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.PUP))
			    (SETQ \PUP.READY T)
			    (NOTIFY.EVENT \PUP.READY.EVENT)
			    (\LOCATE.PUPNET
 0)               (* Initiate a probe to find out where we are and get 

							     routing)

			    (BLOCK])

(\FIND.LOCALPUPHOSTNUMBER

  [LAMBDA (NDB EVENT QUIET)                                  (* bvm: "26-Jul-84 16:27")

                                                             (* Finds out our pup address on this 10mb NDB)

    (PROG (NEWNUMBER)
          [COND
	    [(SETQ NEWNUMBER (\LOOKUPPUPNUMBER \MY.NSHOSTNUMBER NDB))
	      (COND
		(PUPTRACEFLG (printout
 PUPTRACEFILE "My pup address = " (fetch
 PUPNET# of
 NEWNUMBER)
				       "#"
				       (fetch
 PUPHOST# of
 NEWNUMBER)
				       "#" T]
	    (QUIET (RETURN NIL))
	    (T (SETQ NEWNUMBER (\PROMPT.FOR.PUP.NUMBER
 (AND (EQ EVENT (QUOTE AFTERLOGOUT))
							    (NEQ \OLDPUPHOST# 0)
							    (OCTALSTRING
 \OLDPUPHOST#]
                                                             (* Only rely on the host number part of reply.

							     There is confusion for machines that exist on more than 

							     one net)

          (RETURN (fetch
 PUPHOST# of
 NEWNUMBER])

(\PROMPT.FOR.PUP.NUMBER

  [LAMBDA (DEFAULT)                                          (* bvm: "26-Jul-84 16:30")

    (RESETLST (PROVIDE.PROMPTING.WINDOW "Ethernet info needed")
	      (RESETBUFS (PROG (NEWNUMBER)
			   LP  (SETQ NEWNUMBER (PACK* (PROMPTFORWORD 
						    "Please enter my pup host number (in octal):"
								     DEFAULT NIL NIL NIL T)
						      (QUOTE Q)))
			       (TERPRI T)
			       (COND
				 ((OR (NOT (FIXP NEWNUMBER))
				      (ILEQ NEWNUMBER 0)
				      (IGEQ NEWNUMBER 376Q))
				   (printout
 T T "Pup host number must be between 1 and 376" T T)
				   (CLEARBUF T)
				   (FLASHWINDOW (TTYDISPLAYSTREAM))
				   (GO LP)))
			       (RETURN NEWNUMBER])

(\HANDLE.RAW.PUP

  [LAMBDA (PACKET TYPE)                                      (* bvm: "15-Feb-85 22:20")

                                                             (* Handles the arrival of a PUP.

							     If it is destined for a local socket that has room, 

							     queues it there, else releases it)

    (
COND

      ((
EQ
 TYPE (ffetch
 NDBPUPTYPE of
 (ffetch
 EPNETWORK of
 PACKET)))
	[
COND

	  ((
NULL
 \PUP.READY)
	    (
RELEASE.PUP
 PACKET))
	  (T (
PROG
 ((NDB (fetch
 EPNETWORK of
 PACKET))
		    CSUM PUPSOC DESTNET MYNET)
	           [
COND

		     ((
AND
 (
NEQ
 (fetch
 PUPDESTHOST of
 PACKET)
				(fetch
 NDBPUPHOST# of
 NDB))
			   (
NEQ
 (fetch
 PUPDESTHOST of
 PACKET)
				0))
		       (
RETURN
 (\FORWARD.PUP
 PACKET]
	           [
COND

		     ((
AND
 (
NEQ
 (
SETQ
 DESTNET (fetch
 PUPDESTNET of
 PACKET))
				(
SETQ
 MYNET (fetch
 NDBPUPNET# of
 NDB)))
			   (
NEQ
 MYNET 0)
			   (
NEQ
 DESTNET 0))                  (* Destination net is not us, so packet not for us)

		       (
RETURN
 (\FORWARD.PUP
 PACKET]
	           (
COND

		     [[
NULL
 (
SETQ
 PUPSOC (\PUPSOCKET.FROM# (fetch
 PUPDESTSOCKETHI of
 PACKET)
							   (fetch
 PUPDESTSOCKETLO of
 PACKET]
                                                             (* Packets addressed to non-active sockets are just 

							     ignored.)

		       (
COND

			 (PUPTRACEFLG (
PRIN1
 (
QUOTE
 &)
					     PUPTRACEFILE)))
		       (
COND

			 ((
AND
 (
EQ
 (fetch
 PUPTYPE of
 PACKET)
				   \PT.ECHOME)
			       (
EQ
 (fetch
 PUPDESTSOCKETLO of
 PACKET)
				   \PUPSOCKET.ECHO)
			       (
EQ
 (fetch
 PUPDESTSOCKETHI of
 PACKET)
				   0))                       (* Play echo server)

			   (replace
 TYPEWORD of
 PACKET
			      with
 (
COND

				     ([
AND
 (
NEQ
 (
SETQ
 CSUM (fetch
 PUPCHECKSUM of
 PACKET))
						MASKWORD1'S)
					   (
NEQ
 CSUM (
\CHECKSUM
 (fetch
 PUPCHECKSUMBASE of
 PACKET)
								(
SUB1
 (FOLDHI (fetch
 PUPLENGTH
										 of
 PACKET)
									      BYTESPERWORD]
				       \PT.IAMBADECHO)
				     (T \PT.IAMECHO)))
			   (SWAPPUPPORTS
 PACKET)
			   (replace
 EPREQUEUE of
 PACKET with
 (
QUOTE
 FREE))
			   (SENDPUP
 NIL PACKET))
			 (T (\PUPERROR
 PACKET \PUPE.NOSOCKET]
		     ((
IGEQ
 (fetch
 (PUPSOCKET INQUEUELENGTH) of
 PUPSOC)
			    (fetch
 (PUPSOCKET PUPSOC#ALLOCATION) of
 PUPSOC))
                                                             (* Note that packets are just "dropped" when the queue 

							     overflows.)

		       (\PUPERROR
 PACKET \PUPE.SOCKETFULL))
		     ([
AND
 \PUP.CHECKSUMFLG (
NEQ
 (
SETQ
 CSUM (fetch
 PUPCHECKSUM of
 PACKET))
						 MASKWORD1'S)
			   (
NEQ
 CSUM (
\CHECKSUM
 (fetch
 PUPCHECKSUMBASE of
 PACKET)
						(
SUB1
 (FOLDHI (fetch
 PUPLENGTH of
 PACKET)
							      BYTESPERWORD]
		       (\PUPERROR
 PACKET \PUPE.CHECKSUM))
		     (T [
COND

			  ((
EQ
 DESTNET 0)                    (* Fill in unspecified destination net 

							     (possibly redundantly with zero))

			    (replace
 PUPDESTNET of
 PACKET with
 MYNET))
			  ((
EQ
 MYNET 0)

          (* Packet of specific destination net has arrived on a socket that we listen to. If we don't know our own net 

	  number, assume sender is telling the truth)



			    (replace
 NDBPUPNET# of
 NDB with
 DESTNET)
			    (
SETQ
 \LOCALPUPNETHOST (create
 PUPADDRESS
							   PUPNET# _ DESTNET
							   PUPHOST# _(fetch
 NDBPUPHOST# of
 NDB)))
                                                             (* This variable only for backward compatibility.

							     Delete it some day)

			    (
PROG
 ((ENTRY (\LOCATE.PUPNET
 DESTNET T)))
			          [
OR
 ENTRY (push
 (
CDR
 \PUP.ROUTING.TABLE)
						  (
SETQ
 ENTRY (create
 ROUTING
								      RTNET# _ DESTNET]
			          (replace
 RTHOPCOUNT of
 ENTRY with
 0)
			          (replace
 RTGATEWAY# of
 ENTRY with
 NIL)
			          (replace
 RTNDB of
 ENTRY with
 NDB)
			          (replace
 RTRECENT of
 ENTRY with
 T]
			(UNINTERRUPTABLY
                            (
\ENQUEUE
 (fetch
 (PUPSOCKET INQUEUE) of
 PUPSOC)
				      PACKET)
			    (add
 (fetch
 (PUPSOCKET INQUEUELENGTH) of
 PUPSOC)
				 1)
			    (
NOTIFY.EVENT
 (fetch
 PUPSOCEVENT of
 PUPSOC)))]
	T])

(\FORWARD.PUP

  [LAMBDA (PUP)                                              (* bvm: "22-SEP-83 14:24")

                                                             (* Called when we receive a PUP not addressed to us.

							     Unless we are a gateway, dump it)

    (COND
      (\PEEKPUPNUMBER (\MAYBEPEEKPUP
 PUP))
      (\GATEWAYFLG (\GATEWAY.FORWARD.PUP PUP))
      (T (COND
	   (PUPTRACEFLG (PRINTPUP
 PUP (QUOTE GET)
				  NIL "PUP not addressed to this host: ")))
	 (\RELEASE.ETHERPACKET PUP])

(\SETPUPCHECKSUM

  [LAMBDA (PUP)                                              (* bvm: "11-FEB-83 12:28")

                                                             (* Sets the PUPCHECKSUM field of PUP to checksum over 

							     its current contents)

    (replace
 PUPCHECKSUM of
 PUP with
 (COND
				       [\PUP.CHECKSUMFLG (\CHECKSUM (fetch
 PUPCHECKSUMBASE
								       of
 PUP)
								    (SUB1 (FOLDHI (fetch
 PUPLENGTH
										     of
 PUP)
										  BYTESPERWORD]
				       (T \NULLCHECKSUM)))
    T])
)

(RPAQ? \PUP.CHECKSUMFLG
 T)

(RPAQ? \MAX.EPKTS.ON.PUPSOCKET
 20Q)

(RPAQ? \LOCALPUPNETHOST
 )

(RPAQ? \OLDPUPHOST#
 0)



(* Pup error stuff)


(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(ACCESSFNS ERRORPUP
 ((ERRORPUPBASE (fetch
 PUPCONTENTS of
 DATUM)))
		    (
BLOCKRECORD
 ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
                                                             (* Copy of pup header)

				  (ERRORPUPCODE WORD)
				  (ERRORPUPARG WORD)         (* Usually zero)

				  (ERRORPUPSTRINGBASE WORD)
                                                             (* Human readable message)

				  )))
]

(RPAQQ PUPERRORCODES
 ((\PUPE.CHECKSUM 1)
		      (\PUPE.NOSOCKET 2)
		      (\PUPE.SOCKETFULL 3)
		      (\PUPE.GATEWAY.BADPUP 1001Q)
		      (\PUPE.NOROUTE 1002Q)
		      (\PUPE.NOHOST 1003Q)
		      (\PUPE.LOOPED 1004Q)
		      (\PUPE.TOOLARGE 1005Q)
		      (\PUPE.WRONG.GATEWAY 1006Q)
		      (\PUPE.GATEWAYFULL 1007Q)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \PUPE.CHECKSUM
 1)

(RPAQQ \PUPE.NOSOCKET
 2)

(RPAQQ \PUPE.SOCKETFULL
 3)

(RPAQQ \PUPE.GATEWAY.BADPUP
 1001Q)

(RPAQQ \PUPE.NOROUTE
 1002Q)

(RPAQQ \PUPE.NOHOST
 1003Q)

(RPAQQ \PUPE.LOOPED
 1004Q)

(RPAQQ \PUPE.TOOLARGE
 1005Q)

(RPAQQ \PUPE.WRONG.GATEWAY
 1006Q)

(RPAQQ \PUPE.GATEWAYFULL
 1007Q)

(CONSTANTS (\PUPE.CHECKSUM 1)
	   (\PUPE.NOSOCKET 2)
	   (\PUPE.SOCKETFULL 3)
	   (\PUPE.GATEWAY.BADPUP 1001Q)
	   (\PUPE.NOROUTE 1002Q)
	   (\PUPE.NOHOST 1003Q)
	   (\PUPE.LOOPED 1004Q)
	   (\PUPE.TOOLARGE 1005Q)
	   (\PUPE.WRONG.GATEWAY 1006Q)
	   (\PUPE.GATEWAYFULL 1007Q))
)


(* END EXPORTED DEFINITIONS)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PUPERRORMESSAGES)
)
)

(RPAQQ PUPERRORMESSAGES
 ((1 "Bad Checksum")
			 (2 "No such socket")
			 (3 "Socket full")
			 (1001Q "Inconsistent pup")
			 (1002Q "No route to that host")
			 (1003Q "Host is down")
			 (1004Q "Too many hops")
			 (1005Q "Pup too long")
			 (1006Q "Wrong gateway for that host")
			 (1007Q "Gateway IQ full")))
(DEFINEQ

(\PUPERROR

  [LAMBDA (PUP ERRCODE MSG)                                  (* bvm: " 5-Jan-85 23:33")


          (* * Turn packet around into an error packet with given error)



    (
COND

      (\PEEKPUPNUMBER (\MAYBEPEEKPUP
 PUP))
      ((
AND
 (
NEQ
 (fetch
 PUPDESTHOST of
 PUP)
		 0)
	    (
NEQ
 (fetch
 PUPTYPE of
 PUP)
		 \PT.ERROR))                                 (* Don't respond to errors or to broadcasts!)

	[
COND

	  ((
AND
 PUPTRACEFLG (
NEQ
 PUPTRACEFLG (
QUOTE
 PEEK)))
	    (printout
 PUPTRACEFILE "Incoming packet dropped because: "
		      (
OR
 (
CADR
 (
ASSOC
 ERRCODE PUPERRORMESSAGES))
			  ERRCODE)
		      T)
	    (
OR
 (
EQ
 PUPTRACEFLG (
QUOTE
 RAW))
		(PRINTPUP
 PUP]
	(
\BLT
 (fetch
 PUPCONTENTS of
 PUP)
	      (fetch
 PUPBASE of
 PUP)
	      (FOLDLO \PUPHEADERLEN BYTESPERWORD))           (* Copy pup header into body)

	(replace
 ERRORPUPCODE of
 PUP with
 ERRCODE)
	(replace
 ERRORPUPARG of
 PUP with
 0)
	[replace
 PUPLENGTH of
 PUP with
 (
IPLUS
 \PUPOVLEN \PUPHEADERLEN (
ITIMES
 2 BYTESPERWORD)
					      (
\PUTBASESTRING
 (LOCF (fetch
 ERRORPUPSTRINGBASE
								       of
 PUP))
							      0
							      (
OR
 MSG (
CADR
 (
ASSOC
 ERRCODE 
										 PUPERRORMESSAGES))
								  ""]
	(replace
 PUPTYPE of
 PUP with
 \PT.ERROR)
	(SWAPPUPPORTS
 PUP)
	(replace
 EPREQUEUE of
 PUP with
 (
QUOTE
 FREE))
	(SENDPUP
 NIL PUP))
      (T (
\RELEASE.ETHERPACKET
 PUP])
)



(* Pup utilities)


(DEFINEQ

(SETUPPUP

  [LAMBDA (PUP DESTHOST DESTSOCKET TYPE ID SOC REQUEUE)      (* bvm: " 5-Jan-85 23:34")


          (* Initialize pup header PUP with indicated destination HOST, DESTSOCKET and TYPE. A local socket and ID 

	  (if not supplied) are assigned. Returns a "socket" datum)



    (
OR
 \PUP.READY (ASSURE.PUP.READY
))
    (replace
 PUPLENGTH of
 (
SETQ
 PUP (
\DTEST
 PUP (
QUOTE
 ETHERPACKET))) with
 \PUPOVLEN)
                                                             (* pup data initially empty)

    (replace
 (PUP TYPEWORD) of
 PUP with
 TYPE)                (* Clears PUPTCONTROL)

    [replace
 PUPID of
 PUP with
 (
OR
 ID (
SETQ
 \PUPCOUNTER (
COND

				       ((
IGEQ
 \PUPCOUNTER 177777Q)
					 1)
				       (T (
ADD1
 \PUPCOUNTER]
    (replace
 PUPDEST of
 PUP with
 (
OR
 (
FIXP
 (
SETQ
 DESTHOST (ETHERPORT
 DESTHOST T)))
				     (
CAR
 DESTHOST)))
    (replace
 PUPDESTSOCKET of
 PUP with
 (
COND

					 ((
AND
 (
LISTP
 DESTHOST)
					       (
NEQ
 (
CDR
 DESTHOST)
						    0))
					   (
CDR
 DESTHOST))
					 (T DESTSOCKET)))
    (
AND
 REQUEUE (replace
 EPREQUEUE of
 PUP with
 REQUEUE))
    (
OR
 SOC (
SETQ
 SOC (OPENPUPSOCKET
])

(SWAPPUPPORTS

  [LAMBDA (PUP)                                              (* bvm: "12-FEB-83 16:21")

    (swap
 (fetch
 PUPSOURCE of
 PUP)
	  (fetch
 DEST of
 PUP))
    (swap
 (fetch
 PUPSOURCESOCKETHI of
 PUP)
	  (fetch
 DESTSKTHI of
 PUP))
    (swap
 (fetch
 PUPSOURCESOCKETLO of
 PUP)
	  (fetch
 DESTSKTLO of
 PUP])

(GETPUP

  [LAMBDA (PUPSOC WAIT)                                      (* bvm: "24-MAY-83 17:42")

    (SETQ PUPSOC (\DTEST PUPSOC (QUOTE PUPSOCKET)))
    (PROG (PUP TIMER)
      LP  (UNINTERRUPTABLY
              (COND
		((SETQ PUP (\DEQUEUE (ffetch
 (PUPSOCKET INQUEUE) of
 PUPSOC)))
		  (add
 (ffetch
 (PUPSOCKET INQUEUELENGTH) of
 PUPSOC)
		       -1))))
          (COND
	    [(NULL PUP)
	      (COND
		(WAIT (COND
			((EQ WAIT T))
			[TIMER (COND
				 ((TIMEREXPIRED? TIMER)
				   (RETURN]
			(T (OR (FIXP WAIT)
			       (LISPERROR "NON-NUMERIC ARG" WAIT))
			   (SETQ TIMER (SETUPTIMER WAIT))
			   T))
		      (AWAIT.EVENT (ffetch
 PUPSOCEVENT of
 PUPSOC)
				   TIMER T)
		      (GO LP))
		(T                                           (* Let ether procs run)

		   (BLOCK]
	    [(EQ \EPT.PUP (fetch
 EPTYPE of
 PUP))
	      (AND PUPTRACEFLG (\MAYBEPRINTPACKET PUP (QUOTE GET]
	    (T (AND PUPTRACEFLG (printout
 PUPTRACEFILE T "Non-PUP packet " PUP " arrived on " PUPSOC 
					  T))
	       (SETQ PUP)))
          (RETURN PUP])

(SENDPUP

  [LAMBDA (PUPSOC PUP)                                       (* bvm: " 5-Jan-85 23:34")

                                                             (* Returns the PUP arg iff packet can be sent;

							     returns a litatom explaining error otherwise.)

    (
SETQ
 PUP (
\DTEST
 PUP (
QUOTE
 ETHERPACKET)))
    [
AND
 PUPSOC (
SETQ
 PUPSOC (
\DTEST
 PUPSOC (
QUOTE
 PUPSOCKET]
    (replace
 EPTYPE of
 PUP with
 \EPT.PUP)
    (replace
 PUPTCONTROL of
 PUP with
 0)
    (
PROG
 (NDB)
          (\RCLK (LOCF (fetch
 EPTIMESTAMP of
 PUP)))
          [
COND

	    ((
AND
 PUPSOC (
EQ
 (fetch
 PUPSOURCESOCKETLO of
 PUP)
			     0)
		  (
EQ
 (fetch
 PUPSOURCESOCKETHI of
 PUP)
		      0))
	      (replace
 PUPSOURCESOCKETHI of
 PUP with
 (fetch
 PSOCKETHI of
 PUPSOC))
	      (replace
 PUPSOURCESOCKETLO of
 PUP with
 (fetch
 PSOCKETLO of
 PUPSOC]
          (
RETURN
 (
COND

		    ((
NEQ
 (
OR
 \PUP.READY (ASSURE.PUP.READY
))
			  T)                                 (* No PUP?)

		      (
\REQUEUE.ETHERPACKET
 PUP)
		      (
QUOTE
 NoEther))
		    ((fetch
 EPTRANSMITTING of
 PUP)
		      (
AND
 PUPTRACEFLG (printout
 PUPTRACEFILE 
						 "[Packet not sent--already being transmitted]"
						 T))
		      (
QUOTE
 AlreadyQueued))
		    ((
NULL
 (
SETQ
 NDB (\ROUTE.PUP
 PUP)))
		      (
AND
 PUPTRACEFLG (PRINTPUPROUTE
 PUP "[Put fails: no routing]" PUPTRACEFILE))
		      (
\REQUEUE.ETHERPACKET
 PUP)
		      (
QUOTE
 NoRouting))
		    (T (\SETPUPCHECKSUM
 PUP)
		       (
AND
 PUPTRACEFLG (
\MAYBEPRINTPACKET
 PUP (
QUOTE
 PUT)))
		       (
TRANSMIT.ETHERPACKET
 NDB PUP)
		       (
BLOCK
)
		       NIL])

(EXCHANGEPUPS

  [LAMBDA (SOC OUTPUP DUMMY IDFILTER TIMEOUT)                (* bvm: "24-MAY-83 23:19")


          (* Sends out OUTPUP on SOC and waits for a reply, which it puts in INPUP. If IDFILTER is true, only replies with 

	  the same ID are accepted. Returns input pup on success, or NIL on failure. TIMEOUT overrides the default timeout.)



    (DISCARDPUPS
 (\DTEST SOC (QUOTE PUPSOCKET)))             (* Flush any pups waiting on this socket)

    (SENDPUP
 SOC OUTPUP)
    (bind
 INPUP (TIMER _(SETUPTIMER (OR TIMEOUT \ETHERTIMEOUT)))
	  (EVENT _(ffetch
 PUPSOCEVENT of
 SOC)) do
 (COND
						    ([AND (SETQ INPUP (GETPUP
 SOC))
							  (OR (NOT IDFILTER)
							      (IEQP (fetch
 PUPID of
 INPUP)
								    (fetch
 PUPID of
 OUTPUP]
						      (RETURN INPUP))
						    (T (AWAIT.EVENT EVENT TIMER T)))
       repeatuntil
 (TIMEREXPIRED? TIMER])

(DISCARDPUPS

  [LAMBDA (SOC)                                              (* bvm: " 5-MAY-83 23:51")

    (SETQ SOC (\DTEST SOC (QUOTE PUPSOCKET)))
    (UNINTERRUPTABLY
        (PROG1 (fetch
 (PUPSOCKET INQUEUELENGTH) of
 SOC)
	       (\FLUSH.PACKET.QUEUE (fetch
 (PUPSOCKET INQUEUE) of
 SOC))
	       (replace
 (PUPSOCKET INQUEUELENGTH) of
 SOC with
 0)))])

(GETPUPWORD

  [LAMBDA (PUP WORD#)                                        (* bvm: "31-JAN-83 15:27")

    (\GETBASE [fetch
 PUPCONTENTS of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
	      WORD#])

(\PUPINIT

  [LAMBDA NIL                                                (* bvm: "22-JUN-83 10:36")

    (for
 FN in
 (QUOTE (SETUPPUP
 EXCHANGEPUPS GETPUP SENDPUP CLEARPUP GETPUPSTRING PUTPUPSTRING 
				ALLOCATE.PUP RELEASE.PUP CREATESOCKET FLUSHSOCKET))
       bind
 NEWFN unless
 (GETD (SETQ NEWFN (PACK* (QUOTE \)
						  FN)))
       do
                                                    (* make dummy defs for old \ fns)

	  (PUTD NEWFN (GETD FN)
		T))
    (INITPUPLEVEL1 T])
)
(DEFINEQ

(ETHERHOSTNAME

  [LAMBDA (PORT USE.OCTAL.DEFAULT)                           (* bvm: " 5-Jan-85 23:50")


          (* * Looks up the name of the host at address PORT. PORT may be a numeric address, or (host . socket) as returned by

	  ETHERPORT)



    (
PROG
 ((SOC (\GETMISCSOCKET
))
	   (SOCKET# 0)
	   (OPUP (
ALLOCATE.PUP
))
	   NETHOST RESULT BUF IPUP)
          (
OR
 (
EQ
 (
OR
 \PUP.READY (ASSURE.PUP.READY
))
		  T)
	      (
RETURN
))
          [
SETQ
 NETHOST (
COND

	      ((
NULL
 PORT)
		(\LOCALPUPHOSTNUMBER))
	      ((
FIXP
 PORT))
	      [(
AND
 (
LISTP
 PORT)
		    (
FIXP
 (
SETQ
 SOCKET# (
CDR
 PORT)))
		    (
FIXP
 (
CAR
 PORT]
	      ((
AND
 (
NLISTP
 PORT)
		    (
SETQ
 NETHOST (\PARSE.PORTCONSTANT
 PORT)))
		(
SETQ
 SOCKET# (
CDR
 NETHOST))
		(
CAR
 NETHOST))
	      (T (
LISPERROR
 "ILLEGAL ARG" PORT]
          [
COND

	    ((
EQ
 (fetch
 PUPNET# of
 NETHOST)
		 0)                                          (* Net not specified, default to local net)

	      (
SETQ
 NETHOST (create
 PUPADDRESS
				    PUPNET# _(\LOCALPUPNETNUMBER)
				    PUPHOST# _ NETHOST]
          (SETUPPUP
 OPUP 0 \PUPSOCKET.MISCSERVICES \PT.ADDRLOOKUP NIL SOC T)
          (add
 (fetch
 PUPLENGTH of
 OPUP)
	       6)                                            (* port is 6 bytes long)

          (replace
 (PORT NETHOST) of
 (
SETQ
 BUF (fetch
 PUPCONTENTS of
 OPUP)) with
 NETHOST)
          (replace
 (PORT SOCKET) of
 BUF with
 SOCKET#)
          (to
 \MAXETHERTRIES when
 (
SETQ
 IPUP (EXCHANGEPUPS
 SOC OPUP NIL T))
	     do
 (
SELECTC
 (fetch
 PUPTYPE of
 IPUP)
			 (\PT.ADDRRESPONSE (
SETQ
 RESULT (GETPUPSTRING
 IPUP))
					   (
COND

					     ([for
 C instring
 RESULT
						 always
 (
AND
 (
ILESSP
 C (
CHARCODE
 10Q))
							     (
IGEQ
 C (
CHARCODE
 0]
                                                             (* Not really a name, but a Dandelion processor ID.

							     Pretend is NIL so as not to confuse rest of world with 

							     uninvertable name)

					       (
SETQ
 RESULT NIL)))
					   (
RETURN
))
			 (\PT.NAME/ADDRERROR (PUPDEBUGGING "Address lookup error for "
							   (PORTSTRING
 NETHOST SOCKET#)
							   ": "
							   (GETPUPSTRING
 IPUP)
							   T)
					     (
RETURN
))
			 NIL)
	     finally
 (PUPDEBUGGING "Address lookup timed out" T))
          (
AND
 IPUP (
RELEASE.PUP
 IPUP))
          (
RELEASE.PUP
 OPUP)
          (
RETURN
 (
OR
 RESULT (
AND
 USE.OCTAL.DEFAULT (PORTSTRING
 NETHOST (
AND
 (
NEQ
 SOCKET# 0)
									     SOCKET#])

(ETHERHOSTNUMBER

  [LAMBDA (NAME)                                             (* bvm: "26-Jul-84 16:08")

    (COND
      ((NEQ (OR \PUP.READY (ASSURE.PUP.READY
))
	    T)                                               (* No ether, no pup address)

	NIL)
      ((NULL NAME)
	(\LOCALPUPADDRESS))
      (T (CAR (BESTPUPADDRESS
 NAME])

(ETHERPORT

  [LAMBDA (NAME ERRORFLG MULTFLG)                            (* bvm: "16-NOV-83 11:40")


          (* * Returns net address of NAME as (nethost . socket), or list of same if MULTFLG is true %.

	  Caches results locally so doesn't have to look all the time. If ERRORFLG is true, generates error on failure.)


                                                             (* If MULTFLG is nonNIL, fives a list of results -

							     singleton unless perhaps from \LOOKUPP%ORT)

    (PROG (VAL)
          (RETURN (COND
		    ([SETQ VAL (COND
			  ((FIXP NAME)                       (* A host number. Give it socket zero)

			    (\FIXLOCALNET
 (CONS NAME 0)))
			  [(LISTP NAME)                      (* An existing port structure)

			    (COND
			      ((AND (FIXP (CAR NAME))
				    (FIXP (CDR NAME)))
				(\FIXLOCALNET
 NAME))
			      (ERRORFLG (\ILLEGAL.ARG NAME))
			      (T (RETURN]
			  (T (\PARSE.PORTCONSTANT
 NAME]
		      (COND
			(MULTFLG (LIST VAL))
			(T VAL)))
		    [(SETQ VAL (OR (GETHASH NAME \ETHERPORTS)
				   (PUTHASH NAME (\LOOKUPPORT
 NAME)
					    \ETHERPORTS)))   (* note we always save multiple values in case they are 

							     ever wanted)

		      (COND
			(MULTFLG VAL)
			(T (CAR VAL]
		    (ERRORFLG (ERROR "host not found" NAME])

(BESTPUPADDRESS

  [LAMBDA (HOST ERRORSTREAM)                                 (* bvm: " 5-Jan-85 23:36")


          (* Returns a pup port for HOST, selecting the one of possibly multiple ports that is closest, returning NIL if there

	  is no route or name lookup fails. If ERRORSTREAM = ERROR, causes error on failure; otherwise ERRORSTREAM is a stream

	  to print an appropriate error message to before returning NIL)



    (
PROG
 (PORT NET MSG)
          (
OR
 (
EQ
 (
OR
 \PUP.READY (ASSURE.PUP.READY
))
		  T)
	      (
RETURN
))
      RETRY
          (
COND

	    [[
SETQ
 PORT (
COND

		  ((
FIXP
 HOST)                               (* A host number. Give it socket zero)

		    (\FIXLOCALNET
 (
CONS
 HOST 0)))
		  [(
LISTP
 HOST)                              (* An existing port structure)

		    (
COND

		      ((
AND
 (
FIXP
 (
CAR
 HOST))
			    (
FIXP
 (
CDR
 HOST)))
			(\FIXLOCALNET
 HOST))
		      (ERRORSTREAM (
SETQ
 MSG "Invalid port specification")
				   (
GO
 ERROR))
		      (T (
RETURN
]
		  (T (\PARSE.PORTCONSTANT
 HOST]
	      (
COND

		((
OR
 (
EQ
 (
SETQ
 NET (fetch
 PUPNET# of
 (
CAR
 PORT)))
			 0)
		     (
EQ
 NET (\LOCALPUPNETNUMBER)))
		  (
RETURN
 PORT))
		(T (
SETQ
 PORT (
LIST
 PORT]
	    ((
SETQ
 PORT (
OR
 (
GETHASH
 HOST \ETHERPORTS)
			    (
PUTHASH
 HOST (\LOOKUPPORT
 HOST)
				     \ETHERPORTS)))          (* note we always save multiple values in case they are

							     ever wanted)

	      )
	    (ERRORSTREAM (
SETQ
 MSG "Host not found")
			 (
GO
 ERROR))
	    (T (
RETURN
)))
          [
RETURN
 (for
 TRY from
 1 to
 5 bind
 NOTLOOKEDUP HOPS BESTHOPS BESTPORT ROUTE
		     do
 (
SETQ
 BESTHOPS \RT.INFINITY)
			(
SETQ
 NOTLOOKEDUP (
SETQ
 BESTPORT NIL))
			[for
 PAIR in
 PORT do
 (
COND

					       ((
OR
 [
NOT
 (
SETQ
 ROUTE (\LOCATE.PUPNET

							     (fetch
 PUPNET# of
 (
CAR
 PAIR]
						    (
IGEQ
 (
SETQ
 HOPS (fetch
 RTHOPCOUNT of
 ROUTE))
							  \RT.INFINITY))
						 (
SETQ
 NOTLOOKEDUP T))
					       ((
ILESSP
 HOPS BESTHOPS)
						 (
SETQ
 BESTHOPS HOPS)
						 (
SETQ
 BESTPORT PAIR]
                                                             (* Enter request for routing for all hosts)

			(
COND

			  ((
AND
 BESTPORT (
OR
 (
NOT
 NOTLOOKEDUP)
					     (
ILEQ
 BESTHOPS \PUP.ROUTING.TABLE.RADIUS)
					     (
IGREATERP
 TRY 1)))
			    (
RETURN
 BESTPORT)))
			(
BLOCK
 \ETHERTIMEOUT)
		     finally
 (
COND

			       (ERRORSTREAM (
SETQ
 MSG "No route to host")
					    (
GO
 ERROR]
      ERROR
          (
COND

	    ((
EQ
 ERRORSTREAM (
QUOTE
 ERROR))
	      (
ERROR
 MSG HOST)
	      (
GO
 RETRY))
	    (T (printout
 ERRORSTREAM T MSG ": " HOST)
	       (
RETURN
])

(NETDAYTIME0

  [LAMBDA NIL                                                (* bvm: "26-Jul-84 15:26")


          (* * Returns a 32-bit unsigned alto time from the network, if possible)



    (\NET.SETTIME
 T])

(\PUP.SETTIME

  [LAMBDA (RETFLG)                                           (* bvm: " 1-NOV-83 17:07")


          (* * Sets the local time from the network, if possible, or simply returns a 32-bit unsigned alto time if RETFLG is

	  T)



    (DECLARE
 (GLOBALVARS \TimeZoneComp \BeginDST \EndDST))
    (PROG ((SOC (\GETMISCSOCKET
))
	   (OPUP (ALLOCATE.PUP))
	   RESULT IPUP DATA TIME)
          (SETUPPUP
 OPUP 0 \PUPSOCKET.MISCSERVICES \PT.ALTOTIMEREQUEST NIL SOC T)
          (RETURN (to
 \MAXETHERTRIES when
 (SETQ IPUP (EXCHANGEPUPS
 SOC OPUP NIL T))
		     do
 (SELECTC (fetch
 PUPTYPE of
 IPUP)
				 (\PT.ALTOTIMERESPONSE (SETQ DATA (fetch
 PUPCONTENTS of
 IPUP))
						       (SETQ TIME (create
 FIXP
									  HINUM _(fetch
 
										   TIMEPUPVALUEHI
										    of
 DATA)
									  LONUM _(fetch
 
										   TIMEPUPVALUELO
										    of
 DATA)))
						       (COND
							 (RETFLG (RETURN TIME)))
						       (\SETNEWTIME0
 TIME)
						       (SETQ \TimeZoneComp
							 (ITIMES (COND
								   ((fetch
 TIMEPUPEASTP of
 DATA)
								     -1)
								   (T 1))
								 (fetch
 TIMEPUPHOURS of
 DATA)))
						       (SETQ \BeginDST (fetch
 TIMEPUPBEGINDST
									  of
 DATA))
						       (SETQ \EndDST (fetch
 TIMEPUPENDDST
									of
 DATA))
						       (RELEASE.PUP IPUP)
						       (RETURN T))
				 (\PT.ERROR (AND PUPTRACEFLG (PRINTERRORPUP
 IPUP PUPTRACEFILE)))
				 NIL)
			(RELEASE.PUP IPUP])

(\SETNEWTIME0

  [LAMBDA (NEWTIME)                                          (* bvm: "26-Jul-84 15:23")

    (PROG [(OLDTIME (\DAYTIME0 (create
 FIXP]
          (\SETDAYTIME0 NEWTIME)
          (COND
	    ((IGREATERP (IABS (IDIFFERENCE NEWTIME OLDTIME))
			454Q)                                (* Time changed by more than 5 minutes, maybe mention 

							     it)

	      (printout
 PROMPTWINDOW T "[Time reset to " (DATE (DATEFORMAT TIME.ZONE))
			"]"])

(\NET.SETTIME

  [LAMBDA (RETFLG)                                           (* bvm: "26-Jul-84 15:25")


          (* * Sets the time from local network time server, or just returns said time if RETFLG is true)



    (if
 \LOCALNDBS
	then
 (SELECTQ (fetch
 (NDB NETTYPE) of
 \LOCALNDBS)
		      (3 (OR (\PUP.SETTIME
 RETFLG)
			     (\NS.SETTIME RETFLG)))
		      [12Q (OR (\NS.SETTIME RETFLG)
			       (AND \PUP.READY (\PUP.SETTIME
 RETFLG]
		      NIL])

(NETDATE

  [LAMBDA NIL                                               (* bvm: "30-AUG-81 00:30")

    (GDATE (ALTO.TO.LISP.DATE (OR (NETDAYTIME0
)
				  (DAYTIME0 (create
 FIXP])

(\LOOKUPPORT

  [LAMBDA (NAME)                                             (* bvm: " 5-Jan-85 23:58")


          (* * Looks up the ether address of NAME, returning a list of dotted pairs (nethost . socket), or NIL on failure)



    (
PROG
 ((SOC (\GETMISCSOCKET
))
	   (OPUP (
ALLOCATE.PUP
))
	   RESULT BUF LEN IPUP)
          (SETUPPUP
 OPUP 0 \PUPSOCKET.MISCSERVICES \PT.NAMELOOKUP NIL SOC T)
          (PUTPUPSTRING
 OPUP NAME)
          (to
 \MAXETHERTRIES when
 (
SETQ
 IPUP (EXCHANGEPUPS
 SOC OPUP NIL T))
	     do
 (
SELECTC
 (fetch
 PUPTYPE of
 IPUP)
			 [\PT.NAMERESPONSE (
COND

					     ((
IGREATERP
 (
SETQ
 LEN
							   (
IQUOTIENT
 (FOLDLO (
IDIFFERENCE

										(fetch
 PUPLENGTH
										   of
 IPUP)
										\PUPOVLEN)
									      BYTESPERWORD)
								      \PORTIDLEN))
							 1)
					       (PUPDEBUGGING "Multiple response received for " NAME T)
					       ))
					   (
RETURN
 (
SETQ
 RESULT (from
 1 to
 LEN
								   as
 (PTR _(fetch
 PUPCONTENTS
									       of
 IPUP))
								   by
 (
\ADDBASE
 PTR \PORTIDLEN)
								   collect

								    (
CONS
 (fetch
 (PORT NETHOST)
									     of
 PTR)
									  (fetch
 (PORT SOCKET)
									     of
 PTR]
			 (\PT.NAME/ADDRERROR (PUPDEBUGGING "Name lookup error for " NAME ": "
							   (GETPUPSTRING
 IPUP)
							   T)
					     (
RETURN
))
			 NIL)
	     finally
 (PUPDEBUGGING "Name lookup timed out" T))
          (
AND
 IPUP (
RELEASE.PUP
 IPUP))
          (
RELEASE.PUP
 OPUP)
          (
RETURN
 RESULT])

(\PARSE.PORTCONSTANT

  [LAMBDA (STR)                                              (* bvm: "16-NOV-83 12:01")


          (* * If STR is a constant ether address of form net#host#socket, returns a port, else NIL)



    (for
 CH instring
 (OR (STRINGP STR)
			 (SETQ STR (MKSTRING STR)))
       bind
 NET HOST VAL do
 (COND
			      [(AND (IGEQ CH (CHARCODE 0))
				    (ILEQ CH (CHARCODE 7)))
                                                             (* Add octal digit into value)

				(SETQ VAL (IPLUS (COND
						   (VAL (LLSH VAL 3))
						   (T 0))
						 (IDIFFERENCE CH (CHARCODE 0]
			      ((EQ CH (CHARCODE #))          (* # terminates net or host number)

				(COND
				  (NET (RETURN)))
				(SETQ NET HOST)
				(SETQ HOST (OR VAL 0))
				(SETQ VAL NIL))
			      (T (RETURN)))
       finally
                                               (* Ran out of chars. Save last value parsed, make sure 

							     we have at least a net and host)

	       (RETURN (AND (OR HOST VAL)
			    (CONS (LOGOR (OR HOST 0)
					 (COND
					   (NET (LLSH NET 10Q))
					   (T 0)))
				  (OR VAL 0])

(\FIXLOCALNET

  [LAMBDA (PORT)                                             (* bvm: " 5-Jan-85 23:37")


          (* Port is a dotted pair (nethost . socket). We force the nethost to have a nonzero net if we know our net by now.

	  Returns the possibly modified PORT)



    [
PROG
 (NET)
          (
COND

	    ((
AND
 (
ILESSP
 (
CAR
 PORT)
			  400Q)
		  (
NEQ
 (
CAR
 PORT)
		       0)
		  \LOCALNDBS
		  (
SETQ
 NET (fetch
 NDBPUPNET# of
 \LOCALNDBS))
		  (
NEQ
 NET 0))
	      (
RPLACA
 PORT (create
 PUPADDRESS
				   PUPNET# _ NET
				   PUPHOST# _(
CAR
 PORT]
    PORT])
)
(DEFINEQ

(PORTSTRING

  [LAMBDA (NETHOST SOCKET)                                   (* bvm: " 5-Jan-85 23:40")

    [
COND

      ((
LISTP
 NETHOST)
	(
SETQ
 SOCKET (
CDR
 NETHOST))
	(
COND

	  ((
EQ
 SOCKET 0)
	    (
SETQ
 SOCKET NIL)))
	(
SETQ
 NETHOST (
CAR
 NETHOST]
    (
CONCAT
 (OCTALSTRING
 (
LRSH
 NETHOST 10Q))
	    (
QUOTE
 #)
	    (OCTALSTRING
 (
LOGAND
 NETHOST 377Q))
	    (
QUOTE
 #)
	    (
COND

	      (SOCKET (OCTALSTRING
 SOCKET))
	      (T ""])

(OCTALSTRING

  [LAMBDA (N)                                                (* bvm: "21-JUL-81 12:16")

    (GLOBALRESOURCE (\NUMSTR \NUMSTR1)
        (CONCAT (\CONVERTNUMBER N 10Q NIL NIL \NUMSTR \NUMSTR1)))])
)

(RPAQ? \ETHERPORTS
 (HASHARRAY 24Q))

(RPAQ? \ETHERTIMEOUT
 3720Q)

(RPAQ? \MAXETHERTRIES
 4)

(RPAQ? \PUPCOUNTER
 0)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \ETHERPORTS \PUPCOUNTER)
)



(* Accessing a PUP's contents)


(DEFINEQ

(CLEARPUP

  [LAMBDA (PUP)                                              (* bvm: "31-JAN-83 15:31")

    (replace
 EPLINK of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET))) with
 NIL)
                                                             (* de-reference the pointers)

    [replace
 EPUSERFIELD of
 PUP with
 (replace
 EPPLIST of
 PUP
					with
 (replace
 EPREQUEUE of
 PUP
						with
 (replace
 EPSOCKET of
 PUP
							with
 (replace
 EPNETWORK of
 PUP with
 NIL]
    (\ZEROWORDS (fetch
 PUPBASE of
 PUP)
		(\ADDBASE (LOCF (fetch
 SOURCESKT of
 PUP))
			  1))
    (\ZEROBYTES (fetch
 PUPCONTENTS of
 PUP)
		0
		(SUB1 \MAX.PUPLENGTH])

(PUTPUPWORD

  [LAMBDA (PUP WORD# VALUE)                                  (* bvm: "31-JAN-83 15:31")

    (\PUTBASE [fetch
 PUPCONTENTS of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
	      WORD# VALUE])

(GETPUPBYTE

  [LAMBDA (PUP BYTE#)                                        (* bvm: "31-JAN-83 15:31")

    (\GETBASEBYTE [fetch
 PUPCONTENTS of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
		  BYTE#])

(PUTPUPBYTE

  [LAMBDA (PUP BYTE# VALUE)                                  (* bvm: "31-JAN-83 15:31")

    (\PUTBASEBYTE [fetch
 PUPCONTENTS of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
		  BYTE# VALUE])

(GETPUPSTRING

  [LAMBDA (PUP OFFSET)                                       (* bvm: "26-Apr-84 10:04")

    (PROG [(NC (IDIFFERENCE (IDIFFERENCE [ffetch
 PUPLENGTH of
 (SETQ PUP (\DTEST PUP (QUOTE 
										      ETHERPACKET]
					 \PUPOVLEN)
			    (OR OFFSET (SETQ OFFSET 0]
          (RETURN (COND
		    ((IGREATERP NC 0)
		      (\GETBASESTRING (ffetch
 PUPCONTENTS of
 PUP)
				      OFFSET NC))
		    (T                                       (* Could give error if length negative, but the empty 

							     string is a reasonable thing to return)

		       (ALLOCSTRING 0])

(GETPUPSTREAM

  [LAMBDA (PUP OFFSET LENGTH ACCESS WRITEXTENSIONFN)         (* bvm: "26-OCT-83 12:10")

    (\MAKEBASEBYTESTREAM [fetch
 PUPCONTENTS of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
			 (OR OFFSET (SETQ OFFSET 0))
			 (OR LENGTH (IDIFFERENCE (IDIFFERENCE (fetch
 PUPLENGTH of
 PUP)
							      \PUPOVLEN)
						 OFFSET))
			 (OR ACCESS (QUOTE INPUT))
			 WRITEXTENSIONFN])

(PUTPUPSTRING

  [LAMBDA (PUP STR)                                          (* bvm: "31-JAN-83 15:35")

    (add
 [fetch
 PUPLENGTH of
 (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET]
	 (\PUTBASESTRING (fetch
 PUPCONTENTS of
 PUP)
			 (IDIFFERENCE (fetch
 PUPLENGTH of
 PUP)
				      \PUPOVLEN)
			 STR])

(READPLIST

  [LAMBDA (STREAM NOERRORFLG)                                (* bvm: " 5-May-84 16:09")


          (* * Reads an FTP-style property list from STREAM. If the plist is malformed, causes an error unless NOERRORFLG is

	  true. FTP-style plists look like lists of two elements in a very rigid syntax: each element of the list is 

	  (property value); spaces are significant except the one immediately following property. READPLIST returns the 

	  property names as uppercase atoms, the values as strings)



    (PROG ([READTABLES (DEFERREDCONSTANT (PROG ((TAB1 (COPYREADTABLE (QUOTE ORIG)))
						TAB2)
					       (SETSEPR NIL NIL TAB1)
                                                             (* Want to set up two readtables to read properties)

					       (SETSYNTAX (QUOTE ')
							  (QUOTE ESCAPE)
							  TAB1)
					       (SETSYNTAX (QUOTE %%)
							  (QUOTE OTHER)
							  TAB1)
					       (SETQ TAB2 (COPYREADTABLE TAB1))
					       (SETBRK (CHARCODE (%)))
						       NIL TAB2)
					       (SETBRK (CHARCODE (SPACE))
						       NIL TAB1)
					       (RETURN (CONS TAB1 TAB2]
	   PLIST)
          (OR (EQ (BIN STREAM)
		  (CHARCODE %())
	      (GO ERROR))
          [SETQ PLIST (bind
 CH while
 (EQ (SETQ CH (BIN STREAM))
					 (CHARCODE %())
			 collect
                             (* Another element)

				 [PROG1 [LIST (RATOM STREAM (CAR READTABLES))
					      (PROGN (BIN STREAM)
                                                             (* Skip over the space)

						     (RSTRING STREAM (CDR READTABLES]
					(COND
					  ((NEQ (BIN STREAM)
						(CHARCODE %)))
					    (GO ERROR]
			 finally
 (COND
				   ((NEQ CH (CHARCODE %)))
				     (GO ERROR]
          [for
 PAIR in
 PLIST do
 (RPLACA PAIR (AND (CAR PAIR)
						  (OR (GETPROP (CAR PAIR)
							       (QUOTE U-CASE))
						      (PUTPROP (CAR PAIR)
							       (QUOTE U-CASE)
							       (U-CASE (CAR PAIR]
          (RETURN PLIST)
      ERROR
          (OR NOERRORFLG (ERROR "Malformed property list in stream" STREAM))
          (RETURN NIL])

(\STOREPLIST

  [LAMBDA (LST BASE LIMIT)         (* lmm "30-JUN-82 22:22")

    (PROG ((CNT 0)
	   PRE)
          (\PUTBASEBYTE BASE 0 (CHARCODE "("))
          (for
 PAIR in
 LST do
 (SETQ PRE (CHARCODE "("))
			      (for
 X in
 PAIR do
 (\PUTBASEBYTE BASE (add
 CNT 1)
							      PRE)
						(SETQ PRE (CHARCODE SPACE))
						(for
 CH inchars
 X
						   do
 (SELCHARQ CH
								((%( %) ')
                                   (* need to quote these)

								  (\PUTBASEBYTE BASE
										(add
 CNT 1)
										(CHARCODE ')))
								NIL)
						      (\PUTBASEBYTE BASE (add
 CNT 1)
								    CH)))
			      (\PUTBASEBYTE BASE (add
 CNT 1)
					    (CHARCODE ")")))
          (\PUTBASEBYTE BASE (add
 CNT 1)
			(CHARCODE ")"))
          (RETURN (ADD1 CNT])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS GETPUPWORD DMACRO
 ((PUPARG WORD#)
			     (\GETBASE (fetch PUPCONTENTS of (\DTEST PUPARG (QUOTE ETHERPACKET)))
				       WORD#)))

(PUTPROPS PUTPUPWORD DMACRO
 ((PUPARG WORD# VALUE)
			     (\PUTBASE (fetch PUPCONTENTS of (\DTEST PUPARG (QUOTE ETHERPACKET)))
				       WORD# VALUE)))

(PUTPROPS GETPUPBYTE DMACRO
 ((PUPARG BYTE#)
			     (\GETBASEBYTE (fetch PUPCONTENTS of (\DTEST PUPARG (QUOTE ETHERPACKET)))
					   BYTE#)))

(PUTPROPS PUTPUPBYTE DMACRO
 ((PUPARG BYTE# VALUE)
			     (\PUTBASEBYTE (fetch PUPCONTENTS of (\DTEST PUPARG (QUOTE ETHERPACKET)))
					   BYTE# VALUE)))
)
(DEFINEQ

(\CANONICAL.HOSTNAME

  [LAMBDA (NAME)                                             (* bvm: "15-Sep-84 14:36")

    (DECLARE
 (
GLOBALVARS
 FIXSPELLREL))

          (* * Returns the canonical name of a given hostname, in case a server has synonyms)



    (
OR
 (
LITATOM
 NAME)
	(
SETQ
 NAME (
MKATOM
 NAME)))
    (
OR
 (
CDR
 (
FASSOC
 NAME \HOSTNAMES))
	(
PROG
 ((PORT (ETHERPORT
 NAME))
	       OFFICIALNAME)
	      (
RETURN
 (
COND

			(PORT (if
 [
NOT
 (
LITATOM
 (
SETQ
 OFFICIALNAME (
MKATOM

						    (
U-CASE
 (
OR
 (ETHERHOSTNAME
 PORT)
								NAME]
				  then
                       (* DLions with no real name come out as large integers,

							     not litatoms, so use name given)

				       (
SETQ
 OFFICIALNAME (
U-CASE
 NAME)))
			      (push
 \HOSTNAMES (
CONS
 NAME OFFICIALNAME))
                                                             (* If no name in database, take what was given)

			      OFFICIALNAME)
			((
AND
 \HOSTNAMES (
SETQ
 NAME (
FIXSPELL
 NAME FIXSPELLREL \HOSTNAMES T)))
			  (\CANONICAL.HOSTNAME
 NAME])

(CANONICAL.HOSTNAME

  [LAMBDA (
HOSTNAME
)                                         (* bvm: "15-Sep-84 14:38")

    (if
 (
STRPOS
 ":" HOSTNAME)
	then
 (
\CANONICAL.NSHOSTNAME
 HOSTNAME)
      else
 (\CANONICAL.HOSTNAME
 HOSTNAME])
)

(ADDTOVAR \HOSTNAMES
 )

(ADDTOVAR \SYSTEMCACHEVARS
 \HOSTNAMES)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \HOSTNAMES)
)



(* PUP allocation)


(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(PUTPROPS BINDPUPS MACRO
 [X (
CONS
 (
LIST
 (
QUOTE
 LAMBDA)
					(
CAR
 X)
					(
CONS
 (
QUOTE
 PROGN)
					      (
CDR
 X)))
				  (in
 (
CAR
 X) collect
 (
LIST
 (
QUOTE
 ALLOCATE.PUP])
)

(PUTPROPS BINDPUPS INFO
 BINDS)

(ADDTOVAR PRETTYPRINTMACROS
 (BINDPUPS LAMBDA
                              (FORM)
			      (
PROG
 [(POS (
IPLUS
 2 (
POSITION
]
				    (
PRIN1
 "(")
				    (
PRIN2
 (
CAR
 FORM))
				    (
SPACES
 1)
				    (
PRINTDEF
 (
CADR
 FORM)
					      (
POSITION
))
				    (
OR
 [
EQ
 COMMENTFLG (
CAAR
 (
SETQ
 FORM (
CDDR
 FORM]
					(
TAB
 POS 0))
				    (
PRINTDEF
 FORM POS T T FNSLST)
				    (
PRIN1
 ")"))))


(* END EXPORTED DEFINITIONS)




(* Pup routing)


(DEFINEQ

(\PUPGATELISTENER

  [LAMBDA NIL                                                (* bvm: "10-JUN-83 11:25")

    (PROG ((SOCKET (OPENPUPSOCKET
 \PUPSOCKET.ROUTING T))
	   (TIMER (SETUPTIMER 0))
	   PUP EVENT BASE)
          (SETQ EVENT (fetch
 PUPSOCEVENT of
 SOCKET))
      LP  (COND
	    ((SETQ PUP (GETPUP
 SOCKET))
	      (\HANDLE.PUP.ROUTING.INFO
 PUP)
	      (BLOCK))
	    ((EQ (AWAIT.EVENT EVENT (COND
				((IGREATERP \PUPROUTER.PROBECOUNT 0)
				  \PUPROUTER.PROBETIMER)
				(T TIMER))
			      T)
		 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)))
          [COND
	    ((AND (IGREATERP \PUPROUTER.PROBECOUNT 0)
		  (TIMEREXPIRED? \PUPROUTER.PROBETIMER))     (* Routing info desired. Broadcast a routing request on 

							     each directly-connected net)

	      (SETUPPUP
 (SETQ PUP (ALLOCATE.PUP))
			0 \PUPSOCKET.ROUTING \PT.GATEWAYREQUEST NIL SOCKET)
	      (SENDPUP
 SOCKET PUP)
	      (SETUPTIMER \PUPROUTER.PROBEINTERVAL \PUPROUTER.PROBETIMER)
	      (SETQ \PUPROUTER.PROBECOUNT (SUB1 \PUPROUTER.PROBECOUNT]
          (GO LP])

(\HANDLE.PUP.ROUTING.INFO

  [LAMBDA (PUP)                                              (* bvm: "10-JUN-83 14:20")

                                                             (* Processes a routing info PUP)

    [COND
      ((EQ (fetch
 PUPTYPE of
 PUP)
	   \PT.GATEWAYRESPONSE)                              (* Unless we're a gateway, we only handle responses)

	(PROG ((HOST (fetch
 PUPSOURCEHOST of
 PUP))
	       (NDB (fetch
 EPNETWORK of
 PUP))
	       (LENGTH (FOLDLO (IDIFFERENCE (fetch
 PUPLENGTH of
 PUP)
					    \PUPOVLEN)
			       BYTESPERWORD))
	       (BASE (fetch
 PUPCONTENTS of
 PUP))
	       ENTRY NET HOPS)
	      [COND
		((NEQ (fetch
 NETTYPE of
 NDB)
		      3)
		  (OR (SETQ HOST (\TRANSLATE.3TO10 HOST NDB))
		      (RETURN]
	      (SETQ \PUPROUTER.PROBECOUNT 0)
	      (while
 (IGEQ LENGTH \PUP.ROUTINGINFO.WORDS)
		 do
 (SETQ NET (fetch
 (PUPROUTINGINFO NET#) of
 BASE))
		    (SETQ HOPS (ADD1 (fetch
 (PUPROUTINGINFO #HOPS) of
 BASE)))
		    [COND
		      ((OR (SETQ ENTRY (.RTLOOKUP. NET \PUP.ROUTING.TABLE))
			   (COND
			     ((ILEQ HOPS \PUP.ROUTING.TABLE.RADIUS)
			       [push
 (CDR \PUP.ROUTING.TABLE)
				     (SETQ ENTRY (create
 ROUTING
							 RTNET# _ NET
							 RTTIMER _(SETUPTIMER 0]
			       T)))

          (* Update the entry if this entry not for directly connected net and -

	  current entry timed out, or -

	  new gateway same as old, or -

	  new route has fewer hops than old)



			(COND
			  ([AND (NEQ (fetch
 RTHOPCOUNT of
 ENTRY)
				     0)
				(OR (NOT (fetch
 RTRECENT of
 ENTRY))
				    (AND (EQUAL HOST (fetch
 RTGATEWAY# of
 ENTRY))
					 (EQ NDB (fetch
 RTNDB of
 ENTRY)))
				    (ILESSP HOPS (fetch
 RTHOPCOUNT of
 ENTRY]
			    (replace
 RTGATEWAY# of
 ENTRY with
 HOST)
			    (replace
 RTNDB of
 ENTRY with
 NDB)
			    (replace
 RTHOPCOUNT of
 ENTRY with
 HOPS)
			    (COND
			      ((ILESSP HOPS \RT.INFINITY)
				(replace
 RTRECENT of
 ENTRY with
 T)
				(SETUPTIMER \RT.TIMEOUTINTERVAL (fetch
 RTTIMER of
 ENTRY]
		    (SETQ LENGTH (IDIFFERENCE LENGTH \PUP.ROUTINGINFO.WORDS))
		    (SETQ BASE (\ADDBASE BASE \PUP.ROUTINGINFO.WORDS]
    (\RELEASE.ETHERPACKET PUP])

(\ROUTE.PUP

  [LAMBDA (PUP READONLY)                                     (* bvm: "15-Feb-85 22:21")


          (* Encapsulates PUP, choosing the right network and immediate destination host. Returns an NDB for the transmission.

	  Defaults the pup source fields, unless READONLY is set)



    (
PROG
 ((NET (fetch
 PUPDESTNET of
 PUP))
	   (HOST (fetch
 PUPDESTHOST of
 PUP))
	   PDH ROUTE NDB)
          (
COND

	    [(
EQ
 NET 0)
	      (
COND

		((
NOT
 (
SETQ
 NDB \LOCALNDBS))
		  (
RETURN
]
	    ((
SETQ
 ROUTE (\LOCATE.PUPNET
 NET))
	      (
SETQ
 NDB (fetch
 RTNDB of
 ROUTE)))
	    (T (
RETURN
)))
          [
SETQ
 PDH (
COND

	      ((
AND
 ROUTE (
NEQ
 (fetch
 RTHOPCOUNT of
 ROUTE)
			       0))
		(fetch
 RTGATEWAY# of
 ROUTE))
	      ((
EQ
 (fetch
 NETTYPE of
 NDB)
		   3)
		HOST)
	      ((
EQ
 HOST 0)                                   (* Broadcast)

		BROADCASTNSHOSTNUMBER)
	      ((
\TRANSLATE.3TO10
 HOST NDB))
	      (T (
RETURN
]
          (replace
 EPNETWORK of
 PUP with
 NDB)
          (
ENCAPSULATE.ETHERPACKET
 NDB PUP PDH (fetch
 PUPLENGTH of
 PUP)
				   (ffetch
 NDBPUPTYPE of
 NDB))
          [
COND

	    ((
NOT
 READONLY)
	      [
COND

		((
EQ
 NET 0)
		  (replace
 PUPDESTNET of
 PUP with
 (fetch
 NDBPUPNET# of
 NDB]
	      (replace
 PUPSOURCENET of
 PUP with
 (fetch
 NDBPUPNET# of
 NDB))
	      (
COND

		((
EQ
 (fetch
 PUPSOURCEHOST of
 PUP)
		     0)
		  (replace
 PUPSOURCEHOST of
 PUP with
 (fetch
 NDBPUPHOST# of
 NDB]
          (
RETURN
 NDB])

(\LOCATE.PUPNET

  [LAMBDA (NET DONTPROBE)                                    (* bvm: " 5-Jan-85 23:39")

    (
OR
 (
SMALLP
 NET)
	(
HELP
 "Bad network number" NET))
    (
OR
 \PUP.READY (ASSURE.PUP.READY
))
    (for
 (PREVTAIL _ \PUP.ROUTING.TABLE) bind
 TAIL DATA while
 (
LISTP
 (
SETQ
 TAIL (
CDR
 PREVTAIL)))
       do
 (
SETQ
 DATA (
CAR
 TAIL))
	  [
COND

	    ((
OR
 (
EQ
 NET (fetch
 (ROUTING RTNET#) of
 DATA))
		 (
AND
 (
EQ
 NET 0)
		      (
EQ
 (fetch
 (ROUTING RTHOPCOUNT) of
 DATA)
			  0)))
	      [
COND

		((
NEQ
 PREVTAIL \PUP.ROUTING.TABLE)           (* Promote this entry to the front, so we find it 

							     faster in the future)

		  (
FRPLACD
 \PUP.ROUTING.TABLE (
PROG1
 TAIL (
FRPLACD
 PREVTAIL (
CDR
 TAIL))
						     (
FRPLACD
 TAIL (
CDR
 \PUP.ROUTING.TABLE]
	      (
RETURN
 (
AND
 (
ILESSP
 (fetch
 RTHOPCOUNT of
 DATA)
				   \RT.INFINITY)
			   DATA]
	  (
SETQ
 PREVTAIL TAIL)
       finally
 (
COND

		 ((
NOT
 DONTPROBE)
		   [
OR
 (
EQ
 NET 0)
		       (push
 (
CDR
 \PUP.ROUTING.TABLE)
			     (create
 ROUTING
				     RTNET# _ NET
				     RTHOPCOUNT _ \RT.INFINITY
				     RTTIMER _(
SETUPTIMER
 72460Q]
                                                             (* Insert an entry for the net, to be purged in 36Q sec

							     if router process hasn't filled it by then)

		   (
SETQ
 \PUPROUTER.PROBECOUNT 5)
		   (
SETQ
 \PUPROUTER.PROBETIMER (
SETUPTIMER
 0 \PUPROUTER.PROBETIMER))
		   (
WAKE.PROCESS
 (
QUOTE
 \PUPGATELISTENER))
		   (
BLOCK
])

(SORT.PUPHOSTS.BY.DISTANCE

  [LAMBDA (HOSTLIST)                                         (* bvm: " 6-MAY-83 00:18")

    (COND
      ((NULL (CDR (LISTP HOSTLIST)))
	HOSTLIST)
      (T 

          (* HOSTLIST is a list each of whose elements has a pup nethost in its CAR and anything in its CDR.

	  In particular, standard pup PORT pairs work)



	 [for
 PAIR in
 HOSTLIST do
 (\LOCATE.PUPNET
 (fetch
 PUPNET# of
 (CAR PAIR]
                                                             (* Enter request for routing for all hosts)

	 (BLOCK)
	 (COND
	   ((NOT (for
 PAIR in
 HOSTLIST always
 (\LOCATE.PUPNET
 (fetch
 PUPNET# of
 (CAR PAIR))
							      T)))
	     (BLOCK \ETHERTIMEOUT)))
	 (SORT HOSTLIST (FUNCTION \PUPNET.CLOSERP])

(\PUPNET.CLOSERP

  [LAMBDA (X Y)                                              (* edited: "12-APR-83 12:44")

    (PROG ((ROUTEX (\LOCATE.PUPNET
 (fetch
 PUPNET# of
 (CAR X))
				   T))
	   ROUTEY)
          (RETURN (COND
		    ((NULL ROUTEX)
		      NIL)
		    ((SETQ ROUTEY (\LOCATE.PUPNET
 (fetch
 PUPNET# of
 (CAR Y))
						  T))
		      (ILESSP (fetch
 RTHOPCOUNT of
 ROUTEX)
			      (fetch
 RTHOPCOUNT of
 ROUTEY)))
		    (T T])

(PUPNET.DISTANCE

  [LAMBDA (NET#)                                             (* bvm: " 1-MAR-83 16:15")

    (PROG ((ROUTE (\LOCATE.PUPNET
 NET#)))
          [COND
	    ((NULL ROUTE)
	      (to
 4 do
 (BLOCK \ETHERTIMEOUT) repeatuntil
 (SETQ ROUTE (\LOCATE.PUPNET
 NET#]
          (RETURN (COND
		    (ROUTE (fetch
 RTHOPCOUNT of
 ROUTE])
)

(RPAQ? \PUP.ROUTING.TABLE
 (CONS))

(RPAQ? \PUP.ROUTING.TABLE.RADIUS
 2)

(RPAQ? \PUPROUTER.PROBECOUNT
 0)

(RPAQ? \PUPROUTER.PROBETIMER
 )

(RPAQ? \PUPROUTER.PROBEINTERVAL
 5670Q)

(RPAQ? \PUP.READY
 )

(RPAQ? \PUP.READY.EVENT
 (CREATE.EVENT "Pup Ready"))

(RPAQ? \PUP.READY.LOCK
 (CREATE.MONITORLOCK "Pup Ready"))

(ADDTOVAR \SYSTEMCACHEVARS
 \PUP.READY)
(DECLARE: DONTCOPY 
[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)))
]

(DECLARE: EVAL@COMPILE 

(RPAQQ \PUP.ROUTINGINFO.WORDS
 2)

(CONSTANTS \PUP.ROUTINGINFO.WORDS)
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \PUP.ROUTING.TABLE \PUP.ROUTING.TABLE.RADIUS \PUPROUTER.PROBECOUNT \PUPROUTER.PROBETIMER 
	    \PUPROUTER.PROBEINTERVAL \PUP.READY \PUP.READY.EVENT \PUP.READY.LOCK)
)
)



(* Sockets)


(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(DATATYPE PUPSOCKET
 ((NIL BYTE)
		     (PUPSOCLINK POINTER)                    (* So that we can Queue them)

		     (PSOCKET# FIXP)
		     (INQUEUE POINTER)
		     (INQUEUELENGTH WORD)
		     (PUPSOC#ALLOCATION WORD)
		     (PUPSOCHANDLE WORD)                     (* Back-fitting for Bcpl)

		     (PUPSOCPUPADDRESS WORD)                 (* Local net/host)

		     (NIL BYTE)
		     (PUPSOCEVENT POINTER)                   (* Event that is notified when a pup arrives on this 

							     socket)

		     (NIL BYTE)
		     (NIL POINTER))
		    (
BLOCKRECORD
 PUPSOCKET ((NIL BYTE)
				  (NIL POINTER)
				  (PSOCKETHI WORD)
				  (PSOCKETLO WORD)))
		    INQUEUE _(create
 SYSQUEUE)
		    PUPSOC#ALLOCATION _ \MAX.EPKTS.ON.PUPSOCKET)
]
(/DECLAREDATATYPE (QUOTE PUPSOCKET)
		  (QUOTE (BYTE POINTER FIXP POINTER WORD WORD WORD WORD BYTE POINTER BYTE POINTER)))

(DECLARE: EVAL@COMPILE 

(PUTPROPS \PUPSOCKET.FROM# MACRO
 (OPENLAMBDA (SOCHI SOCLO)
					     (for
 SOC in
 \PUPSOCKETS
						when
 (
AND
 (
EQ
 (fetch
 PSOCKETLO of
 SOC)
							      SOCLO)
							  (
EQ
 (fetch
 PSOCKETHI of
 SOC)
							      SOCHI))
						do
 (
RETURN
 SOC))))
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \PUPSOCKETS.TABLE \MAX.EPKTS.ON.PUPSOCKET \PUP.CHECKSUMFLG)
)
)
(/DECLAREDATATYPE (QUOTE PUPSOCKET)
		  (QUOTE (BYTE POINTER FIXP POINTER WORD WORD WORD WORD BYTE POINTER BYTE POINTER)))
[ADDTOVAR SYSTEMRECLST

(DATATYPE PUPSOCKET
 ((NIL BYTE)
		     (PUPSOCLINK POINTER)
		     (PSOCKET# FIXP)
		     (INQUEUE POINTER)
		     (INQUEUELENGTH WORD)
		     (PUPSOC#ALLOCATION WORD)
		     (PUPSOCHANDLE WORD)
		     (PUPSOCPUPADDRESS WORD)
		     (NIL BYTE)
		     (PUPSOCEVENT POINTER)
		     (NIL BYTE)
		     (NIL POINTER)))
]
(DEFINEQ

(OPENPUPSOCKET

  [LAMBDA (SKT# IFCLASH)                                     (* bvm: "21-JUL-83 10:36")


          (* Creates a new local PUPSOCKET If SKT# is supplied, it is the identifying number (32-bit) of the socket, and an 

	  error occurs if that socket is already in use.)



    (PROG ((ID#EXPLICIT? (FIXP SKT#))
	   PUPSOC CLASHP SOCHI SOCLO)
          [COND
	    [(type?
 PUPSOCKET SKT#)
	      (SETQ PUPSOC SKT#)
	      (\FLUSHPUPSOCQUEUE
 PUPSOC)
	      (COND
		((NEQ PUPSOC (\PUPSOCKET.FROM# (fetch
 PSOCKETHI of
 PUPSOC)
					       (fetch
 PSOCKETLO of
 PUPSOC)))
		  (ERROR PUPSOC "Attempt to re-open a released PUPSOCKET."]
	    (T (COND
		 (ID#EXPLICIT? (SETQ SOCHI (\HINUM SKT#))
			       (SETQ SOCLO (\LONUM SKT#)))
		 (T                                          (* Pick a socket that is reasonably random but won't 

							     conflict with well-known sockets)

		    [SETQ SOCLO (LOGOR 100000Q (\LONUM (DAYTIME]
		    (SETQ SOCHI 1)))
	       (UNINTERRUPTABLY
                   [do
 (COND
			 ((NOT (SETQ CLASHP (\PUPSOCKET.FROM# SOCHI SOCLO)))
			   (SETQ PUPSOC (create
 PUPSOCKET
						PSOCKETHI _ SOCHI
						PSOCKETLO _ SOCLO))
			   (replace
 PUPSOCEVENT of
 PUPSOC with
 (CREATE.EVENT PUPSOC))
			   (push
 \PUPSOCKETS PUPSOC)
			   (RETURN))
			 [(NOT ID#EXPLICIT?)
			   (SETQ SOCLO (LOGOR 100000Q (ADD1 (LOGAND SOCLO 77777Q]
			 (T (RETURN])
	       (COND
		 (CLASHP (SELECTQ IFCLASH
				  ((T ACCEPT)
				    (\FLUSHPUPSOCQUEUE
 (SETQ PUPSOC CLASHP)))
				  ((DON'T FAIL)
				    (RETURN NIL))
				  (ERROR "Socket number is already in use" SKT#]
          (RETURN PUPSOC])

(CLOSEPUPSOCKET

  [LAMBDA (PUPSOC NOERRORFLG)                                (* bvm: " 5-MAY-83 23:58")

                                                             (* Closes a local PUPSOCKET -- argument = T means close 

							     all sockets)

    (COND
      ((EQ PUPSOC T)
	(while
 \PUPSOCKETS
	   do
 (\FLUSHPUPSOCQUEUE
 (SETQ PUPSOC (pop
 \PUPSOCKETS)))
	      (replace
 PUPSOCEVENT of
 PUPSOC with
 NIL)))
      (T (\FLUSHPUPSOCQUEUE
 (\DTEST PUPSOC (QUOTE PUPSOCKET)))
	 (PROG1 (COND
		  ((FMEMB PUPSOC \PUPSOCKETS)
		    (SETQ \PUPSOCKETS (DREMOVE PUPSOC \PUPSOCKETS))
		    T)
		  ((NOT NOERRORFLG)
		    (ERROR PUPSOC "not an open PUP socket")))
		(replace
 PUPSOCEVENT of
 PUPSOC with
 NIL])

(PUPSOCKETNUMBER

  [LAMBDA (PUPSOC)                                           (* bvm: "14-FEB-83 15:21")

    (fetch
 PSOCKET# of
 PUPSOC])

(PUPSOCKETFROMNUMBER

  [LAMBDA (SOC#orSOCLO SOCHI)                                (* bvm: "21-JUL-83 11:39")

    [COND
      ((NULL SOCHI)
	(SETQ SOCHI (\HINUM SOC#orSOCLO))
	(SETQ SOC#orSOCLO (LOGAND SOC#orSOCLO 177777Q]
    (\PUPSOCKET.FROM# SOCHI SOC#orSOCLO])

(PUPSOCKETEVENT

  [LAMBDA (PUPSOC)                                           (* bvm: "10-MAY-83 22:32")

    (ffetch
 PUPSOCEVENT of
 (\DTEST PUPSOC (QUOTE PUPSOCKET])

(\FLUSHPUPSOCQUEUE

  [LAMBDA (PUPSOC)                                           (* bvm: "11-FEB-83 12:55")

    (\FLUSH.PACKET.QUEUE (fetch
 (PUPSOCKET INQUEUE) of
 PUPSOC))
    (replace
 (PUPSOCKET INQUEUELENGTH) of
 PUPSOC with
 0)
    PUPSOC])
)
(DEFINEQ

(\GETMISCSOCKET

  [LAMBDA NIL                                                (* bvm: "14-FEB-83 15:29")

                                                             (* Opens a socket for miscellaneous services, if we 

							     don't have it open yet)

    (COND
      ((AND \MISC.SOCKET (FMEMB \MISC.SOCKET \PUPSOCKETS))
	\MISC.SOCKET)
      (T (SETQ \MISC.SOCKET (OPENPUPSOCKET])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \MISC.SOCKET \PUPSOCKETS)
)

(RPAQ? \MISC.SOCKET
 )

(RPAQ? \PUPSOCKETS
 )
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(BLOCKRECORD PORT
 ((NETHOST WORD)
		   (SOCKET FIXP))
		  (
BLOCKRECORD
 PORT ((NET BYTE)
				(HOST BYTE)
				(SOCKETHI WORD)
				(SOCKETLO WORD))))

(ACCESSFNS ERRORPUP
 ((ERRORPUPBASE (fetch
 PUPCONTENTS of
 DATUM)))
		    (
BLOCKRECORD
 ERRORPUPBASE ((ERRORPUPCOPY 12Q WORD)
                                                             (* Copy of pup header)

				  (ERRORPUPCODE WORD)
				  (ERRORPUPARG WORD)         (* Usually zero)

				  (ERRORPUPSTRINGBASE WORD)
                                                             (* Human readable message)

				  )))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \ETHERWAIT1 \ETHERTIMEOUT \MAXETHERTRIES PUPTRACEFLG LOGINPASSWORDS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PUPTRACEFILE PUPONLYTYPES PUPIGNORETYPES PUPPRINTMACROS)
)
(DECLARE: EVAL@COMPILE 

(RPAQQ \PUPOVLEN
 26Q)

(RPAQQ \MAX.PUPLENGTH
 1024Q)

(RPAQQ \TIME.GETPUP
 5)

(CONSTANTS (\PUPOVLEN 26Q)
	   (\MAX.PUPLENGTH 1024Q)
	   (\TIME.GETPUP 5))
)

(PUTPROPS PUPPRINTMACROS VARTYPE
 ALIST)
(DECLARE: EVAL@COMPILE 
(I.S.OPR (QUOTE INCHARS)
	 NIL
	 [QUOTE (SUBPAIR (QUOTE ($BASE $OFF $END))
			 (LIST (GETDUMMYVAR)
			       (GETDUMMYVAR)
			       (GETDUMMYVAR))
			 (QUOTE (bind $BASE $OFF $END first [COND
					((LITATOM BODY)
					 (SETQ $OFF 1)
					 (SETQ $BASE (fetch (LITATOM PNAMEBASE)
							    of BODY))
					 (SETQ $END (fetch (LITATOM PNAMELENGTH)
							   of BODY)))
					(T [SETQ $OFF (fetch (STRINGP OFFST)
							     of
							     (OR (STRINGP BODY)
								 (SETQ BODY (MKSTRING BODY]
					   (SETQ $BASE (fetch (STRINGP BASE)
							      of BODY))
					   (SETQ $END (IPLUS $OFF (fetch (STRINGP LENGTH)
									 of BODY)
							     -1]
				      eachtime
				      (COND ((IGREATERP $OFF $END)
					     (GO $$OUT))
					    (T (SETQ I.V. (\GETBASEBYTE $BASE $OFF))
					       (SETQ $OFF (ADD1 $OFF]
	 T)
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS \GETPUPWORD DMACRO
 ((PUP WORD#)
			      (\GETBASE (fetch PUPCONTENTS of PUP)
					WORD#)))

(PUTPROPS \PUTPUPWORD DMACRO
 ((PUP WORD# VALUE)
			      (\PUTBASE (fetch PUPCONTENTS of PUP)
					WORD# VALUE)))

(PUTPROPS \GETPUPBYTE DMACRO
 ((PUP BYTE#)
			      (\GETBASEBYTE (fetch PUPCONTENTS of PUP)
					    BYTE#)))

(PUTPROPS \PUTPUPBYTE DMACRO
 ((PUP BYTE# VALUE)
			      (\PUTBASEBYTE (fetch PUPCONTENTS of PUP)
					    BYTE# VALUE)))
)

(RPAQQ RAWPUPTYPES
 ((\PT.ECHOME 1)
		    (\PT.IAMECHO 2)
		    (\PT.IAMBADECHO 3)
		    (\PT.ERROR 4)
		    (\PT.RFC 10Q)
		    (\PT.ABORT 11Q)
		    (\PT.END 12Q)
		    (\PT.ENDREPLY 13Q)
		    (\PT.DATA 20Q)
		    (\PT.ADATA 21Q)
		    (\PT.ACK 22Q)
		    (\PT.MARK 23Q)
		    (\PT.INTERRUPT 24Q)
		    (\PT.INTERRUPTREPLY 25Q)
		    (\PT.AMARK 26Q)
		    (\PT.GATEWAYREQUEST 200Q)
		    (\PT.GATEWAYRESPONSE 201Q)
		    (\PT.ALTOTIMEREQUEST 206Q)
		    (\PT.ALTOTIMERESPONSE 207Q)
		    (\PT.MSGCHECK 210Q)
		    (\PT.NEWMAIL 211Q)
		    (\PT.NONEWMAIL 212Q)
		    (\PT.NOMAILBOX 213Q)
		    (\PT.LAURELCHECK 214Q)
		    (\PT.NAMELOOKUP 220Q)
		    (\PT.NAMERESPONSE 221Q)
		    (\PT.NAME/ADDRERROR 222Q)
		    (\PT.ADDRLOOKUP 223Q)
		    (\PT.ADDRRESPONSE 224Q)
		    (\PT.PRINTERSTATUS 200Q)
		    (\PT.STATUSRESPONSE 201Q)
		    (\PT.PRINTERCAPABILITY 202Q)
		    (\PT.CAPABILITYRESPONSE 203Q)
		    (\PT.PRINTJOBSTATUS 204Q)
		    (\PT.PRINTJOBRESPONSE 205Q)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \PT.ECHOME
 1)

(RPAQQ \PT.IAMECHO
 2)

(RPAQQ \PT.IAMBADECHO
 3)

(RPAQQ \PT.ERROR
 4)

(RPAQQ \PT.RFC
 10Q)

(RPAQQ \PT.ABORT
 11Q)

(RPAQQ \PT.END
 12Q)

(RPAQQ \PT.ENDREPLY
 13Q)

(RPAQQ \PT.DATA
 20Q)

(RPAQQ \PT.ADATA
 21Q)

(RPAQQ \PT.ACK
 22Q)

(RPAQQ \PT.MARK
 23Q)

(RPAQQ \PT.INTERRUPT
 24Q)

(RPAQQ \PT.INTERRUPTREPLY
 25Q)

(RPAQQ \PT.AMARK
 26Q)

(RPAQQ \PT.GATEWAYREQUEST
 200Q)

(RPAQQ \PT.GATEWAYRESPONSE
 201Q)

(RPAQQ \PT.ALTOTIMEREQUEST
 206Q)

(RPAQQ \PT.ALTOTIMERESPONSE
 207Q)

(RPAQQ \PT.MSGCHECK
 210Q)

(RPAQQ \PT.NEWMAIL
 211Q)

(RPAQQ \PT.NONEWMAIL
 212Q)

(RPAQQ \PT.NOMAILBOX
 213Q)

(RPAQQ \PT.LAURELCHECK
 214Q)

(RPAQQ \PT.NAMELOOKUP
 220Q)

(RPAQQ \PT.NAMERESPONSE
 221Q)

(RPAQQ \PT.NAME/ADDRERROR
 222Q)

(RPAQQ \PT.ADDRLOOKUP
 223Q)

(RPAQQ \PT.ADDRRESPONSE
 224Q)

(RPAQQ \PT.PRINTERSTATUS
 200Q)

(RPAQQ \PT.STATUSRESPONSE
 201Q)

(RPAQQ \PT.PRINTERCAPABILITY
 202Q)

(RPAQQ \PT.CAPABILITYRESPONSE
 203Q)

(RPAQQ \PT.PRINTJOBSTATUS
 204Q)

(RPAQQ \PT.PRINTJOBRESPONSE
 205Q)

(CONSTANTS (\PT.ECHOME 1)
	   (\PT.IAMECHO 2)
	   (\PT.IAMBADECHO 3)
	   (\PT.ERROR 4)
	   (\PT.RFC 10Q)
	   (\PT.ABORT 11Q)
	   (\PT.END 12Q)
	   (\PT.ENDREPLY 13Q)
	   (\PT.DATA 20Q)
	   (\PT.ADATA 21Q)
	   (\PT.ACK 22Q)
	   (\PT.MARK 23Q)
	   (\PT.INTERRUPT 24Q)
	   (\PT.INTERRUPTREPLY 25Q)
	   (\PT.AMARK 26Q)
	   (\PT.GATEWAYREQUEST 200Q)
	   (\PT.GATEWAYRESPONSE 201Q)
	   (\PT.ALTOTIMEREQUEST 206Q)
	   (\PT.ALTOTIMERESPONSE 207Q)
	   (\PT.MSGCHECK 210Q)
	   (\PT.NEWMAIL 211Q)
	   (\PT.NONEWMAIL 212Q)
	   (\PT.NOMAILBOX 213Q)
	   (\PT.LAURELCHECK 214Q)
	   (\PT.NAMELOOKUP 220Q)
	   (\PT.NAMERESPONSE 221Q)
	   (\PT.NAME/ADDRERROR 222Q)
	   (\PT.ADDRLOOKUP 223Q)
	   (\PT.ADDRRESPONSE 224Q)
	   (\PT.PRINTERSTATUS 200Q)
	   (\PT.STATUSRESPONSE 201Q)
	   (\PT.PRINTERCAPABILITY 202Q)
	   (\PT.CAPABILITYRESPONSE 203Q)
	   (\PT.PRINTJOBSTATUS 204Q)
	   (\PT.PRINTJOBRESPONSE 205Q))
)

(RPAQ? PUPTYPES
 RAWPUPTYPES)

(RPAQQ WELLKNOWNPUPSOCKETS
 ((\PUPSOCKET.TELNET 1)
			    (\PUPSOCKET.ROUTING 2)
			    (\PUPSOCKET.FTP 3)
			    (\PUPSOCKET.MISCSERVICES 4)
			    (\PUPSOCKET.ECHO 5)
			    (\PUPSOCKET.EFTP 20Q)
			    (\PUPSOCKET.PRINTERSTATUS 21Q)
			    (\PUPSOCKET.LEAF 43Q)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \PUPSOCKET.TELNET
 1)

(RPAQQ \PUPSOCKET.ROUTING
 2)

(RPAQQ \PUPSOCKET.FTP
 3)

(RPAQQ \PUPSOCKET.MISCSERVICES
 4)

(RPAQQ \PUPSOCKET.ECHO
 5)

(RPAQQ \PUPSOCKET.EFTP
 20Q)

(RPAQQ \PUPSOCKET.PRINTERSTATUS
 21Q)

(RPAQQ \PUPSOCKET.LEAF
 43Q)

(CONSTANTS (\PUPSOCKET.TELNET 1)
	   (\PUPSOCKET.ROUTING 2)
	   (\PUPSOCKET.FTP 3)
	   (\PUPSOCKET.MISCSERVICES 4)
	   (\PUPSOCKET.ECHO 5)
	   (\PUPSOCKET.EFTP 20Q)
	   (\PUPSOCKET.PRINTERSTATUS 21Q)
	   (\PUPSOCKET.LEAF 43Q))
)


(* END EXPORTED DEFINITIONS)



(RPAQQ PUPCONSTANTS
 ((\PUPHEADERLEN 24Q)
		     (\NetMask 177400Q)
		     (\HILOCALSOCKET 1)
		     (\PORTIDLEN 3)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \PUPHEADERLEN
 24Q)

(RPAQQ \NetMask
 177400Q)

(RPAQQ \HILOCALSOCKET
 1)

(RPAQQ \PORTIDLEN
 3)

(CONSTANTS (\PUPHEADERLEN 24Q)
	   (\NetMask 177400Q)
	   (\HILOCALSOCKET 1)
	   (\PORTIDLEN 3))
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS PUPDEBUGGING MACRO
 [(X . Y)
			      (
COND

				(PUPTRACEFLG (printout
 PUPTRACEFILE X . Y])
)


(ADDTOVAR PUPPRINTMACROS
 (210Q CHARS)
			 (214Q CHARS)
			 (211Q CHARS)
			 (213Q CHARS)
			 (201Q WORDS 2 CHARS 24Q ...)
			 (30Q CHARS))

[DECLARE: EVAL@COMPILE 

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

			     )
]
)



(* echo utilities)


(DEFINEQ

(PUP.ECHOSERVER

  [LAMBDA (ECHOWINDOW FLG)                                   (* bvm: " 7-AUG-83 01:11")

    (RESETLST (PROG ((SOC (OPENPUPSOCKET
 \PUPSOCKET.ECHO T))
		     PUP EVENT ISGOOD)
		    (RESETSAVE NIL (LIST (QUOTE CLOSEPUPSOCKET)
					 SOC))
		    (OR FLG (SETQ FLG (QUOTE PEEK)))
		    (SETQ EVENT (fetch
 PUPSOCEVENT of
 SOC))
		LP  (COND
		      ((SETQ PUP (GETPUP
 SOC))
			(SETQ ISGOOD (EQ (fetch
 PUPTYPE of
 PUP)
					 \PT.ECHOME))
			[COND
			  (ECHOWINDOW (SELECTQ FLG
					       (NIL)
					       (PEEK (PRIN1 (COND
							      (ISGOOD (QUOTE !))
							      (T (QUOTE ?)))
							    ECHOWINDOW))
					       (PRINTPUP
 PUP NIL ECHOWINDOW]
			(COND
			  (ISGOOD (replace
 TYPEWORD of
 PUP with
 \PT.IAMECHO)
				  (SWAPPUPPORTS
 PUP)
				  (replace
 EPREQUEUE of
 PUP with
 (QUOTE FREE))
				  (SENDPUP
 SOC PUP))
			  (T (RELEASE.PUP PUP)))
			(BLOCK))
		      (T (AWAIT.EVENT EVENT)))
		    (GO LP])

(PUP.ECHOUSER

  [LAMBDA (HOST ECHOSTREAM INTERVAL NTIMES)                  (* bvm: " 1-NOV-83 15:31")

    (RESETLST (PROG ((OPUP (ALLOCATE.PUP))
		     (PORT (BESTPUPADDRESS
 HOST (OR ECHOSTREAM PROMPTWINDOW)))
		     (SOC (OPENPUPSOCKET
))
		     (TIMER (SETUPTIMER 0))
		     IPUP EVENT ECHOPUPLENGTH I)
		    (RESETSAVE NIL (LIST (QUOTE CLOSEPUPSOCKET)
					 SOC))
		    (OR PORT (RETURN))
		    (OR INTERVAL (SETQ INTERVAL 1750Q))
		    (OR NTIMES (SETQ NTIMES 1750Q))
		    (SETQ ECHOSTREAM (GETSTREAM (OR ECHOSTREAM T)
						(QUOTE OUTPUT)))
		    (SETUPPUP
 OPUP PORT \PUPSOCKET.ECHO \PT.ECHOME NIL SOC T)
		    (PUTPUPWORD
 OPUP 0 (SETQ I 1))
		    (add
 (fetch
 PUPLENGTH of
 OPUP)
			 BYTESPERWORD)
		    (PUTPUPSTRING
 OPUP "Random string for echo")
		    (SETQ ECHOPUPLENGTH (fetch
 PUPLENGTH of
 OPUP))
		    (SETQ EVENT (fetch
 PUPSOCEVENT of
 SOC))
		LP  (SENDPUP
 SOC OPUP)
		    (PRIN1 (QUOTE !)
			   ECHOSTREAM)
		    (SETUPTIMER INTERVAL TIMER)
		    (do
 (COND
			  [(SETQ IPUP (GETPUP
 SOC))
			    (COND
			      ((PROG1 (SELECTC (fetch
 PUPTYPE of
 IPUP)
					       (\PT.IAMBADECHO (PRIN1 (QUOTE x)
								      ECHOSTREAM))
					       (\PT.IAMECHO (COND
							      ((NOT (AND (EQ (fetch
 PUPIDHI
										of
 IPUP)
									     (fetch
 PUPIDHI
										of
 OPUP))
									 (EQ (fetch
 PUPIDLO
										of
 IPUP)
									     (fetch
 PUPIDLO
										of
 OPUP))
									 (EQ (fetch
 PUPLENGTH
										of
 IPUP)
									     ECHOPUPLENGTH)))
								(PRIN1 (QUOTE ?)
								       ECHOSTREAM)
								NIL)
							      ((IEQP (GETPUPWORD
 IPUP 0)
								     I)
								(PRIN1 (QUOTE +)
								       ECHOSTREAM))
							      (T (PRIN1 "(late)" ECHOSTREAM)
								 NIL)))
					       (\PT.ERROR (PRINTERRORPUP
 IPUP ECHOSTREAM)
							  NIL)
					       (PROGN (PRIN1 (QUOTE ?)
							     ECHOSTREAM)
						      NIL))
				      (RELEASE.PUP IPUP))
				(RETURN]
			  (T (AWAIT.EVENT EVENT TIMER T)))
		       repeatuntil
 (TIMEREXPIRED? TIMER)
		       finally
 (COND
				 ((fetch
 EPTRANSMITTING of
 OPUP)
				   (PRIN1 "[not yet transmitted; maybe transmitter is off]" 
					  ECHOSTREAM)))
			       (PRIN1 (QUOTE %.)
				      ECHOSTREAM))
		    (COND
		      ((IGREATERP (OR (EQ NTIMES T)
				      (add
 NTIMES -1))
				  0)
			(PUTPUPWORD
 OPUP 0 (add
 I 1))
			(GO LP])
)



(* Peeking)


(DEFINEQ

(\PEEKPUP

  [LAMBDA (HOST FILE)                                        (* bvm: " 1-NOV-83 15:32")

    (PROG (NETHOST L)
          [COND
	    ((NULL HOST)
	      (SELECTQ (fetch
 NETTYPE of
 \LOCALNDBS)
		       (3 (\PUTBASE (EMADDRESS \ETHERHOSTLOC)
				    0
				    (fetch
 NDBPUPHOST# of
 \LOCALNDBS)))
		       (12Q)
		       NIL)
	      (RPTQ 24Q (BLOCK))                             (* empty the pipe)

	      (SETQ \PEEKPUPNUMBER))
	    (T [COND
		 ((EQ HOST T)
		   (SETQ \PEEKPUPNUMBER T))
		 (T [SETQ L (for
 H inside
 HOST
			       collect
 (PROGN (SETQ NETHOST (CAR (BESTPUPADDRESS
 H PROMPTWINDOW)))
					      (COND
						([AND NETHOST (OR (EQ (fetch
 PUPNET# of
 NETHOST)
								      0)
								  (EQ (fetch
 PUPNET# of
 NETHOST)
								      (\LOCALPUPNETNUMBER]
						  (fetch
 PUPHOST# of
 NETHOST))
						(T (ERROR H "not a host on local network"]
		    (SETQ \PEEKPUPNUMBER (COND
			((CDR L)
			  L)
			(T (CAR L]                           (* Now make us promiscuous)

	       (SELECTQ (fetch
 NETTYPE of
 \LOCALNDBS)
			(3 (\PUTBASE (EMADDRESS \ETHERHOSTLOC)
				     0 0))
			(12Q)
			NIL)
	       [COND
		 (FILE (SETQ PUPTRACEFILE (OR (OPENP FILE (QUOTE OUTPUT))
					      (OPENFILE FILE (QUOTE OUTPUT]
	       (OR PUPTRACEFLG (SETQ PUPTRACEFLG T]
          (RETURN \PEEKPUPNUMBER])

(\MAYBEPEEKPUP

  [LAMBDA (PUP)                                              (* bvm: " 5-Jan-85 23:39")

    [
COND

      ((
AND
 \PEEKPUPNUMBER PUPTRACEFLG)
	(
PROG
 (DIRECTION)
	      (
COND

		([
OR
 (
EQ
 \PEEKPUPNUMBER T)
		     (
EQ
 (fetch
 PUPDESTHOST of
 PUP)
			 0)
		     (for
 HOST inside
 \PEEKPUPNUMBER thereis
 (
OR
 [
COND

								   ((
EQ
 (fetch
 PUPSOURCEHOST
									   of
 PUP)
									HOST)
								     (
SETQ
 DIRECTION (
QUOTE
 PUT]
								 (
COND

								   ((
EQ
 (fetch
 PUPDESTHOST
									   of
 PUP)
									HOST)
								     (
SETQ
 DIRECTION (
QUOTE
 GET]
		  (PRINTPUP
 PUP DIRECTION PUPTRACEFILE NIL T]
    (
\RELEASE.ETHERPACKET
 PUP])
)

(RPAQ? \PEEKPUPNUMBER
 )
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \ETHERHOSTLOC
 610Q)

(CONSTANTS \ETHERHOSTLOC)
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \PEEKPUPNUMBER)
)
)



(* Debugging assistance)


(DEFINEQ

(PRINTPUP

  [LAMBDA (PACKET CALLER FILE PRE.NOTE DOFILTER)             (* bvm: " 5-Jan-85 23:40")

    (
\DTEST
 PACKET (
QUOTE
 ETHERPACKET))
    (
OR
 FILE (
SETQ
 FILE PUPTRACEFILE))
    (
PROG
 ((TYPE (fetch
 PUPTYPE of
 PACKET))
	   MACRO LENGTH)
          (
COND

	    ([
AND
 DOFILTER (
COND

		    (PUPONLYTYPES (
NOT
 (
FMEMB
 TYPE PUPONLYTYPES)))
		    (PUPIGNORETYPES (
FMEMB
 TYPE PUPIGNORETYPES]
	      (
PRIN1
 (
SELECTQ
 CALLER
			      [(GET RAWGET)
				(
COND

				  ((
EQ
 (fetch
 PUPDESTHOST of
 PACKET)
				       0)                    (* Broadcast)

				    (
QUOTE
 *))
				  (T (
QUOTE
 +]
			      ((
PUT
 RAWPUT)
				(
QUOTE
 !))
			      (
QUOTE
 ?))
		     PUPTRACEFILE)
	      (
RETURN
)))
          (
AND
 PRE.NOTE (
PRIN1
 PRE.NOTE FILE))
          (PRINTPUPROUTE
 PACKET CALLER FILE)
          [
COND

	    ((
SETQ
 MACRO (
CDR
 (
FASSOC
 TYPE PUPPRINTMACROS)))
	      (
COND

		((
NLISTP
 MACRO)
		  (
RETURN
 (
RESETFORM
 (
OUTPUT
 FILE)
				     (
APPLY*
 MACRO PACKET FILE]
          (printout
 FILE "Length = " .P2 (
SETQ
 LENGTH (fetch
 PUPLENGTH of
 PACKET))
		    " bytes" " (header + " .P2 (
IDIFFERENCE
 LENGTH \PUPOVLEN)
		    ")" T "Type = ")
          (PRINTCONSTANT
 TYPE PUPTYPES FILE "\PT.")
          (printout
 FILE ", ID = " .P2 (fetch
 PUPID of
 PACKET)
		    T)
          (
COND

	    ((
IGREATERP
 LENGTH \PUPOVLEN)                    (* Tells how to print data. Consists of elements in 

							     pairs: a byte offset followed by a type)

	      (
PRIN1
 "Contents: " FILE)
	      (
PRINTPACKETDATA
 (fetch
 PUPCONTENTS of
 PACKET)
			       0
			       (
OR
 MACRO (
QUOTE
 (BYTES 14Q ...)))
			       (
IDIFFERENCE
 LENGTH \PUPOVLEN)
			       FILE)))
          (
TERPRI
 FILE))
    PACKET])

(PRINTPUPROUTE

  [LAMBDA (PACKET CALLER FILE)                               (* bvm: "26-OCT-83 15:33")

    (TAB 0 0 FILE)
    (AND CALLER (printout
 FILE CALLER ":  "))
    (PROG ((CONTROL (fetch
 PUPTCONTROL of
 PACKET))
	   CSECS)
          (printout
 FILE "From " (PORTSTRING
 (fetch
 PUPSOURCE of
 PACKET)
					     (fetch
 PUPSOURCESOCKET of
 PACKET))
		    " to "
		    (PORTSTRING
 (fetch
 PUPDEST of
 PACKET)
				(fetch
 PUPDESTSOCKET of
 PACKET)))
          [COND
	    ((NEQ CONTROL 0)
	      (printout
 FILE ", Hops = " .P2 (LRSH CONTROL 4]
          (COND
	    (PUPTRACETIME (printout
 FILE " [" .I4 (IQUOTIENT (SETQ CSECS (\CENTICLOCK
 PACKET))
							     144Q)
				    (QUOTE %.)
				    .I2..T
				    (IREMAINDER CSECS 144Q)
				    "]")))
          (TERPRI FILE])

(PRINTPUPDATA

  [LAMBDA (PUP MACRO OFFSET FILE)                            (* bvm: "26-MAY-83 12:13")

    (PRINTPACKETDATA (fetch
 PUPCONTENTS of
 PUP)
		     OFFSET MACRO (IDIFFERENCE (fetch
 PUPLENGTH of
 PUP)
					       \PUPOVLEN)
		     FILE])

(PRINTERRORPUP

  [LAMBDA (PUP FILE)                                         (* bvm: "12-FEB-83 16:24")

    (printout
 FILE "From " (PORTSTRING
 (fetch
 PUPSOURCE of
 PUP))
	      ": [Error " .P2 (fetch
 ERRORPUPCODE of
 PUP)
	      "] "
	      (GETPUPSTRING
 PUP 30Q)
	      T])

(PUPTRACE

  [LAMBDA (FLG REGION)                                       (* bvm: "11-JUL-83 17:19")

    (COND
      ((NULL FLG)
	(COND
	  ((ACTIVEWP PUPTRACEFILE)
	    (CLOSEW PUPTRACEFILE)))
	(SETQ PUPTRACEFILE T)
	(SETQ PUPTRACEFLG))
      (T (SETQ PUPTRACEFILE (CREATEW REGION "Pup traffic"))
	 [WINDOWPROP PUPTRACEFILE (QUOTE BUTTONEVENTFN)
		     (FUNCTION (LAMBDA (WINDOW)
			 (COND
			   ((LASTMOUSESTATE (NOT UP))
			     (\CHANGE.ETHER.TRACING
 WINDOW (QUOTE PUPTRACEFLG]
	 [WINDOWPROP PUPTRACEFILE (QUOTE CLOSEFN)
		     (FUNCTION (LAMBDA (WINDOW)
			 (COND
			   ((EQ WINDOW PUPTRACEFILE)
			     (SETQ PUPTRACEFLG)
			     (SETQ PUPTRACEFILE T]
	 (DSPFONT (FONTCREATE (QUOTE GACHA)
			      10Q)
		  PUPTRACEFILE)
	 (SETQ PUPTRACEFLG FLG)
	 (DSPSCROLL T PUPTRACEFILE)
	 PUPTRACEFILE])

(\CHANGE.ETHER.TRACING

  [LAMBDA (WINDOW FLGNAME)                                   (* bvm: "11-JUL-83 17:14")

    (printout
 WINDOW .TAB0 0 "[Tracing " (COND
		[(LASTMOUSESTATE LEFT)
		  (SELECTQ (EVALV FLGNAME)
			   (NIL (SET FLGNAME T)
				"On]")
			   (T (SET FLGNAME (QUOTE PEEK))
			      "Brief]")
			   (COND
			     ((OR (NOT \RAWTRACING)
				  (EQ (EVALV FLGNAME)
				      (QUOTE RAW)))
			       (SET FLGNAME NIL)
			       "Off]")
			     (T (SET FLGNAME (QUOTE RAW))
				"only Raw]"]
		(T (COND
		     (\RAWTRACING (SETQ \RAWTRACING NIL)
				  "Raw Off]")
		     (T (SETQ \RAWTRACING T)
			"Raw On]"])

(PRINTCONSTANT

  [LAMBDA (VAR CONSTANTLIST FILE PREFIX)                     (* bvm: " 4-APR-83 16:11")

    (PRIN2 VAR FILE)
    (COND
      ((LISTP CONSTANTLIST)
	(PRIN1 " (" FILE)
	(PRIN1 (OR [for
 X in
 CONSTANTLIST when
 (EQ (CADR X)
						   VAR)
		      do
 (RETURN (COND
				   [(AND PREFIX (STRPOS PREFIX (CAR X)
							1 NIL T))
				     (SUBSTRING (CAR X)
						(ADD1 (NCHARS PREFIX]
				   (T (CAR X]
		   (QUOTE ?))
	       FILE)
	(PRIN1 ")" FILE])
)

(RPAQ? PUPTRACEFLG
 )

(RPAQ? PUPTRACEFILE
 T)

(RPAQ? PUPTRACETIME
 )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PUPTRACETIME)
)

(ADDTOVAR PUPPRINTMACROS
 )

(ADDTOVAR PUPONLYTYPES
 )

(ADDTOVAR PUPIGNORETYPES
 )

(ADDTOVAR PUPPRINTMACROS
 (4 . PRINTERRORPUP)
			 (220Q CHARS)
			 (221Q REPEAT BYTES -2 WORDS -4)
			 (223Q BYTES -2 WORDS)
			 (224Q CHARS))
(DEFINEQ

(\CENTICLOCK

  [LAMBDA (PACKET)                                           (* bvm: "26-OCT-83 15:42")


          (* * Returns a relative time in centiseconds. If PACKET is given, the time is a translation of its EPTIMESTAMP;

	  otherwise the time is now)



    (PROG ((CLK \CENTICLOCKBOX))
          (COND
	    (PACKET (\BLT CLK (LOCF (fetch
 EPTIMESTAMP of
 PACKET))
			  WORDSPERCELL))
	    (T (\RCLK CLK)))
          (replace
 CENTICLOCKSIGNBIT of
 CLK with
 0)
          (RETURN (IQUOTIENT CLK (OR \CENTICLOCKFACTOR (SETQ \CENTICLOCKFACTOR (ITIMES 12Q 
										 \RCLKMILLISECOND])
)

(RPAQQ \CENTICLOCKFACTOR
 NIL)

(RPAQ \CENTICLOCKBOX
 (NCREATE (QUOTE FIXP)))

(ADDTOVAR \SYSTEMCACHEVARS
 \CENTICLOCKFACTOR)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \CENTICLOCKFACTOR \CENTICLOCKBOX)
)

[DECLARE: EVAL@COMPILE 

(BLOCKRECORD CENTICLOCK
 ((CENTICLOCKSIGNBIT BITS 1)
			 (CENTICLOCKMAGNITUDE BITS 37Q)))
]
)
(DECLARE: DONTEVAL@LOAD 
(\PUPINIT)
)
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP)
	   LLETHER)
)
(PUTPROPS PUP COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (16653Q 42333Q (\STARTPUP 16665Q . 17521Q) (ASSURE.PUP.READY 17523Q . 24026Q) (
\FIND.LOCALPUPHOSTNUMBER 24030Q . 25757Q) (\PROMPT.FOR.PUP.NUMBER 25761Q . 27252Q) (\HANDLE.RAW.PUP 
27254Q . 40236Q) (\FORWARD.PUP 40240Q . 41251Q) (\SETPUPCHECKSUM 41253Q . 42331Q)) (46373Q 51433Q (
\PUPERROR 46405Q . 51431Q)) (51466Q 66331Q (SETUPPUP 51500Q . 54110Q) (SWAPPUPPORTS 54112Q . 54676Q) (
GETPUP 54700Q . 56763Q) (SENDPUP 56765Q . 62354Q) (EXCHANGEPUPS 62356Q . 64203Q) (DISCARDPUPS 64205Q
 . 65007Q) (GETPUPWORD 65011Q . 65331Q) (\PUPINIT 65333Q . 66327Q)) (66332Q 120775Q (ETHERHOSTNAME 
66344Q . 73607Q) (ETHERHOSTNUMBER 73611Q . 74344Q) (ETHERPORT 74346Q . 77026Q) (BESTPUPADDRESS 77030Q
 . 104546Q) (NETDAYTIME0 104550Q . 105107Q) (\PUP.SETTIME 105111Q . 110075Q) (\SETNEWTIME0 110077Q . 
111030Q) (\NET.SETTIME 111032Q . 111776Q) (NETDATE 112000Q . 112276Q) (\LOOKUPPORT 112300Q . 115430Q) 
(\PARSE.PORTCONSTANT 115432Q . 117611Q) (\FIXLOCALNET 117613Q . 120773Q)) (120776Q 122326Q (PORTSTRING
 121010Q . 121773Q) (OCTALSTRING 121775Q . 122324Q)) (122713Q 135724Q (CLEARPUP 122725Q . 124243Q) (
PUTPUPWORD 124245Q . 124573Q) (GETPUPBYTE 124575Q . 125116Q) (PUTPUPBYTE 125120Q . 125447Q) (
GETPUPSTRING 125451Q . 126610Q) (GETPUPSTREAM 126612Q . 127436Q) (PUTPUPSTRING 127440Q . 130146Q) (
READPLIST 130150Q . 134241Q) (\STOREPLIST 134243Q . 135722Q)) (137121Q 141715Q (\CANONICAL.HOSTNAME 
137133Q . 141312Q) (CANONICAL.HOSTNAME 141314Q . 141713Q)) (143655Q 164443Q (\PUPGATELISTENER 143667Q
 . 146323Q) (\HANDLE.PUP.ROUTING.INFO 146325Q . 152722Q) (\ROUTE.PUP 152724Q . 156132Q) (
\LOCATE.PUPNET 156134Q . 161306Q) (SORT.PUPHOSTS.BY.DISTANCE 161310Q . 162727Q) (\PUPNET.CLOSERP 
162731Q . 163660Q) (PUPNET.DISTANCE 163662Q . 164441Q)) (172131Q 200515Q (OPENPUPSOCKET 172143Q . 
175351Q) (CLOSEPUPSOCKET 175353Q . 176734Q) (PUPSOCKETNUMBER 176736Q . 177166Q) (PUPSOCKETFROMNUMBER 
177170Q . 177607Q) (PUPSOCKETEVENT 177611Q . 200075Q) (\FLUSHPUPSOCQUEUE 200077Q . 200513Q)) (200516Q 
201350Q (\GETMISCSOCKET 200530Q . 201346Q)) (220062Q 226631Q (PUP.ECHOSERVER 220074Q . 222017Q) (
PUP.ECHOUSER 222021Q . 226627Q)) (226656Q 233006Q (\PEEKPUP 226670Q . 231424Q) (\MAYBEPEEKPUP 231426Q
 . 233004Q)) (233377Q 245572Q (PRINTPUP 233411Q . 237157Q) (PRINTPUPROUTE 237161Q . 240670Q) (
PRINTPUPDATA 240672Q . 241306Q) (PRINTERRORPUP 241310Q . 241773Q) (PUPTRACE 241775Q . 243442Q) (
\CHANGE.ETHER.TRACING 243444Q . 244627Q) (PRINTCONSTANT 244631Q . 245570Q)) (246374Q 247560Q (
\CENTICLOCK 246406Q . 247556Q)))))
STOP