(FILECREATED "23-Aug-84 15:37:20" {ERIS}<LISPCORE>SOURCES>LLNS.;13 67558
changes to: (FNS \LOOKUPPUPNUMBER)
previous date: "29-Jul-84 23:20:06" {ERIS}<LISPCORE>SOURCES>LLNS.;12)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLNSCOMS)
(RPAQQ LLNSCOMS ((COMS (* Xerox Internet Packet stuff.)
(DECLARE: DONTCOPY (EXPORT (RECORDS XIP)
(CONSTANTS \XIPOVLEN \MAX.XIPDATALENGTH)
(CONSTANTS * RAWXIPTYPES)
(CONSTANTS * XIPERRORCODES)))
(ADDVARS * (LIST (CONS (QUOTE XIPTYPES)
RAWXIPTYPES)))
(ALISTS (XIPERRORMESSAGES 1 2 3 513 514 515 516))
(GLOBALVARS XIPTYPES XIPERRORMESSAGES))
(COMS (* Parsing and looking up NS addresses)
(FNS \COERCE.TO.NSADDRESS \PARSE.NSADDRESSCONSTANT))
(COMS (* New SOCKET datatype stuff)
(DECLARE: DONTCOPY (EXPORT (RECORDS NSOCKET))
(* Well-known NS sockets)
(CONSTANTS (\NS.WKS.RoutingInformation 1)
(\NS.WKS.Echo 2)
(\NS.WKS.PUPLOOKUP 9))
(GLOBALVARS \NSOCKETS \MAX.EPKTS.ON.NSOCKET)
(MACROS \NSOCKET.FROM#))
(INITRECORDS NSOCKET)
(SYSRECORDS NSOCKET)
(FNS OPENNSOCKET CLOSENSOCKET NSOCKETEVENT NSOCKETNUMBER NSOCKETFROMNUMBER
\FLUSHNSOCQUEUE)
(INITVARS (\NSOCKETS)
(\MAX.EPKTS.ON.NSOCKET 16)))
(COMS (* assorted level 1 and 2)
(FNS \NSINIT STOPNS)
(FNS \HANDLE.RAW.XIP \XIPERROR \FORWARD.XIP)
(COMS (INITVARS (\NS.CHECKSUMFLG T))
(GLOBALVARS \NS.CHECKSUMFLG))
(FNS GETXIP DISCARDXIPS SENDXIP SWAPXIPADDRESSES \SETXIPCHECKSUM
\CLEARXIPHEADER)
(GLOBALRESOURCES \ROUTEBOX.HOST)
(FNS \FILLINXIP XIPAPPEND.BYTE XIPAPPEND.WORD XIPAPPEND.CELL XIPAPPEND.STRING
XIPAPPEND.IFSSTRING XIPAPPEND.INTEGER))
(COMS (* XIP routing)
(FNS \NSGATELISTENER \HANDLE.NS.ROUTING.INFO \ROUTE.XIP \LOCATE.NSNET
NSNET.DISTANCE BESTNSADDRESS SORT.NSADDRESSES.BY.DISTANCE \NSNET.CLOSERP)
(INITVARS (\NS.ROUTING.TABLE NIL)
(\NS.ROUTING.TABLE.RADIUS 5)
(\NSROUTER.PROBECOUNT 0)
(\NSROUTER.PROBETIMER)
(\NSROUTER.PROBEINTERVAL 3000)
(\NS.READY)
(\NS.READY.EVENT (CREATE.EVENT "NS Ready")))
(ADDVARS (\SYSTEMCACHEVARS \NS.READY))
(DECLARE: DONTCOPY (RECORDS NSROUTINGINFO)
(CONSTANTS \NS.ROUTINGINFO.WORDS \XROUTINGINFO.OP.REQUEST
\XROUTINGINFO.OP.RESPONSE)
(GLOBALVARS \NS.ROUTING.TABLE \NS.ROUTING.TABLE.RADIUS
\NSROUTER.PROBECOUNT \NSROUTER.PROBETIMER
\NSROUTER.PROBEINTERVAL \NS.READY \NS.READY.EVENT)))
(COMS (* Analogous to PUP stuff for tracing activity.)
(FNS XIPTRACE)
(FNS PRINTXIP PRINTERRORXIP PRINTXIPROUTE PRINTXIPDATA)
(INITVARS (XIPTRACEFLG)
(XIPTRACEFILE T)
(XIPTRACETIME))
(ALISTS (XIPONLYTYPES)
(XIPIGNORETYPES)
(XIPPRINTMACROS 1 2 3 4))
(PROP VARTYPE XIPPRINTMACROS)
(ADDVARS (\PACKET.PRINTERS (1536 . PRINTXIP)))
(DECLARE: DONTCOPY (RECORDS ERRORXIP)
(GLOBALVARS XIPTRACEFLG XIPTRACEFILE XIPIGNORETYPES XIPONLYTYPES
XIPTRACETIME XIPPRINTMACROS)))
[COMS (* Peeking)
(FNS \PEEKNS \MAYBEPEEKNS)
(GLOBALVARS \PEEKNSNUMBER)
(INITVARS (\PEEKNSNUMBER))
(COMS (FNS \PROMISCUOUS.ON \PROMISCUOUS.OFF)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS \ETHERHOSTLOC]
(COMS (* Simple packet exchange protocols)
(FNS \GETMISCNSOCKET CREATE.PACKET.EXCHANGE.XIP EXCHANGEXIPS RELEASE.XIP)
[DECLARE: DONTEVAL@LOAD DOCOPY (P (AND (CCODEP (QUOTE \ALLOCATE.ETHERPACKET))
(MOVD (QUOTE \ALLOCATE.ETHERPACKET)
(QUOTE ALLOCATE.XIP)))
(AND (CCODEP (QUOTE \RELEASE.ETHERPACKET))
(MOVD (QUOTE \RELEASE.ETHERPACKET)
(QUOTE RELEASE.XIP]
(RECORDS PACKETEXCHANGEXIP)
(CONSTANTS (\EXTYPE.REQUEST 1)
(\EXTYPE.RESPONSE 2)
(\EXTYPE.NEGATIVE 3))
(GLOBALVARS \MISC.NSOCKET \PACKET.EXCHANGE.CNTR)
(INITVARS (\MISC.NSOCKET)
(\PACKET.EXCHANGE.CNTR 0))
(FNS \LOOKUPPUPNUMBER))
(COMS (* Time service)
(FNS NSNETDAYTIME0 \NS.SETTIME NSNETDATE)
(DECLARE: DONTCOPY (RECORDS TIMEXIP)
(CONSTANTS \TIMESOCKET \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE
\TIMEVERSION \EXTYPE.TIME)))
(COMS (* Background activities)
(FNS NS.ECHOSERVER)
(DECLARE: DONTCOPY (CONSTANTS \XECHO.OP.REQUEST \XECHO.OP.REPLY)))
(COMS (* Debugging)
(FNS NS.ECHOUSER)
(INITVARS (\DEFAULTECHOSERVER NIL)
(\NS.ECHOUSERSOCKET NIL)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\NSINIT)))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LLETHER))))
(* Xerox Internet Packet stuff.)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(ACCESSFNS XIP [(XIPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM]
[BLOCKRECORD XIPBASE ((XIPCHECKSUM WORD)
(XIPLENGTH WORD)
(XIPTCONTROL BYTE)
(XIPTYPE BYTE)
(XIPDESTNET FIXP)
(XIPDESTWORD1 3 WORD)
(XIPDESTSOCKET WORD)
(XIPSOURCENET FIXP)
(XIPSOURCEWORD1 3 WORD)
(XIPSOURCESOCKET WORD)
(XIPFIRSTDATAWORD WORD) (* Start of data)
)
[ACCESSFNS XIPLENGTH ((XIPCHECKSUMBASE (LOCF DATUM]
[ACCESSFNS XIPFIRSTDATAWORD ((XIPCONTENTS (LOCF DATUM]
[ACCESSFNS XIPSOURCEWORD1 ((XIPSOURCEHOST (LOADNSHOSTNUMBER (LOCF DATUM))
(STORENSHOSTNUMBER
(LOCF DATUM)
NEWVALUE]
[ACCESSFNS XIPDESTWORD1 ((XIPDESTHOST (LOADNSHOSTNUMBER (LOCF DATUM))
(STORENSHOSTNUMBER (LOCF DATUM)
NEWVALUE]
[ACCESSFNS XIPSOURCENET ((XIPSOURCENSADDRESS (\LOADNSADDRESS
(LOCF DATUM))
(\STORENSADDRESS
(LOCF DATUM)
NEWVALUE]
(ACCESSFNS XIPDESTNET ((XIPDESTNSADDRESS (\LOADNSADDRESS (LOCF DATUM))
(\STORENSADDRESS (LOCF DATUM)
NEWVALUE]
(TYPE? (type? ETHERPACKET DATUM)))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \XIPOVLEN 30)
(RPAQQ \MAX.XIPDATALENGTH 546)
(CONSTANTS \XIPOVLEN \MAX.XIPDATALENGTH)
)
(RPAQQ RAWXIPTYPES ((\XIPT.ROUTINGINFO 1)
(\XIPT.ECHO 2)
(\XIPT.ERROR 3)
(\XIPT.EXCHANGE 4)
(\XIPT.SPP 5)
(\XIPT.PUPLOOKUP 6)))
(DECLARE: EVAL@COMPILE
(RPAQQ \XIPT.ROUTINGINFO 1)
(RPAQQ \XIPT.ECHO 2)
(RPAQQ \XIPT.ERROR 3)
(RPAQQ \XIPT.EXCHANGE 4)
(RPAQQ \XIPT.SPP 5)
(RPAQQ \XIPT.PUPLOOKUP 6)
(CONSTANTS (\XIPT.ROUTINGINFO 1)
(\XIPT.ECHO 2)
(\XIPT.ERROR 3)
(\XIPT.EXCHANGE 4)
(\XIPT.SPP 5)
(\XIPT.PUPLOOKUP 6))
)
(RPAQQ XIPERRORCODES ((\XIPE.CHECKSUM 1)
(\XIPE.NOSOCKET 2)
(\XIPE.SOCKETFULL 3)
(\XIPE.GATEWAY.CHECKSUM 513)
(\XIPE.NOROUTE 514)
(\XIPE.LOOPED 515)
(\XIPE.TOOLARGE 516)))
(DECLARE: EVAL@COMPILE
(RPAQQ \XIPE.CHECKSUM 1)
(RPAQQ \XIPE.NOSOCKET 2)
(RPAQQ \XIPE.SOCKETFULL 3)
(RPAQQ \XIPE.GATEWAY.CHECKSUM 513)
(RPAQQ \XIPE.NOROUTE 514)
(RPAQQ \XIPE.LOOPED 515)
(RPAQQ \XIPE.TOOLARGE 516)
(CONSTANTS (\XIPE.CHECKSUM 1)
(\XIPE.NOSOCKET 2)
(\XIPE.SOCKETFULL 3)
(\XIPE.GATEWAY.CHECKSUM 513)
(\XIPE.NOROUTE 514)
(\XIPE.LOOPED 515)
(\XIPE.TOOLARGE 516))
)
(* END EXPORTED DEFINITIONS)
)
(ADDTOVAR XIPTYPES (\XIPT.ROUTINGINFO 1)
(\XIPT.ECHO 2)
(\XIPT.ERROR 3)
(\XIPT.EXCHANGE 4)
(\XIPT.SPP 5)
(\XIPT.PUPLOOKUP 6))
(ADDTOVAR XIPERRORMESSAGES (1 "Bad checksum")
(2 "No socket at destination")
(3 "Destination congestion")
(513 "Gateway: Bad checksum")
(514 "Can't get there from here")
(515 "Too many hops")
(516 "Packet too large to forward"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS XIPTYPES XIPERRORMESSAGES)
)
(* Parsing and looking up NS addresses)
(DEFINEQ
(\COERCE.TO.NSADDRESS
[LAMBDA (HOST DEFAULTSOCKET) (* bvm: "25-Jun-84 15:20")
(COND
((LITATOM HOST)
(\PARSE.NSADDRESSCONSTANT (MKSTRING HOST)
DEFAULTSOCKET))
((type? NSADDRESS HOST)
(COND
((AND DEFAULTSOCKET (EQ 0 (fetch NSSOCKET of HOST)))
(PROG ((COPYADDR (create NSADDRESS
NSSOCKET ← DEFAULTSOCKET)))
(\BLT COPYADDR HOST (SUB1 \#WDS.NSADDRESS))
(RETURN COPYADDR)))
(T HOST)))
((type? NSHOSTNUMBER HOST)
(create NSADDRESS
NSHOSTNUMBER ← HOST
NSSOCKET ←(OR DEFAULTSOCKET 0)))
((STRINGP HOST)
(\PARSE.NSADDRESSCONSTANT HOST DEFAULTSOCKET])
(\PARSE.NSADDRESSCONSTANT
[LAMBDA (STR DEFAULTSOCKET) (* bvm: "25-Jun-84 15:16")
(* * 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 NSHOST ADDR 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 (COND
(NSHOST (CONS VAL NSHOST))
((NULL VAL)
0)
(T VAL)))
(SETQ VAL (SETQ NSHOST NIL)))
((EQ CH (CHARCODE %.))
(* Terminates part of a 3-part host number)
(push NSHOST VAL)
(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 (COND
((AND (OR HOST VAL)
(NLISTP NET)
(NULL NSHOST))
(SETQ ADDR (create NSADDRESS
NSNET ←(OR NET 0)
NSSOCKET ←(OR VAL DEFAULTSOCKET 0)))
(COND
[(LISTP HOST)
(with NSADDRESS ADDR (SETQ NSHNM0 (OR (CADDR HOST)
0))
(SETQ NSHNM1 (OR (CADR HOST)
0))
(SETQ NSHNM2 (OR (CAR HOST)
0]
(HOST (\PUTBASEFIXP (LOCF (fetch NSHNM1 of ADDR))
0 HOST)))
ADDR])
)
(* New SOCKET datatype stuff)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE NSOCKET ((NIL BYTE)
(NSOCLINK POINTER) (* So that we can Queue them)
(ID# WORD)
(NSOCHANDLE WORD)
(NSOC#OPENP FLAG)
(NSOC#CONNECTIONP FLAG)
(NIL BITS 6)
(INQUEUE POINTER)
(INQUEUELENGTH WORD)
(NSOC#ALLOCATION WORD)
(NSOCEVENT POINTER))
INQUEUE ←(create SYSQUEUE)
NSOC#ALLOCATION ← \MAX.EPKTS.ON.NSOCKET)
]
(/DECLAREDATATYPE (QUOTE NSOCKET)
(QUOTE (BYTE POINTER WORD WORD FLAG FLAG (BITS 6)
POINTER WORD WORD POINTER)))
(* END EXPORTED DEFINITIONS)
(* Well-known NS sockets)
(DECLARE: EVAL@COMPILE
(RPAQQ \NS.WKS.RoutingInformation 1)
(RPAQQ \NS.WKS.Echo 2)
(RPAQQ \NS.WKS.PUPLOOKUP 9)
(CONSTANTS (\NS.WKS.RoutingInformation 1)
(\NS.WKS.Echo 2)
(\NS.WKS.PUPLOOKUP 9))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NSOCKETS \MAX.EPKTS.ON.NSOCKET)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \NSOCKET.FROM# MACRO (OPENLAMBDA (SOCNUM)
(for SOC in \NSOCKETS when (EQ SOCNUM
(fetch ID# of SOC))
do (RETURN SOC))))
)
)
(/DECLAREDATATYPE (QUOTE NSOCKET)
(QUOTE (BYTE POINTER WORD WORD FLAG FLAG (BITS 6)
POINTER WORD WORD POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE NSOCKET ((NIL BYTE)
(NSOCLINK POINTER)
(ID# WORD)
(NSOCHANDLE WORD)
(NSOC#OPENP FLAG)
(NSOC#CONNECTIONP FLAG)
(NIL BITS 6)
(INQUEUE POINTER)
(INQUEUELENGTH WORD)
(NSOC#ALLOCATION WORD)
(NSOCEVENT POINTER)))
]
(DEFINEQ
(OPENNSOCKET
[LAMBDA (SKT# IFCLASH) (* bvm: " 7-SEP-83 21:45")
(* Creates a new local NSOCKET If SKT# is supplied, it is the identifying number (16-bit) of the socket, and an
error occurs if that socket is already in use.)
(PROG ((ID#EXPLICIT? (FIXP SKT#))
NSOC CLASHP)
[COND
((type? NSOCKET SKT#)
(SETQ NSOC (OR (\NSOCKET.FROM# (fetch ID# of SKT#))
(PROGN (push \NSOCKETS SKT#)
SKT#)))
(\FLUSHNSOCQUEUE NSOC))
(T [COND
((NOT ID#EXPLICIT?) (* Pick a socket that is reasonably random but won't
conflict with well-known sockets)
(SETQ SKT# (LOGOR 32768 (\LONUM (DAYTIME]
(UNINTERRUPTABLY
[do (COND
((NOT (SETQ CLASHP (\NSOCKET.FROM# SKT#)))
(push \NSOCKETS (SETQ NSOC (create NSOCKET
ID# ← SKT#)))
(replace NSOCEVENT of NSOC with (CREATE.EVENT NSOC))
(RETURN))
[(NOT ID#EXPLICIT?)
(SETQ SKT# (LOGOR 32768 (ADD1 (LOGAND SKT# 32767]
(T (RETURN])
(COND
(CLASHP (SELECTQ IFCLASH
((T ACCEPT)
(\FLUSHNSOCQUEUE (SETQ NSOC CLASHP)))
((DON'T FAIL)
(RETURN NIL))
(ERROR "Socket number is already in use" SKT#]
(RETURN NSOC])
(CLOSENSOCKET
[LAMBDA (NSOC NOERRORFLG) (* bvm: "26-MAY-83 14:11")
(* Closes a local NSOCKET -- argument = T means close
all sockets)
(COND
[(EQ NSOC T)
(while \NSOCKETS do (UNINTERRUPTABLY
(\FLUSHNSOCQUEUE (SETQ NSOC (pop \NSOCKETS)))
(replace NSOCEVENT of NSOC with NIL))]
(T (SETQ NSOC (\DTEST NSOC (QUOTE NSOCKET)))
(UNINTERRUPTABLY
(\FLUSHNSOCQUEUE NSOC)
(replace NSOCEVENT of NSOC with NIL) (* Break circular link)
(COND
((FMEMB NSOC \NSOCKETS)
(SETQ \NSOCKETS (DREMOVE NSOC \NSOCKETS))
T)
((NOT NOERRORFLG)
(ERROR NSOC "not an open NS socket"))))])
(NSOCKETEVENT
[LAMBDA (NSOC) (* bvm: "26-MAY-83 14:14")
(ffetch NSOCEVENT of (\DTEST NSOC (QUOTE NSOCKET])
(NSOCKETNUMBER
[LAMBDA (NSOC) (* bvm: "10-Jun-84 16:10")
(ffetch (NSOCKET ID#) of (\DTEST NSOC (QUOTE NSOCKET])
(NSOCKETFROMNUMBER
[LAMBDA (SOC#) (* bvm: " 7-AUG-83 01:40")
(\NSOCKET.FROM# SOC#])
(\FLUSHNSOCQUEUE
[LAMBDA (NSOC) (* bvm: "11-FEB-83 12:56")
(\FLUSH.PACKET.QUEUE (fetch (NSOCKET INQUEUE) of NSOC))
(replace (NSOCKET INQUEUELENGTH) of NSOC with 0)
NSOC])
)
(RPAQ? \NSOCKETS )
(RPAQ? \MAX.EPKTS.ON.NSOCKET 16)
(* assorted level 1 and 2)
(DEFINEQ
(\NSINIT
[LAMBDA (EVENT MINI) (* bvm: "28-OCT-83 13:58")
(* MINI means just enough to broadcast packets and
receive answers. Used by \LOOKUPPUPNUMBER)
(for SOC in \NSOCKETS do (\FLUSHNSOCQUEUE SOC))
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.XIP))
[PROG [(PROC (FIND.PROCESS (QUOTE \NSGATELISTENER]
(OR \LOCALNDBS (RETURN))
(COND
((NULL MINI)
[COND
(\3MBLOCALNDB (* If we want to talk XIPs on 3mb net, we need to be
able to handle translations)
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.10TO3)))
(T (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.10TO3]
(* Initiate router probe to find out what our net is)
(\LOCATE.NSNET 0)
(COND
(\GATEWAYFLG (AND PROC (DEL.PROCESS PROC)))
(PROC (RESTART.PROCESS PROC))
(T (ADD.PROCESS (QUOTE (\NSGATELISTENER))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
\NS.READY.EVENT)))
(SETQ \NSFLG T]
(SETQ \NS.READY T)
(NOTIFY.EVENT \NS.READY.EVENT])
(STOPNS
[LAMBDA NIL (* bvm: "17-FEB-83 15:57")
(\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.XIP))
(\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.10TO3))
(DEL.PROCESS (QUOTE \NSGATELISTENER))
(CLOSENSOCKET T)
(SETQ \NSFLG NIL])
)
(DEFINEQ
(\HANDLE.RAW.XIP
[LAMBDA (XIP TYPE) (* bvm: "10-Jun-84 16:49")
(* Handles the arrival of a raw XIP. If it is destined for a local socket that has room for it, we queue it up,
else release it)
(COND
((EQ TYPE \EPT.XIP)
[PROG (NSOC CSUM NDB DESTNET MYNET)
[COND
((NULL \NS.READY)
(RETURN (RELEASE.XIP XIP]
[COND
((AND (NOT (EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
\MY.NSHOSTNUMBER))
(NOT (EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
BROADCASTNSHOSTNUMBER)))
(* Not for us)
(RETURN (\FORWARD.XIP XIP]
(SETQ NDB (fetch EPNETWORK of XIP))
[COND
((AND [NOT (IEQP (SETQ DESTNET (fetch XIPDESTNET of XIP))
(SETQ MYNET (fetch NDBNSNET# of NDB]
(NEQ MYNET 0)
(NEQ DESTNET 0)) (* explicitly for a net other than us)
(RETURN (\FORWARD.XIP XIP]
(COND
[[NULL (SETQ NSOC (\NSOCKET.FROM# (fetch XIPDESTSOCKET of XIP]
(* Packets addressed to non-active sockets are just
ignored.)
(COND
(XIPTRACEFLG (PRIN1 (QUOTE &)
XIPTRACEFILE)))
(PROG (XIPBASE)
(COND
[(AND (EQ (fetch XIPTYPE of XIP)
\XIPT.ECHO)
(EQ (fetch XIPDESTSOCKET of XIP)
\NS.WKS.Echo)
(EQ (\GETBASE (SETQ XIPBASE (fetch XIPCONTENTS of XIP))
0)
\XECHO.OP.REQUEST)) (* Play echo server)
(COND
([AND (NEQ (SETQ CSUM (fetch XIPCHECKSUM of XIP))
MASKWORD1'S)
(NEQ CSUM (\CHECKSUM (fetch XIPCHECKSUMBASE of XIP)
(SUB1 (FOLDHI (fetch XIPLENGTH of XIP)
BYTESPERWORD]
(\XIPERROR XIP \XIPE.CHECKSUM))
(T (\PUTBASE XIPBASE 0 \XECHO.OP.REPLY)
(SWAPXIPADDRESSES XIP)
(replace EPREQUEUE of XIP with (QUOTE FREE))
(SENDXIP NIL XIP]
(T (\XIPERROR XIP \XIPE.NOSOCKET]
((IGEQ (fetch (NSOCKET INQUEUELENGTH) of NSOC)
(fetch (NSOCKET NSOC#ALLOCATION) of NSOC))
(* Note that packets are just "dropped" when the queue
overflows.)
(\XIPERROR XIP \XIPE.SOCKETFULL))
([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]
(\XIPERROR XIP \XIPE.CHECKSUM))
(T [COND
((EQ DESTNET 0) (* Fill in unspecified destination net
(possibly redundantly with zero))
(replace XIPDESTNET of XIP 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 NDBNSNET# of NDB with DESTNET)
(replace NSNET of \MY.NSADDRESS with (SETQ \MY.NSNETNUMBER DESTNET))
(PROG ((ENTRY (\LOCATE.NSNET DESTNET T)))
[OR ENTRY (push (CDR \NS.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 (NSOCKET INQUEUE) of NSOC)
XIP)
(add (fetch (NSOCKET INQUEUELENGTH) of NSOC)
1)
(NOTIFY.EVENT (fetch NSOCEVENT of NSOC)))]
T])
(\XIPERROR
[LAMBDA (XIP ERRCODE) (* bvm: "21-Jun-84 14:49")
(* * Turn packet around into an error packet with given error)
(COND
((AND (NOT (EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
BROADCASTNSHOSTNUMBER))
(NEQ (fetch XIPTYPE of XIP)
\XIPT.ERROR)) (* Don't respond to errors or to broadcasts!)
(PROG (LENGTH)
[\BLT (LOCF (fetch ERRORXIPBODY of XIP))
(fetch XIPBASE of XIP)
(SETQ LENGTH (IMIN (fetch XIPLENGTH of XIP)
(IPLUS \XIPOVLEN 12]
(* Copy header plus some data into data portion.
BLT is in the right direction for the overlap to work)
(replace ERRORXIPCODE of XIP with ERRCODE)
(replace ERRORXIPARG of XIP with 0)
(replace XIPLENGTH of XIP with (IPLUS LENGTH \XIPOVLEN (UNFOLD 2 BYTESPERWORD)))
(replace XIPTYPE of XIP with \XIPT.ERROR)
(SWAPXIPADDRESSES XIP)
(replace EPREQUEUE of XIP with (QUOTE FREE))
(SENDXIP NIL XIP)))
(T (\RELEASE.ETHERPACKET XIP])
(\FORWARD.XIP
[LAMBDA (XIP) (* bvm: "12-OCT-83 15:44")
(* Called when we receive a XIP not addressed to us.
Unless we are a gateway, dump it)
(COND
(\GATEWAYFLG (\GATEWAY.FORWARD.XIP XIP))
(\PEEKNSNUMBER (\MAYBEPEEKNS XIP))
(T (COND
(XIPTRACEFLG (PRINTXIP XIP (QUOTE GET)
NIL "XIP not addressed to this host: ")))
(\RELEASE.ETHERPACKET XIP])
)
(RPAQ? \NS.CHECKSUMFLG T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NS.CHECKSUMFLG)
)
(DEFINEQ
(GETXIP
[LAMBDA (NSOC WAIT) (* bvm: "26-MAY-83 15:48")
(PROG ([NSOCQ (ffetch (NSOCKET INQUEUE) of (\DTEST NSOC (QUOTE NSOCKET]
EPKT TIMER)
LP (UNINTERRUPTABLY
(AND (SETQ EPKT (\DEQUEUE NSOCQ))
(add (ffetch (NSOCKET INQUEUELENGTH) of NSOC)
-1)))
(COND
[(NULL EPKT)
(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 NSOCEVENT of NSOC)
TIMER T)
(GO LP]
[(EQ \EPT.XIP (fetch EPTYPE of EPKT))
(AND XIPTRACEFLG (\MAYBEPRINTPACKET EPKT (QUOTE GET]
(T (AND XIPTRACEFLG (printout XIPTRACEFILE T "Non-XIP packet " EPKT " arrived on " NSOC T)
)
(SETQ EPKT)))
(RETURN EPKT])
(DISCARDXIPS
[LAMBDA (NSOC) (* bvm: "11-FEB-83 12:56")
(UNINTERRUPTABLY
(\FLUSH.PACKET.QUEUE (fetch (NSOCKET INQUEUE) of NSOC))
(replace (NSOCKET INQUEUELENGTH) of NSOC with 0))])
(SENDXIP
[LAMBDA (SOCKET XIP) (* bvm: "26-OCT-83 16:31")
(* Returns the XIP arg iff packet can be sent;
returns a litatom explaining error otherwise)
(replace EPTYPE of XIP with \EPT.XIP)
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(replace XIPTCONTROL of XIP with 0)
(until \NS.READY do (AWAIT.EVENT \NS.READY.EVENT))
(PROG (NDB)
(\RCLK (LOCF (fetch EPTIMESTAMP of XIP)))
(RETURN (COND
((fetch EPTRANSMITTING of XIP)
(AND XIPTRACEFLG (printout XIPTRACEFILE
"[Put failed--packet already being transmitted]"))
(QUOTE AlreadyQueued))
((NULL (SETQ NDB (\ROUTE.XIP XIP)))
(AND XIPTRACEFLG (PRINTXIPROUTE XIP "[Put fails--no routing]" XIPTRACEFILE))
(\REQUEUE.ETHERPACKET XIP)
(QUOTE NoRouting))
(T (\SETXIPCHECKSUM XIP)
(AND XIPTRACEFLG (\MAYBEPRINTPACKET XIP (QUOTE PUT)))
(TRANSMIT.ETHERPACKET NDB XIP)
NIL])
(SWAPXIPADDRESSES
[LAMBDA (XIP) (* bvm: "28-Nov-83 17:59")
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG ((NDB (\DTEST (ffetch EPNETWORK of XIP)
(QUOTE NDB)))
(DESTSOCKET (ffetch XIPDESTSOCKET of XIP)))
(\BLT (LOCF (ffetch XIPDESTNET of XIP))
(LOCF (ffetch XIPSOURCENET of XIP))
\#WDS.NSADDRESS)
(freplace XIPSOURCESOCKET of XIP with DESTSOCKET)
(freplace XIPSOURCENET of XIP with (ffetch NDBNSNET# of NDB))
(freplace XIPSOURCEHOST of XIP with \MY.NSHOSTNUMBER])
(\SETXIPCHECKSUM
[LAMBDA (XIP) (* bvm: " 6-FEB-83 18:43")
(* Sets the XIPCHECKSUM field of XIP to checksum over
its current contents)
(replace XIPCHECKSUM of XIP with (COND
[\NS.CHECKSUMFLG (\CHECKSUM (fetch XIPCHECKSUMBASE
of XIP)
(SUB1 (FOLDHI (fetch XIPLENGTH
of XIP)
BYTESPERWORD]
(T \NULLCHECKSUM)))
T])
(\CLEARXIPHEADER
[LAMBDA (XIP) (* bvm: "16-FEB-83 15:07")
(* Clears the header of XIP)
(\ZEROWORDS [fetch XIPBASE of (SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET]
(LOCF (fetch XIPFIRSTDATAWORD of XIP])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \ROUTEBOX.HOST)
(QUOTE RESOURCES)
(QUOTE (NEW (create NSHOSTNUMBER]
)
)
(/SETTOPVAL (QUOTE \\ROUTEBOX.HOST.GLOBALRESOURCE))
(DEFINEQ
(\FILLINXIP
[LAMBDA (TYPE SOURCENSOCKET DESTHOST DESTSOCKET# DESTNET LENGTH EPKT)
(* bvm: "18-Apr-84 14:25")
(* Sets indicated fields of EPKT to non-NIL args.
DESTHOST may be either an NSADDRESS or a NSHOSTNUMBER)
(PROG NIL
(COND
((NULL EPKT)
(SETQ EPKT (\ALLOCATE.ETHERPACKET))
(replace EPTYPE of EPKT with \EPT.XIP)
(\CLEARXIPHEADER EPKT)
(OR LENGTH (SETQ LENGTH \XIPOVLEN)))
(T (SETQ EPKT (\DTEST EPKT (QUOTE ETHERPACKET)))
(replace EPTYPE of EPKT with \EPT.XIP)))
(replace XIPTCONTROL of EPKT with 0) (* Always zero when transmitted)
(replace XIPTYPE of EPKT with (OR TYPE 0))
(replace XIPSOURCENSADDRESS of EPKT with (\LOCALNSADDRESS))
(* Will put 0 in the socket field)
(AND SOURCENSOCKET (replace XIPSOURCESOCKET of EPKT with (fetch (NSOCKET ID#) of
SOURCENSOCKET)))
(replace XIPLENGTH of EPKT with (OR LENGTH \XIPOVLEN))
[COND
((type? NSADDRESS DESTHOST)
(replace XIPDESTNSADDRESS of EPKT with DESTHOST)
(AND DESTNET (ZEROP (fetch NSNET of DESTHOST))
(replace XIPDESTNET of EPKT with DESTNET))
(AND DESTSOCKET# (ZEROP (fetch NSSOCKET of DESTHOST))
(replace XIPDESTSOCKET of EPKT with DESTSOCKET#)))
(T [COND
((type? NSHOSTNUMBER DESTHOST) (* Just doesn't put anything in the NET or DESTSOCKET#
fields)
(replace XIPDESTHOST of EPKT with DESTHOST))
(T (replace XIPDESTNSADDRESS of EPKT with (OR (\PARSE.NSADDRESSCONSTANT DESTHOST)
(\ILLEGAL.ARG DESTHOST]
(AND DESTNET (replace XIPDESTNET of EPKT with DESTNET))
(AND DESTSOCKET# (replace XIPDESTSOCKET of EPKT with DESTSOCKET#]
(RETURN EPKT])
(XIPAPPEND.BYTE
[LAMBDA (XIP BYTE OFFSET) (* bvm: "16-FEB-83 15:09")
(* Make OFFSET'th byte of XIP'S data be BYTE.
OFFSET defaults to the end of the packet, in which case
the length is updated)
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG [(WHERE (OR OFFSET (IDIFFERENCE (fetch XIPLENGTH of XIP)
\XIPOVLEN]
(COND
((IGEQ WHERE \MAX.XIPDATALENGTH)
(RETURN)))
(COND
((NOT OFFSET)
(add (fetch XIPLENGTH of XIP)
1)))
(\PUTBASEBYTE (fetch XIPCONTENTS of XIP)
WHERE BYTE])
(XIPAPPEND.WORD
[LAMBDA (XIP WORD OFFSET) (* bvm: "16-FEB-83 15:11")
(* Make OFFSET'th word of XIP'S data be WORD.
OFFSET defaults to the end of the packet, in which case
the length is updated)
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG (LENGTH WHERE)
[SETQ WHERE (COND
(OFFSET (UNFOLD OFFSET BYTESPERWORD))
(T (IDIFFERENCE (SETQ LENGTH (CEIL (fetch XIPLENGTH of XIP)
BYTESPERWORD))
\XIPOVLEN]
(COND
((IGREATERP (IPLUS WHERE BYTESPERWORD)
\MAX.XIPDATALENGTH)
(ERROR XIP "Not enough room for another word")))
[COND
((NOT OFFSET)
(replace XIPLENGTH of XIP with (IPLUS LENGTH BYTESPERWORD]
(\PUTBASE (fetch XIPCONTENTS of XIP)
(FOLDLO WHERE BYTESPERWORD)
WORD])
(XIPAPPEND.CELL
[LAMBDA (XIP CELL OFFSET) (* bvm: "16-FEB-83 15:13")
(* Word-aligns the beginning, and puts down two words (a "cell", or LONG CARDINAL). OFFSET defaults to the end of
the packet, in which case the length is updated)
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG (LENGTH WHERE)
[SETQ WHERE (COND
(OFFSET (UNFOLD OFFSET BYTESPERWORD))
(T (IDIFFERENCE (SETQ LENGTH (CEIL (fetch XIPLENGTH of XIP)
BYTESPERWORD))
\XIPOVLEN]
(COND
((IGREATERP (IPLUS WHERE BYTESPERCELL)
\MAX.XIPDATALENGTH)
(ERROR XIP "Not enough room for another word")))
[COND
((NOT OFFSET)
(replace XIPLENGTH of XIP with (IPLUS LENGTH BYTESPERCELL]
(SETQ WHERE (\ADDBASE (fetch XIPCONTENTS of XIP)
(FOLDLO WHERE BYTESPERWORD)))
(\PUTBASE WHERE 0 (\HINUM CELL))
(\PUTBASE WHERE 1 (\LONUM CELL])
(XIPAPPEND.STRING
[LAMBDA (EPKT STRING OFFST IFSP) (* bvm: " 4-FEB-83 12:00")
(* Store STRING beginning at OFFST'th byte of XIP. OFFST defaults to end of packet, in which case the packet's
XIPLENGTH accordingly. IFSP means to store the string in IFS format -- the length word preceeds the string bytes.)
(OR (STRINGP STRING)
(LITATOM STRING)
(SETQ STRING (MKSTRING STRING)))
(PROG ((LEN (NCHARS STRING))
WHERE)
(SETQ WHERE (OR OFFST (IDIFFERENCE (fetch XIPLENGTH of EPKT)
\XIPOVLEN)))
[COND
(IFSP (SETQ WHERE (CEIL WHERE BYTESPERWORD))
(COND
((ILESSP \MAX.XIPDATALENGTH (IPLUS WHERE LEN BYTESPERWORD))
(RETURN)))
(\PUTBASE (fetch XIPCONTENTS of EPKT)
(FOLDLO WHERE BYTESPERWORD)
LEN)
(add WHERE BYTESPERWORD)
(add LEN BYTESPERWORD))
(T (COND
((ILESSP \MAX.XIPDATALENGTH (IPLUS WHERE LEN))
(RETURN]
(COND
((NULL OFFST)
(add (fetch XIPLENGTH of EPKT)
LEN)))
(RETURN (\PUTBASESTRING (fetch XIPCONTENTS of EPKT)
WHERE STRING])
(XIPAPPEND.IFSSTRING
[LAMBDA (XIP STRING OFFST) (* JonL "31-JUL-82 03:40")
(* Store STRING as an IFS string (length word followed by string) beginning at OFFST'th byte of XIP.
OFFST defaults to end of packet, in which case the packet's XIPLENGTH is updated accordingly)
(XIPAPPEND.STRING XIP STRING OFFST T])
(XIPAPPEND.INTEGER
[LAMBDA (XIP N #BITS ALIGNMENT) (* bvm: " 6-FEB-83 17:08")
(PROG ((#IBYTES (FOLDHI #BITS BITSPERBYTE))
LEN NEWLEN CURBASE)
(SETQ NEWLEN (SETQ LEN (fetch XIPLENGTH of XIP)))
(SELECTQ ALIGNMENT
((NIL BYTE 0 1))
((WORD 2)
(SETQ NEWLEN (CEIL NEWLEN BYTESPERWORD))
(SETQ #IBYTES (CEIL #IBYTES BYTESPERWORD)))
((CELL 4)
(SETQ NEWLEN (CEIL NEWLEN BYTESPERCELL))
(SETQ #IBYTES (CEIL #IBYTES BYTESPERCELL)))
(PROGN (add NEWLEN (IDIFFERENCE (SUB1 ALIGNMENT)
(IMOD (SUB1 NEWLEN)
ALIGNMENT)))
(* FOO -- CEIL macro only works for constant modulii!)
NIL))
(\PUTBASEINTEGER (fetch XIPCONTENTS of XIP)
(UNFOLD (IPLUS NEWLEN #IBYTES)
BITSPERBYTE)
(UNFOLD #IBYTES BITSPERBYTE)
N)
(add NEWLEN #IBYTES)
(replace XIPLENGTH of XIP with NEWLEN)
(RETURN (IDIFFERENCE NEWLEN LEN])
)
(* XIP routing)
(DEFINEQ
(\NSGATELISTENER
[LAMBDA NIL (* bvm: "10-JUN-83 11:24")
(PROG ((NSOC (OPENNSOCKET \NS.WKS.RoutingInformation T))
(TIMER (SETUPTIMER 0))
EVENT XIP BASE)
(SETQ EVENT (fetch NSOCEVENT of NSOC))
LP (COND
((SETQ XIP (GETXIP NSOC))
(\HANDLE.NS.ROUTING.INFO XIP)
(BLOCK))
((EQ (AWAIT.EVENT EVENT (COND
((IGREATERP \NSROUTER.PROBECOUNT 0)
\NSROUTER.PROBETIMER)
(T TIMER))
T)
EVENT)
(GO LP)))
(COND
((TIMEREXPIRED? TIMER)
(\AGE.ROUTING.TABLE \NS.ROUTING.TABLE)
(SETUPTIMER \RT.AGEINTERVAL TIMER)))
[COND
((AND (IGREATERP \NSROUTER.PROBECOUNT 0)
(TIMEREXPIRED? \NSROUTER.PROBETIMER)) (* Routing info desired. Broadcast a routing request on
each directly-connected net)
[SETQ XIP (\FILLINXIP \XIPT.ROUTINGINFO NSOC BROADCASTNSHOSTNUMBER
\NS.WKS.RoutingInformation 0 (IPLUS \XIPOVLEN BYTESPERWORD
(UNFOLD \NS.ROUTINGINFO.WORDS
BYTESPERWORD]
(replace XIPFIRSTDATAWORD of XIP with \XROUTINGINFO.OP.REQUEST)
(SETQ BASE (\ADDBASE (fetch XIPCONTENTS of XIP)
1))
(replace (NSROUTINGINFO NET#) of BASE with -1)
(replace (NSROUTINGINFO #HOPS) of BASE with \RT.INFINITY)
(SENDXIP NSOC XIP)
(SETUPTIMER \NSROUTER.PROBEINTERVAL \NSROUTER.PROBETIMER)
(SETQ \NSROUTER.PROBECOUNT (SUB1 \NSROUTER.PROBECOUNT]
(GO LP])
(\HANDLE.NS.ROUTING.INFO
[LAMBDA (XIP) (* bvm: "18-Apr-84 14:36")
(* Processes a routing info XIP)
[COND
((EQ (fetch XIPFIRSTDATAWORD of XIP)
\XROUTINGINFO.OP.RESPONSE) (* Unless we're a gateway, we only handle responses)
(PROG ((HOST (fetch XIPSOURCEHOST of XIP))
(NDB (fetch EPNETWORK of XIP))
(LENGTH (SUB1 (FOLDLO (IDIFFERENCE (fetch XIPLENGTH of XIP)
\XIPOVLEN)
BYTESPERWORD)))
(BASE (\ADDBASE (fetch XIPCONTENTS of XIP)
1))
ENTRY NET HOPS)
[COND
((NEQ (fetch NETTYPE of NDB)
10)
(OR (SETQ HOST (\TRANSLATE.10TO3 HOST NDB))
(RETURN]
(SETQ \NSROUTER.PROBECOUNT 0)
(while (IGEQ LENGTH \NS.ROUTINGINFO.WORDS)
do (SETQ NET (fetch (NSROUTINGINFO NET#) of BASE))
(SETQ HOPS (fetch (NSROUTINGINFO #HOPS) of BASE))
[COND
((OR [SETQ ENTRY (find ENTRY in (CDR \NS.ROUTING.TABLE)
suchthat (IEQP NET (fetch RTNET# of ENTRY]
(COND
((ILEQ HOPS \NS.ROUTING.TABLE.RADIUS)
[push (CDR \NS.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 \NS.ROUTINGINFO.WORDS))
(SETQ BASE (\ADDBASE BASE \NS.ROUTINGINFO.WORDS]
(\RELEASE.ETHERPACKET XIP])
(\ROUTE.XIP
(LAMBDA (XIP READONLY) (* JonL " 7-May-84 01:24")
(* Encapsulates XIP, choosing the right network and immediate destination host. Returns an NDB for the
transmission. Unless READONLY is true, defaults source and destination nets if needed)
(GLOBALRESOURCE \ROUTEBOX.HOST (PROG ((NET (fetch XIPDESTNET of XIP))
PDH ROUTE NDB)
(COND
((EQ 0 NET)
(OR (SETQ NDB (OR \10MBLOCALNDB \3MBLOCALNDB))
(RETURN)))
((SETQ ROUTE (\LOCATE.NSNET 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)
10)
(LOADNSHOSTNUMBER (LOCF (fetch XIPDESTWORD1
of XIP))
\ROUTEBOX.HOST)
\ROUTEBOX.HOST)
((EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
BROADCASTNSHOSTNUMBER)
(* On 3, broadcast goes to zero)
0)
((PROGN (LOADNSHOSTNUMBER (LOCF (fetch XIPDESTWORD1
of XIP))
\ROUTEBOX.HOST)
(\TRANSLATE.10TO3 \ROUTEBOX.HOST NDB)))
(T (RETURN))))
(replace EPNETWORK of XIP with NDB)
(ENCAPSULATE.ETHERPACKET NDB XIP PDH (fetch XIPLENGTH
of XIP)
\EPT.XIP)
(COND
((NOT READONLY)
(COND
((EQ 0 NET)
(replace XIPDESTNET of XIP
with (fetch NDBNSNET# of NDB))))
(replace XIPSOURCENET of XIP
with (fetch NDBNSNET# of NDB))))
(RETURN NDB)))))
(\LOCATE.NSNET
(LAMBDA (NET DONTPROBE) (* JonL " 7-May-84 01:26")
(for (PREVTAIL ← \NS.ROUTING.TABLE) bind TAIL DATA while (LISTP (SETQ TAIL (CDR PREVTAIL)))
do (SETQ DATA (CAR TAIL))
(COND
((OR (IEQP NET (fetch (ROUTING RTNET#) of DATA))
(AND (EQ 0 NET)
(EQ 0 (fetch (ROUTING RTHOPCOUNT) of DATA))))
(COND
((NEQ PREVTAIL \NS.ROUTING.TABLE) (* Promote this entry to the front, so we find it faster
in the future)
(FRPLACD \NS.ROUTING.TABLE (PROG1 TAIL (FRPLACD PREVTAIL (CDR TAIL))
(FRPLACD TAIL (CDR \NS.ROUTING.TABLE))))))
(RETURN (AND (ILESSP (fetch RTHOPCOUNT of DATA)
\RT.INFINITY)
DATA))))
(SETQ PREVTAIL TAIL)
finally (COND
((NOT DONTPROBE)
(push (CDR \NS.ROUTING.TABLE)
(create ROUTING
RTNET# ← NET
RTHOPCOUNT ← \RT.INFINITY
RTTIMER ←(SETUPTIMER 30000)))
(* Insert an entry for the net, to be purged in 30 sec
if router process hasn't filled it by then)
(SETQ \NSROUTER.PROBECOUNT 5)
(SETQ \NSROUTER.PROBETIMER (SETUPTIMER 0 \NSROUTER.PROBETIMER))
(WAKE.PROCESS (QUOTE \NSGATELISTENER))
(BLOCK))))))
(NSNET.DISTANCE
[LAMBDA (NET#) (* bvm: "29-Jul-84 22:52")
[COND
((type? NSADDRESS NET#)
(SETQ NET# (fetch NSNET of NET#]
(PROG ((ROUTE (\LOCATE.NSNET NET#)))
[COND
((NULL ROUTE)
(to 4 do (BLOCK \ETHERTIMEOUT) repeatuntil (SETQ ROUTE (\LOCATE.NSNET NET#]
(RETURN (COND
(ROUTE (fetch RTHOPCOUNT of ROUTE])
(BESTNSADDRESS
[LAMBDA (ADDRESSES ERRORSTREAM HOSTNAME) (* bvm: "29-Jul-84 23:03")
(* Returns an NSADDRESS from the list ADDRESSES that is closest, returning NIL if there is no route.
If ERRORSTREAM = ERROR, causes error on failure; otherwise ERRORSTREAM is a stream to print an appropriate error
message to before returning NIL. HOSTNAME is optional interesting name of the host being sought)
(PROG (MSG)
RETRY
(COND
(ADDRESSES)
((SETQ ADDRESSES (LOOKUP.NS.SERVER HOSTNAME NIL T))
(SETQ HOSTNAME (CAR ADDRESSES))
(SETQ ADDRESSES (CDR ADDRESSES)))
(ERRORSTREAM (SETQ MSG "Host not found")
(GO ERROR))
(T (RETURN)))
[RETURN (for TRY from 1 to 5 bind NOTLOOKEDUP HOPS BESTHOPS BESTADDR ROUTE
do (SETQ BESTHOPS \RT.INFINITY)
(SETQ NOTLOOKEDUP (SETQ BESTADDR NIL))
[for ADDR in ADDRESSES
do (COND
((OR [NOT (SETQ ROUTE (\LOCATE.NSNET (fetch NSNET of ADDR]
(IGEQ (SETQ HOPS (fetch RTHOPCOUNT of ROUTE))
\RT.INFINITY))
(SETQ NOTLOOKEDUP T))
((ILESSP HOPS BESTHOPS)
(SETQ BESTHOPS HOPS)
(SETQ BESTADDR ADDR] (* Enter request for routing for all hosts)
(COND
((AND BESTADDR (OR (NOT NOTLOOKEDUP)
(ILEQ BESTHOPS \NS.ROUTING.TABLE.RADIUS)
(IGREATERP TRY 1)))
(RETURN BESTADDR)))
(BLOCK \ETHERTIMEOUT)
finally (COND
(ERRORSTREAM (SETQ MSG "No route to host")
(GO ERROR]
ERROR
[OR HOSTNAME (AND ADDRESSES (SETQ HOSTNAME (fetch NSNET of (CAR ADDRESSES]
(COND
((EQ ERRORSTREAM (QUOTE ERROR))
(ERROR MSG HOSTNAME)
(GO RETRY))
(T (printout ERRORSTREAM T MSG ": " HOSTNAME)
(RETURN])
(SORT.NSADDRESSES.BY.DISTANCE
[LAMBDA (HOSTLIST) (* bvm: "22-Jun-84 18:35")
(COND
((NULL (CDR (LISTP HOSTLIST)))
HOSTLIST)
(T (* HOSTLIST is a list each of whose elements has a
NSADDRESS in its CAR and anything in its CDR.)
[for PAIR in HOSTLIST do (\LOCATE.NSNET (fetch (NSADDRESS NSNET) of (CAR PAIR]
(* Enter request for routing for all hosts)
(BLOCK)
(COND
((NOT (for PAIR in HOSTLIST always (\LOCATE.NSNET (fetch (NSADDRESS NSNET)
of (CAR PAIR))
T)))
(BLOCK \ETHERTIMEOUT)))
(SORT HOSTLIST (FUNCTION \NSNET.CLOSERP])
(\NSNET.CLOSERP
[LAMBDA (X Y) (* bvm: "22-Jun-84 18:17")
(PROG ((ROUTEX (\LOCATE.NSNET (fetch (NSADDRESS NSNET) of (CAR X))
T))
ROUTEY)
(RETURN (COND
((NULL ROUTEX)
NIL)
((SETQ ROUTEY (\LOCATE.NSNET (fetch (NSADDRESS NSNET) of (CAR Y))
T))
(ILESSP (fetch RTHOPCOUNT of ROUTEX)
(fetch RTHOPCOUNT of ROUTEY)))
(T T])
)
(RPAQ? \NS.ROUTING.TABLE NIL)
(RPAQ? \NS.ROUTING.TABLE.RADIUS 5)
(RPAQ? \NSROUTER.PROBECOUNT 0)
(RPAQ? \NSROUTER.PROBETIMER )
(RPAQ? \NSROUTER.PROBEINTERVAL 3000)
(RPAQ? \NS.READY )
(RPAQ? \NS.READY.EVENT (CREATE.EVENT "NS Ready"))
(ADDTOVAR \SYSTEMCACHEVARS \NS.READY)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD NSROUTINGINFO ( (* Format of each entry in a routing info packet)
(NET# FIXP)
(#HOPS WORD)))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \NS.ROUTINGINFO.WORDS 3)
(RPAQQ \XROUTINGINFO.OP.REQUEST 1)
(RPAQQ \XROUTINGINFO.OP.RESPONSE 2)
(CONSTANTS \NS.ROUTINGINFO.WORDS \XROUTINGINFO.OP.REQUEST \XROUTINGINFO.OP.RESPONSE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NS.ROUTING.TABLE \NS.ROUTING.TABLE.RADIUS \NSROUTER.PROBECOUNT
\NSROUTER.PROBETIMER \NSROUTER.PROBEINTERVAL \NS.READY \NS.READY.EVENT)
)
)
(* Analogous to PUP stuff for tracing activity.)
(DEFINEQ
(XIPTRACE
[LAMBDA (FLG REGION) (* bvm: "11-JUL-83 17:19")
(COND
((NULL FLG)
(COND
((ACTIVEWP XIPTRACEFILE)
(CLOSEW XIPTRACEFILE)))
(SETQ XIPTRACEFILE T)
(SETQ XIPTRACEFLG NIL))
(T (OR (ACTIVEWP XIPTRACEFILE)
(SETQ XIPTRACEFILE (CREATEW REGION "Xerox Internet Packet Traffic")))
[WINDOWPROP XIPTRACEFILE (QUOTE BUTTONEVENTFN)
(FUNCTION (LAMBDA (WINDOW)
(COND
((LASTMOUSESTATE (NOT UP))
(\CHANGE.ETHER.TRACING WINDOW (QUOTE XIPTRACEFLG]
[WINDOWPROP XIPTRACEFILE (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(COND
((EQ WINDOW XIPTRACEFILE)
(SETQ XIPTRACEFLG)
(SETQ XIPTRACEFILE T]
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
XIPTRACEFILE)
(SETQ XIPTRACEFLG FLG)
(DSPSCROLL T XIPTRACEFILE)
(TOTOPW XIPTRACEFILE)
XIPTRACEFILE])
)
(DEFINEQ
(PRINTXIP
[LAMBDA (XIP CALLER FILE PRE.NOTE DOFILTER) (* bvm: "13-FEB-83 16:10")
(OR FILE (SETQ FILE XIPTRACEFILE))
(PROG ((TYPE (fetch XIPTYPE of XIP))
MACRO LENGTH)
[COND
(DOFILTER (COND
((COND
(XIPONLYTYPES (NOT (FMEMB TYPE XIPONLYTYPES)))
(XIPIGNORETYPES (FMEMB TYPE XIPIGNORETYPES)))
(RETURN (PRIN1 (SELECTQ CALLER
((PUT RAWPUT)
(QUOTE !))
((GET RAWGET)
(QUOTE +))
(QUOTE ?))
FILE]
(AND PRE.NOTE (printout FILE T PRE.NOTE))
(PRINTXIPROUTE XIP CALLER FILE)
[COND
((SETQ MACRO (CDR (FASSOC TYPE XIPPRINTMACROS)))
(* Macro is a function to which to dispatch for the
printing.)
(AND (NLISTP MACRO)
(RETURN (RESETFORM (OUTPUT FILE)
(APPLY* MACRO XIP FILE]
(printout FILE "Length = " .P2 (SETQ LENGTH (fetch XIPLENGTH of XIP))
" bytes" " (header + " .P2 (IDIFFERENCE LENGTH \XIPOVLEN)
")" T "Type = ")
(PRINTCONSTANT TYPE XIPTYPES FILE)
(TERPRI FILE)
(COND
((IGREATERP LENGTH \XIPOVLEN) (* MACRO tells how to print data.)
(PRIN1 "Contents: " FILE)
(PRINTXIPDATA XIP (OR MACRO (QUOTE (BYTES 14Q ...)))
NIL FILE)))
(TERPRI FILE)
(RETURN XIP])
(PRINTERRORXIP
[LAMBDA (XIP FILE) (* bvm: "16-FEB-83 16:04")
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG ((ERRCODE (fetch ERRORXIPCODE of XIP))
(ERRARG (fetch ERRORXIPARG of XIP)))
[printout FILE "[Error] " (OR (CADR (ASSOC ERRCODE XIPERRORMESSAGES))
(CONCAT (QUOTE #)
(OCTALSTRING ERRCODE]
(COND
((NOT (ZEROP ERRARG))
(printout FILE ", Parameter " .P2 ERRARG)))
(TERPRI FILE])
(PRINTXIPROUTE
[LAMBDA (PACKET CALLER FILE) (* bvm: "26-OCT-83 15:51")
(OR (ZEROP (POSITION FILE))
(TERPRI FILE))
(AND CALLER (printout FILE CALLER ": "))
(PROG ((CONTROL (fetch XIPTCONTROL of PACKET))
CSECS)
(printout FILE "From " (\PRINTNSADDRESS (LOCF (fetch (XIP XIPSOURCENET) of PACKET))
FILE)
" to "
(\PRINTNSADDRESS (LOCF (fetch (XIP XIPDESTNET) of PACKET))
FILE))
(COND
((NEQ CONTROL 0)
(printout FILE ", Hops = " .P2 CONTROL)))
(COND
(XIPTRACETIME (printout FILE " [" .I4 (IQUOTIENT (SETQ CSECS (\CENTICLOCK PACKET))
100)
(QUOTE %.)
.I2..T
(IREMAINDER CSECS 100)
"]")))
(TERPRI FILE])
(PRINTXIPDATA
[LAMBDA (XIP MACRO OFFSET FILE) (* JonL " 1-AUG-82 19:52")
(* * Prints DATA part of XIP starting at OFFSET (Default zero) according to MACRO. MACRO contains elements
describing what format the data is in -
WORDS, BYTES, CHARS: print as words, bytes (numeric) or ascii characters -
<number>: subsequent commands apply starting at this byte offset -
...: print "..." and quit if you still have data at this point)
(PROG ((DATA (fetch XIPCONTENTS of XIP))
(LENGTH (IDIFFERENCE (fetch XIPLENGTH of XIP)
\XIPOVLEN)))
(PRINTPACKETDATA DATA OFFSET MACRO LENGTH FILE])
)
(RPAQ? XIPTRACEFLG )
(RPAQ? XIPTRACEFILE T)
(RPAQ? XIPTRACETIME )
(ADDTOVAR XIPONLYTYPES )
(ADDTOVAR XIPIGNORETYPES )
(ADDTOVAR XIPPRINTMACROS (1 "Operation = " WORDS 2 "Info: " ...)
(2 "Operation: " WORDS 2 "Data: " CHARS 100 ...)
(3 . PRINTERRORXIP)
(4 "ID = " INTEGER 4 "Type = " WORDS 6 BYTES 8))
(PUTPROPS XIPPRINTMACROS VARTYPE ALIST)
(ADDTOVAR \PACKET.PRINTERS (1536 . PRINTXIP))
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS ERRORXIP ((ERRORXIPBASE (fetch XIPCONTENTS of DATUM)))
(BLOCKRECORD ERRORXIPBASE ((ERRORXIPCODE WORD)
(ERRORXIPARG WORD)
(ERRORXIPBODY WORD) (* As many words of offending XIP as sender felt like
including...)
)))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS XIPTRACEFLG XIPTRACEFILE XIPIGNORETYPES XIPONLYTYPES XIPTRACETIME XIPPRINTMACROS)
)
)
(* Peeking)
(DEFINEQ
(\PEEKNS
[LAMBDA (HOST FILE) (* bvm: "10-Jun-84 15:00")
(PROG NIL
[COND
((NULL HOST)
(\PROMISCUOUS.OFF)
(RPTQ 20 (BLOCK)) (* empty the pipe)
(SETQ \PEEKNSNUMBER))
(T (COND
((EQ HOST T)
(SETQ \PEEKNSNUMBER T))
((SETQ HOST (\COERCE.TO.NSADDRESS HOST))
(SETQ \PEEKNSNUMBER (fetch NSHOSTNUMBER of HOST)))
(T (RETURN))) (* Now make us promiscuous)
(\PROMISCUOUS.ON)
[COND
(FILE (SETQ XIPTRACEFILE (OR (OPENP FILE (QUOTE OUTPUT))
(OPENFILE FILE (QUOTE OUTPUT]
(OR XIPTRACEFLG (SETQ XIPTRACEFLG T]
(RETURN \PEEKNSNUMBER])
(\MAYBEPEEKNS
[LAMBDA (XIP) (* bvm: "12-OCT-83 16:25")
[COND
((AND \PEEKNSNUMBER XIPTRACEFLG)
(PROG (DIRECTION)
(COND
([OR (EQ \PEEKNSNUMBER T)
(AND (EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
BROADCASTNSHOSTNUMBER)
(NEQ \PEEKNSNUMBER 0))
[COND
((EQNSHOSTNUMBER (fetch XIPSOURCEHOST of XIP)
\PEEKNSNUMBER)
(SETQ DIRECTION (QUOTE PUT]
(COND
((EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
\PEEKNSNUMBER)
(SETQ DIRECTION (QUOTE GET]
(PRINTXIP XIP DIRECTION XIPTRACEFILE NIL T]
(\RELEASE.ETHERPACKET XIP])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \PEEKNSNUMBER)
)
(RPAQ? \PEEKNSNUMBER )
(DEFINEQ
(\PROMISCUOUS.ON
[LAMBDA NIL (* bvm: "12-OCT-83 15:58")
(SELECTQ (fetch NETTYPE of \LOCALNDBS)
(3 (\PUTBASE (EMADDRESS \ETHERHOSTLOC)
0 0))
(10 (\10MB.STARTDRIVER \LOCALNDBS T BROADCASTNSHOSTNUMBER))
NIL])
(\PROMISCUOUS.OFF
[LAMBDA NIL (* bvm: "12-OCT-83 15:58")
(SELECTQ (fetch NETTYPE of \LOCALNDBS)
(3 (\PUTBASE (EMADDRESS \ETHERHOSTLOC)
0
(fetch NDBPUPHOST# of \LOCALNDBS)))
(10 (\10MB.STARTDRIVER \LOCALNDBS T T))
NIL])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \ETHERHOSTLOC 392)
(CONSTANTS \ETHERHOSTLOC)
)
)
(* Simple packet exchange protocols)
(DEFINEQ
(\GETMISCNSOCKET
[LAMBDA NIL (* bvm: "24-FEB-83 17:51")
(* Opens a socket for miscellaneous services, if we
don't have it open yet)
(COND
((AND \MISC.NSOCKET (FMEMB \MISC.NSOCKET \NSOCKETS))
\MISC.NSOCKET)
(T (SETQ \MISC.NSOCKET (OPENNSOCKET])
(CREATE.PACKET.EXCHANGE.XIP
[LAMBDA (NSOCKET DESTHOST DESTSOCKET TYPE) (* bvm: "15-Jun-84 12:54")
(PROG [(XIP (\FILLINXIP \XIPT.EXCHANGE NSOCKET DESTHOST DESTSOCKET 0 (IPLUS \XIPOVLEN
(UNFOLD 3
BYTESPERWORD]
(replace (PACKETEXCHANGEXIP PACKETEXCHANGETYPE) of XIP with TYPE)
(replace (PACKETEXCHANGEXIP PACKETEXCHANGEID0) of XIP with 0)
[replace (PACKETEXCHANGEXIP PACKETEXCHANGEID1) of XIP with (SETQ \PACKET.EXCHANGE.CNTR
(\LOLOC (\ADDBASE
\PACKET.EXCHANGE.CNTR 1]
(RETURN XIP])
(EXCHANGEXIPS
[LAMBDA (SOC OUTXIP IDFILTER TIMEOUT) (* bvm: "12-Jun-84 15:15")
(* Sends out OUTXIP on SOC and waits for a reply, which it puts in INXIP. 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.)
(OR TIMEOUT (SETQ TIMEOUT \ETHERTIMEOUT))
(DISCARDXIPS SOC) (* Flush any pups waiting on this socket)
(SENDXIP SOC OUTXIP)
(bind INXIP (TIMER ←(SETUPTIMER TIMEOUT)) until (TIMEREXPIRED? TIMER)
do (\BACKGROUND)
(COND
([AND (SETQ INXIP (GETXIP SOC))
(OR (NOT IDFILTER)
(IEQP (fetch PACKETEXCHANGEID of INXIP)
(fetch PACKETEXCHANGEID of OUTXIP]
(RETURN INXIP])
(RELEASE.XIP
[LAMBDA (XIP) (* bvm: "24-FEB-83 18:08")
(\RELEASE.ETHERPACKET XIP])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(AND (CCODEP (QUOTE \ALLOCATE.ETHERPACKET))
(MOVD (QUOTE \ALLOCATE.ETHERPACKET)
(QUOTE ALLOCATE.XIP)))
(AND (CCODEP (QUOTE \RELEASE.ETHERPACKET))
(MOVD (QUOTE \RELEASE.ETHERPACKET)
(QUOTE RELEASE.XIP)))
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS PACKETEXCHANGEXIP ((PEXBASE (fetch (XIP XIPCONTENTS) of DATUM)))
(BLOCKRECORD PEXBASE ((PACKETEXCHANGEID FIXP)
(* Arbitrary id in packet exchange XIP)
(PACKETEXCHANGETYPE WORD)
(* Protocol-specific type)
(PACKETEXCHANGEBODY0 WORD)
(* Body starts here)
))
(BLOCKRECORD PEXBASE ((PACKETEXCHANGEID0 WORD)
(PACKETEXCHANGEID1 WORD)))
[ACCESSFNS PACKETEXCHANGEXIP ((PACKETEXCHANGEBODY (LOCF (fetch
PACKETEXCHANGEBODY0
of DATUM])
]
(DECLARE: EVAL@COMPILE
(RPAQQ \EXTYPE.REQUEST 1)
(RPAQQ \EXTYPE.RESPONSE 2)
(RPAQQ \EXTYPE.NEGATIVE 3)
(CONSTANTS (\EXTYPE.REQUEST 1)
(\EXTYPE.RESPONSE 2)
(\EXTYPE.NEGATIVE 3))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \MISC.NSOCKET \PACKET.EXCHANGE.CNTR)
)
(RPAQ? \MISC.NSOCKET )
(RPAQ? \PACKET.EXCHANGE.CNTR 0)
(DEFINEQ
(\LOOKUPPUPNUMBER
[LAMBDA (NSNUMBER) (* bvm: "23-Aug-84 15:01")
(* * Looks up the pup host number for NSNUMBER. These numbers are in gateway's database)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT)
(SETQ OXIP (CREATE.PACKET.EXCHANGE.XIP SOC BROADCASTNSHOSTNUMBER \NS.WKS.PUPLOOKUP
\EXTYPE.REQUEST))
(replace XIPTYPE of OXIP with \XIPT.PUPLOOKUP)
(add (fetch XIPLENGTH of OXIP)
(UNFOLD \#WDS.NSHOSTNUMBER BYTESPERWORD))
(\STORENSHOSTNUMBER (fetch PACKETEXCHANGEBODY of OXIP)
NSNUMBER)
(DISCARDXIPS SOC)
(to \MAXETHERTRIES bind INXIP TIMER
do (SENDXIP SOC OXIP)
(SETQ TIMER (SETUPTIMER \ETHERTIMEOUT TIMER))
repeatuntil (do (BLOCK)
(COND
[(NULL (SETQ INXIP (GETXIP SOC]
((IEQP (fetch PACKETEXCHANGEID of INXIP)
(fetch PACKETEXCHANGEID of OXIP))
(SELECTC (fetch PACKETEXCHANGETYPE of INXIP)
[\EXTYPE.RESPONSE (RETURN (PROG1 (SETQ RESULT
(fetch
PACKETEXCHANGEBODY0
of INXIP))
(RELEASE.XIP INXIP]
(\EXTYPE.NEGATIVE
(COND
(XIPTRACEFLG (printout
XIPTRACEFILE
[\GETBASESTRING
(fetch PACKETEXCHANGEBODY
of INXIP)
0
(IDIFFERENCE (fetch XIPLENGTH
of INXIP)
(IPLUS \XIPOVLEN
(UNFOLD 3
BYTESPERWORD]
T)))
(* For now, ignore negative responses.
some gateways are confused)
)
NIL)
(RELEASE.XIP INXIP))
(T (RELEASE.XIP INXIP)))
repeatuntil (TIMEREXPIRED? TIMER)))
(COND
((AND XIPTRACEFLG (NULL RESULT))
(printout XIPTRACEFILE "NS to Pup number lookup timed out" T)))
(RELEASE.XIP OXIP)
(RETURN RESULT])
)
(* Time service)
(DEFINEQ
(NSNETDAYTIME0
[LAMBDA NIL (* bvm: "15-Jun-84 12:41")
(* * Returns a 32-bit unsigned alto time from the network, if possible)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT IXIP)
(SETQ OXIP (CREATE.PACKET.EXCHANGE.XIP SOC BROADCASTNSHOSTNUMBER \TIMESOCKET \EXTYPE.TIME))
(replace TIMEOP of OXIP with \TIMEOP.TIMEREQUEST)
(replace TIMEVERSION of OXIP with \TIMEVERSION)
(add (fetch XIPLENGTH of OXIP)
(UNFOLD 2 BYTESPERWORD))
(RETURN (to \MAXETHERTRIES when (SETQ IXIP (EXCHANGEXIPS SOC OXIP T))
do (SELECTC (fetch TIMEOP of IXIP)
(\TIMEOP.TIMERESPONSE (RETURN (fetch TIMEVALUE of IXIP)))
NIL])
(\NS.SETTIME
[LAMBDA (RETFLG) (* bvm: "26-Jul-84 15:16")
(* * Sets the time from an NS time server if possible. Returns T on success)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT IXIP TIME)
(SETQ OXIP (CREATE.PACKET.EXCHANGE.XIP SOC BROADCASTNSHOSTNUMBER \TIMESOCKET \EXTYPE.TIME))
(replace TIMEOP of OXIP with \TIMEOP.TIMEREQUEST)
(replace TIMEVERSION of OXIP with \TIMEVERSION)
(add (fetch XIPLENGTH of OXIP)
(UNFOLD 2 BYTESPERWORD))
(RETURN (to \MAXETHERTRIES when (SETQ IXIP (EXCHANGEXIPS SOC OXIP T))
do (SELECTC (fetch (TIMEXIP TIMEOP) of IXIP)
(\TIMEOP.TIMERESPONSE (SETQ TIME (create FIXP
HINUM ←(fetch TIMEVALUEHI
of IXIP)
LONUM ←(fetch TIMEVALUELO
of IXIP)))
(COND
(RETFLG (RETURN TIME)))
(SETQ \TimeZoneComp
(ITIMES (COND
((ZEROP (fetch TIMEZONESIGN
of IXIP))
1)
(T -1))
(fetch TIMEZONEHOURS of IXIP)))
(SETQ \BeginDST (fetch TIMEBEGINDST
of IXIP))
(SETQ \EndDST (fetch TIMEENDDST of IXIP))
(\SETNEWTIME0 TIME)
(RETURN T))
NIL])
(NSNETDATE
[LAMBDA NIL (* bvm: " 3-MAR-83 17:38")
(GDATE (ALTO.TO.LISP.DATE (OR (NSNETDAYTIME0)
(DAYTIME0 (create FIXP])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS TIMEXIP ((TIMEBODY (fetch (PACKETEXCHANGEXIP PACKETEXCHANGEBODY) of DATUM)))
[BLOCKRECORD TIMEBODY ((TIMEVERSION WORD)
(* Protocol version)
(TIMEOP WORD) (* What kind of request/response)
(TIMEVALUE FIXP)
(TIMEZONESIGN WORD) (* 0 = west of prime meridian, 1 = east)
(TIMEZONEHOURS WORD) (* Hours from prime meridian)
(TIMEZONEMINUTES WORD) (* Minutes ...)
(TIMEBEGINDST WORD) (* Day of year when DST starts)
(TIMEENDDST WORD) (* Day of year when DST stops)
)
(BLOCKRECORD TIMEBODY ((NIL 2 WORD)
(TIMEVALUEHI WORD)
(TIMEVALUELO WORD])
]
(DECLARE: EVAL@COMPILE
(RPAQQ \TIMESOCKET 8)
(RPAQQ \TIMEOP.TIMEREQUEST 1)
(RPAQQ \TIMEOP.TIMERESPONSE 2)
(RPAQQ \TIMEVERSION 2)
(RPAQQ \EXTYPE.TIME 1)
(CONSTANTS \TIMESOCKET \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE \TIMEVERSION \EXTYPE.TIME)
)
)
(* Background activities)
(DEFINEQ
(NS.ECHOSERVER
[LAMBDA (DURATION.MINUTES) (* bvm: " 7-AUG-83 01:40")
(* Process that watches for packets on the Well-Known
socket number 2, and echos them.)
(RESETLST (PROG ((ECHOSKT (OPENNSOCKET \NS.WKS.Echo T))
[TIMEOUT (AND (FIXP DURATION.MINUTES)
(SETUPTIMER (ITIMES 165140Q DURATION.MINUTES]
XIP ECHOSKT)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
ECHOSKT))
(until (AND TIMEOUT (TIMEREXPIRED? TIMEOUT))
do (COND
((SETQ XIP (GETXIP ECHOSKT (OR TIMEOUT T)))
(* Got something)
(COND
((AND (EQ (fetch XIPTYPE of XIP)
\XIPT.ECHO)
(EQ (fetch XIPFIRSTDATAWORD of XIP)
\XECHO.OP.REQUEST))
(replace XIPFIRSTDATAWORD of XIP with \XECHO.OP.REPLY)
(\SWAPNSADDRESSES (LOCF (fetch XIPDESTNET of XIP))
(LOCF (fetch XIPSOURCENET of XIP)))
(SENDXIP ECHOSKT XIP))
(T (* Just drop the packet if it doesn't look good)
(COND
(XIPTRACEFLG (PRINTPACKET XIP (QUOTE GET)
XIPTRACEFILE
"Garbage Packet sent to the Echo socket:")))
(\RELEASE.ETHERPACKET XIP])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \XECHO.OP.REQUEST 1)
(RPAQQ \XECHO.OP.REPLY 2)
(CONSTANTS \XECHO.OP.REQUEST \XECHO.OP.REPLY)
)
)
(* Debugging)
(DEFINEQ
(NS.ECHOUSER
[LAMBDA (ECHOHOST ECHOSTREAM INTERVAL NTIMES) (* bvm: "25-Jun-84 15:20")
(RESETLST (PROG ((TIMER (SETUPTIMER 0))
(ECHOADDRESS (OR (\COERCE.TO.NSADDRESS ECHOHOST \NS.WKS.Echo)
(\ILLEGAL.ARG ECHOHOST)))
NSOC OXIP IXIP EVENT I XIPBASE ECHOXIPLENGTH OXIPBASE)
[RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
(SETQ NSOC (OPENNSOCKET]
(SETQ OXIP (\FILLINXIP \XIPT.ECHO NSOC ECHOADDRESS))
(XIPAPPEND.WORD OXIP \XECHO.OP.REQUEST)
(XIPAPPEND.WORD OXIP (SETQ I 1))
(XIPAPPEND.STRING OXIP "Random string for echo")
(OR INTERVAL (SETQ INTERVAL 1000))
(OR NTIMES (SETQ NTIMES 1000))
(printout ECHOSTREAM "Echoing to " ECHOADDRESS T)
(SETQ ECHOSTREAM (GETSTREAM (OR ECHOSTREAM T)
(QUOTE OUTPUT)))
(SETQ ECHOXIPLENGTH (fetch XIPLENGTH of OXIP))
(SETQ OXIPBASE (fetch XIPCONTENTS of OXIP))
(SETQ EVENT (fetch NSOCEVENT of NSOC))
LP (SENDXIP NSOC OXIP)
(PRIN1 (QUOTE !)
ECHOSTREAM)
(SETUPTIMER INTERVAL TIMER)
(do (COND
[(SETQ IXIP (GETXIP NSOC))
(COND
((PROG1 (SELECTC (fetch XIPTYPE of IXIP)
(\XIPT.ECHO (COND
((OR (NEQ (fetch XIPLENGTH of IXIP)
ECHOXIPLENGTH)
(NEQ (\GETBASE (SETQ XIPBASE
(fetch XIPCONTENTS
of IXIP))
0)
\XECHO.OP.REPLY))
(PRIN1 (QUOTE ?)
ECHOSTREAM)
NIL)
((IEQP (\GETBASE XIPBASE 1)
I)
(PRIN1 (QUOTE +)
ECHOSTREAM))
(T (PRIN1 "(late)" ECHOSTREAM)
NIL)))
(\XIPT.ERROR (PRINTERRORXIP IXIP ECHOSTREAM)
NIL)
(PROGN (PRIN1 (QUOTE ?)
ECHOSTREAM)
NIL))
(RELEASE.XIP IXIP))
(RETURN]
(T (AWAIT.EVENT EVENT TIMER T)))
repeatuntil (TIMEREXPIRED? TIMER)
finally (COND
((fetch EPTRANSMITTING of OXIP)
(PRIN1 "[not yet transmitted; maybe transmitter is off]"
ECHOSTREAM)))
(PRIN1 (QUOTE %.)
ECHOSTREAM))
(COND
((IGREATERP (OR (EQ NTIMES T)
(add NTIMES -1))
0)
(\PUTBASE OXIPBASE 1 (add I 1))
(GO LP])
)
(RPAQ? \DEFAULTECHOSERVER NIL)
(RPAQ? \NS.ECHOUSERSOCKET NIL)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\NSINIT)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LLETHER)
)
(PUTPROPS LLNS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8060 10677 (\COERCE.TO.NSADDRESS 8070 . 8765) (\PARSE.NSADDRESSCONSTANT 8767 . 10675))
(12355 15340 (OPENNSOCKET 12365 . 13738) (CLOSENSOCKET 13740 . 14584) (NSOCKETEVENT 14586 . 14758) (
NSOCKETNUMBER 14760 . 14937) (NSOCKETFROMNUMBER 14939 . 15080) (\FLUSHNSOCQUEUE 15082 . 15338)) (15438
17009 (\NSINIT 15448 . 16706) (STOPNS 16708 . 17007)) (17010 22768 (\HANDLE.RAW.XIP 17020 . 20984) (
\XIPERROR 20986 . 22245) (\FORWARD.XIP 22247 . 22766)) (22875 26800 (GETXIP 22885 . 23842) (
DISCARDXIPS 23844 . 24110) (SENDXIP 24112 . 25244) (SWAPXIPADDRESSES 25246 . 25902) (\SETXIPCHECKSUM
25904 . 26457) (\CLEARXIPHEADER 26459 . 26798)) (26986 34516 (\FILLINXIP 26996 . 29197) (
XIPAPPEND.BYTE 29199 . 29919) (XIPAPPEND.WORD 29921 . 30872) (XIPAPPEND.CELL 30874 . 31875) (
XIPAPPEND.STRING 31877 . 33053) (XIPAPPEND.IFSSTRING 33055 . 33437) (XIPAPPEND.INTEGER 33439 . 34514))
(34541 45395 (\NSGATELISTENER 34551 . 36132) (\HANDLE.NS.ROUTING.INFO 36134 . 38529) (\ROUTE.XIP
38531 . 40435) (\LOCATE.NSNET 40437 . 41784) (NSNET.DISTANCE 41786 . 42236) (BESTNSADDRESS 42238 .
44094) (SORT.NSADDRESSES.BY.DISTANCE 44096 . 44908) (\NSNET.CLOSERP 44910 . 45393)) (46402 47294 (
XIPTRACE 46412 . 47292)) (47295 50806 (PRINTXIP 47305 . 48760) (PRINTERRORXIP 48762 . 49284) (
PRINTXIPROUTE 49286 . 50107) (PRINTXIPDATA 50109 . 50804)) (51744 53197 (\PEEKNS 51754 . 52516) (
\MAYBEPEEKNS 52518 . 53195)) (53299 53933 (\PROMISCUOUS.ON 53309 . 53606) (\PROMISCUOUS.OFF 53608 .
53931)) (54098 56163 (\GETMISCNSOCKET 54108 . 54511) (CREATE.PACKET.EXCHANGE.XIP 54513 . 55157) (
EXCHANGEXIPS 55159 . 56019) (RELEASE.XIP 56021 . 56161)) (57542 59697 (\LOOKUPPUPNUMBER 57552 . 59695)
) (59723 62179 (NSNETDAYTIME0 59733 . 60555) (\NS.SETTIME 60557 . 61980) (NSNETDATE 61982 . 62177)) (
63305 64708 (NS.ECHOSERVER 63315 . 64706)) (64890 67292 (NS.ECHOUSER 64900 . 67290)))))
STOP