(FILECREATED " 7-AUG-83 02:02:38" {PHYLUM}<LISPCORE>SOURCES>LLNS.;16 167277Q
changes to: (FNS NS.ECHOSERVER NS.ECHOUSER NSOCKETFROMNUMBER SWAPXIPADDRESSES \HANDLE.RAW.XIP)
(VARS LLNSCOMS)
previous date: " 4-AUG-83 22:56:43" {PHYLUM}<LISPCORE>SOURCES>LLNS.;14)
(* Copyright (c) 1983 by Xerox Corporation)
(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 1001Q 1002Q 1003Q 1004Q))
(GLOBALVARS XIPTYPES XIPERRORMESSAGES))
(COMS (* Parsing and looking up NS addresses)
(DECLARE: DONTCOPY (MACROS \GPNCHAR)
(* Get Previous Numerical-valued CHARacter from string pointer))
(FNS \NS.FINDNSADDRESS \PARSE.NSADDRESSCONSTANT \PARSEANUM))
(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.RouterError 3)
(\NS.WKS.Courier 5)
(\NS.WKS.PUPLOOKUP 11Q)))
(GLOBALVARS \NSOCKETS \MAX.EPKTS.ON.NSOCKET)
(MACROS \NSOCKET.FROM#))
(INITRECORDS NSOCKET)
(SYSRECORDS NSOCKET)
(FNS OPENNSOCKET CLOSENSOCKET NSOCKETEVENT NSOCKETFROMNUMBER \FLUSHNSOCQUEUE)
(INITVARS (\NSOCKETS)
(\MAX.EPKTS.ON.NSOCKET 20Q)))
(COMS (* assorted level 1 and 2)
(FNS \NSINIT STOPNS)
(FNS \HANDLE.RAW.XIP \XIPERROR \FORWARD.XIP)
(FNS GETXIP DISCARDXIPS SENDXIP SWAPXIPADDRESSES \SETXIPCHECKSUM
\CLEARXIPHEADER)
(GLOBALRESOURCES (\ROUTEBOX.HOST (create NSHOSTNUMBER)))
(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)
(INITVARS (\NS.ROUTING.TABLE NIL)
(\NS.ROUTING.TABLE.RADIUS 5)
(\NSROUTER.PROBECOUNT 0)
(\NSROUTER.PROBETIMER)
(\NSROUTER.PROBEINTERVAL 5670Q)
(\NS.READY)
(\NS.READY.EVENT (CREATE.EVENT "NS Ready")))
(ADDVARS (\SYSTEMCACHEVARS \NS.READY))
(DECLARE: DONTCOPY (RECORDS NSROUTINGINFO)
(CONSTANTS \NS.ROUTINGINFO.WORDS)
(GLOBALVARS \NS.ROUTING.TABLE \NS.ROUTING.TABLE.RADIUS
\NSROUTER.PROBECOUNT \NSROUTER.PROBETIMER
\NSROUTER.PROBEINTERVAL \NS.READY \NS.READY.EVENT)))
(COMS (* Background activities)
(FNS NS.ECHOSERVER)
(DECLARE: DONTCOPY (CONSTANTS \XECHO.OP.REQUEST \XECHO.OP.REPLY
\XROUTINGINFO.OP.REQUEST
\XROUTINGINFO.OP.RESPONSE)))
(COMS (* Analogous to PUP stuff for tracing activity.)
(FNS XIPTRACE \XIPTraceWindowButtonEventFn)
(INITVARS (XIPTRACEFLG)
(XIPTRACEFILE T))
(ALISTS (XIPONLYTYPES)
(XIPIGNORETYPES))
(GLOBALVARS XIPTRACEFLG XIPTRACEFILE XIPIGNORETYPES XIPONLYTYPES))
(COMS (* Printing routines for XIP's)
(FNS PRINTXIP PRINTERRORXIP PRINTXIPROUTE PRINTXIPDATA)
(ALISTS (XIPPRINTMACROS 1 2 3 4))
(PROP VARTYPE XIPPRINTMACROS)
(GLOBALVARS XIPPRINTMACROS)
(ADDVARS (\PACKET.PRINTERS (3000Q . PRINTXIP)))
(DECLARE: DONTCOPY (RECORDS ERRORXIP)))
(COMS (INITVARS (\NS.CHECKSUMFLG T))
(GLOBALVARS \NS.CHECKSUMFLG))
(COMS (* Simple packet exchange protocols)
(FNS \GETMISCNSOCKET EXCHANGEXIPS \LOOKUPPUPNUMBER RELEASE.XIP)
(RECORDS PACKETEXCHANGEXIP)
(CONSTANTS (\EXTYPE.REQUEST 1)
(\EXTYPE.RESPONSE 2)
(\EXTYPE.NEGATIVE 3))
(GLOBALVARS \MISC.NSOCKET)
(INITVARS (\MISC.NSOCKET)))
(COMS (* Time service)
(FNS NSNETDAYTIME0 \NS.SETTIME NSNETDATE)
(DECLARE: DONTCOPY (RECORDS TIMEBODY)
(CONSTANTS \TIMESOCKET \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE
\TIMEVERSION \EXTYPE.TIME)))
(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 36Q)
(RPAQQ \MAX.XIPDATALENGTH 1042Q)
(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))
)
(* END EXPORTED DEFINITIONS)
(RPAQQ XIPERRORCODES ((\XIPE.CHECKSUM 1)
(\XIPE.NOSOCKET 2)
(\XIPE.SOCKETFULL 3)
(\XIPE.GATEWAY.CHECKSUM 1001Q)
(\XIPE.NOROUTE 1002Q)
(\XIPE.LOOPED 1003Q)
(\XIPE.TOOLARGE 1004Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \XIPE.CHECKSUM 1)
(RPAQQ \XIPE.NOSOCKET 2)
(RPAQQ \XIPE.SOCKETFULL 3)
(RPAQQ \XIPE.GATEWAY.CHECKSUM 1001Q)
(RPAQQ \XIPE.NOROUTE 1002Q)
(RPAQQ \XIPE.LOOPED 1003Q)
(RPAQQ \XIPE.TOOLARGE 1004Q)
(CONSTANTS (\XIPE.CHECKSUM 1)
(\XIPE.NOSOCKET 2)
(\XIPE.SOCKETFULL 3)
(\XIPE.GATEWAY.CHECKSUM 1001Q)
(\XIPE.NOROUTE 1002Q)
(\XIPE.LOOPED 1003Q)
(\XIPE.TOOLARGE 1004Q))
)
)
(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")
(1001Q "Gateway: Bad checksum")
(1002Q "Can't get there from here")
(1003Q "Too many hops")
(1004Q "Packet too large to forward"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS XIPTYPES XIPERRORMESSAGES)
)
(* Parsing and looking up NS addresses)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \GPNCHAR MACRO [OPENLAMBDA (BAR)
(\GETBASEBYTE (FETCH (STRINGP BASE) OF BAR)
(SUB1 (FETCH (STRINGP OFFST) OF BAR])
)
(* Get Previous Numerical-valued CHARacter from string pointer)
)
(DEFINEQ
(\NS.FINDNSADDRESS
[LAMBDA (HOST) (* lmm "11-JUN-83 22:59")
(COND
((LITATOM HOST)
(\PARSE.NSADDRESSCONSTANT (MKSTRING HOST)))
((type? NSADDRESS HOST)
HOST)
((STRINGP HOST)
(\PARSE.NSADDRESSCONSTANT HOST])
(\PARSE.NSADDRESSCONSTANT
[LAMBDA (STR) (* JonL " 8-AUG-82 04:35")
(* If STR is a constant NS address of form
net#host#socket, or net#host#, or net#host, or host#
then returns an NSADDRESS, else NIL)
(OR (STRINGP STR)
(SHOULDNT STR))
(SETQ STR (SUBSTRING STR 1)) (* Copies string pointer)
(PROG ((NET 0)
(HOST 0)
(SOC# 0)
VAL CH)
(if [NOT (FIXP (SETQ CH (NTHCHAR STR 1]
then (if (EQ CH (QUOTE #))
then (GNC STR)
else (RETURN)))
(if (NOT (FIXP (NTHCHAR STR 1)))
then (RETURN))
(if (NULL (SETQ VAL (\PARSEANUM STR)))
then (RETURN)
elseif (EQ 0 (NCHARS STR))
then (OR (EQ (\GPNCHAR STR)
(CHARCODE #))
(RETURN))
(SETQ HOST VAL)
(GO DONE))
(SETQ NET VAL)
(if (NULL (SETQ VAL (\PARSEANUM STR)))
then (RETURN))
(SETQ HOST VAL)
(if (NEQ 0 (NCHARS STR))
then (SETQ SOC# (\PARSEANUM STR))
(if (OR (NULL SOC#)
(EQ (\GPNCHAR STR)
(CHARCODE #)))
then (RETURN)))
DONE(RETURN (create NSADDRESS
NSNET ← NET
NSHNM0 ← 0
NSHNM1 ←(\HINUM HOST)
NSHNM2 ←(\LONUM HOST)
NSSOCKET ← SOC#])
(\PARSEANUM
[LAMBDA (STR) (* bvm: " 1-FEB-83 15:51")
(* GNC from STR, accumulating a FIXP, stopping when # or
end of string seen.)
(PROG ((N 0)
N1 N2 N3 CH)
START
[while (AND (FIXP (SETQ CH (GNC STR)))
(ILEQ 0 CH)
(ILEQ CH 7))
do (SETQ N (IPLUS CH (if N
then (LLSH N 3)
else 0] (* Accumulate digits)
(if (EQ CH (QUOTE %.))
then (if (NULL N1)
then (SETQ N1 N)
elseif (NULL N2)
then (SETQ N2 N)
elseif (NULL N3)
then (SETQ N3 N))
(SETQ N)
(GO START)
elseif [NOT (MEMB CH (QUOTE (# NIL]
then (* Losing format)
(RETURN))
(RETURN (COND
((NULL N1)
N)
((NULL N2)
(\MAKENUMBER N1 N))
[(NULL N3)
(COND
((EQ 0 N1)
(\MAKENUMBER N2 N]
(T (HELP])
)
(* 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)))
(* Well-known NS sockets)
(DECLARE: EVAL@COMPILE
(RPAQQ \NS.WKS.RoutingInformation 1)
(RPAQQ \NS.WKS.Echo 2)
(RPAQQ \NS.WKS.RouterError 3)
(RPAQQ \NS.WKS.Courier 5)
(RPAQQ \NS.WKS.PUPLOOKUP 11Q)
(CONSTANTS (\NS.WKS.RoutingInformation 1)
(\NS.WKS.Echo 2)
(\NS.WKS.RouterError 3)
(\NS.WKS.Courier 5)
(\NS.WKS.PUPLOOKUP 11Q))
)
(* END EXPORTED DEFINITIONS)
(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) (* 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)
]
(DEFINEQ
(OPENNSOCKET
[LAMBDA (SKT# NOERRORFLG) (* bvm: "26-MAY-83 14:06")
(* 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 100000Q (\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 100000Q (ADD1 (LOGAND SKT# 77777Q]
(T (RETURN])
(COND
(CLASHP (COND
(NOERRORFLG (\FLUSHNSOCQUEUE (SETQ NSOC CLASHP)))
(T (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])
(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 20Q)
(* assorted level 1 and 2)
(DEFINEQ
(\NSINIT
[LAMBDA (EVENT MINI) (* bvm: " 4-AUG-83 22:48")
(* 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))
(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)
(OR (FIND.PROCESS (QUOTE \NSGATELISTENER))
(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 (PACKET TYPE) (* bvm: " 7-AUG-83 01:33")
(* 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)
[COND
((AND (NOT (EQNSHOSTNUMBER (fetch XIPDESTHOST of PACKET)
\MY.NSHOSTNUMBER))
(NOT (EQNSHOSTNUMBER (fetch XIPDESTHOST of PACKET)
BROADCASTNSHOSTNUMBER)))
(* Not for us)
(RETURN (\FORWARD.XIP PACKET]
(SETQ NDB (fetch EPNETWORK of PACKET))
[COND
((ZEROP (fetch XIPDESTNET of PACKET)) (* Default destination net, possibly redundantly to
zero)
(replace XIPDESTNET of PACKET with (fetch NDBNSNET# of NDB)))
([AND (NOT (IEQP (fetch XIPDESTNET of PACKET)
(fetch NDBNSNET# of NDB)))
(NOT (ZEROP (fetch NDBNSNET# of NDB] (* explicitly for a net other than us)
(RETURN (\FORWARD.XIP PACKET]
(COND
[[NULL (SETQ NSOC (\NSOCKET.FROM# (fetch XIPDESTSOCKET of PACKET]
(* Packets addressed to non-active sockets are just
ignored.)
(PROG (XIPBASE)
(COND
[(AND (EQ (fetch XIPTYPE of PACKET)
\XIPT.ECHO)
(EQ (fetch XIPDESTSOCKET of PACKET)
\NS.WKS.Echo)
(EQ (\GETBASE (SETQ XIPBASE (fetch XIPCONTENTS of PACKET))
0)
\XECHO.OP.REQUEST)
\NS.READY) (* Play echo server)
(COND
([AND (NEQ (SETQ CSUM (fetch XIPCHECKSUM of PACKET))
MASKWORD1'S)
(NEQ CSUM (\CHECKSUM (fetch XIPCHECKSUMBASE of PACKET)
(SUB1 (FOLDHI (fetch XIPLENGTH of PACKET)
BYTESPERWORD]
(\XIPERROR PACKET \XIPE.CHECKSUM))
(T (\PUTBASE XIPBASE 0 \XECHO.OP.REPLY)
(SWAPXIPADDRESSES PACKET)
(replace EPREQUEUE of PACKET with (QUOTE FREE))
(SENDXIP NIL PACKET]
(T (\XIPERROR PACKET \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 PACKET \XIPE.SOCKETFULL))
([AND \NS.CHECKSUMFLG (NEQ (SETQ CSUM (fetch XIPCHECKSUM of PACKET))
MASKWORD1'S)
(NEQ CSUM (\CHECKSUM (fetch XIPCHECKSUMBASE of PACKET)
(SUB1 (FOLDHI (fetch XIPLENGTH of PACKET)
BYTESPERWORD]
(\XIPERROR PACKET \XIPE.CHECKSUM))
(T (UNINTERRUPTABLY
(\ENQUEUE (fetch (NSOCKET INQUEUE) of NSOC)
PACKET)
(add (fetch (NSOCKET INQUEUELENGTH) of NSOC)
1)
(NOTIFY.EVENT (fetch NSOCEVENT of NSOC)))]
T])
(\XIPERROR
[LAMBDA (XIP ERRCODE) (* bvm: "19-FEB-83 20:00")
(* * 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!)
(COND
((AND XIPTRACEFLG (NEQ XIPTRACEFLG (QUOTE PEEK)))
(printout XIPTRACEFILE "Incoming packet dropped because: "
(OR (CADR (ASSOC ERRCODE XIPERRORMESSAGES))
ERRCODE)
T)
(OR (EQ XIPTRACEFLG (QUOTE RAW))
(PRINTXIP XIP]
(\RELEASE.ETHERPACKET XIP])
(\FORWARD.XIP
[LAMBDA (XIP) (* bvm: "19-FEB-83 19:51")
(* Called when we receive a XIP not addressed to us. Unless we are a gateway, dump it)
(COND
(XIPTRACEFLG (PRINTXIP XIP (QUOTE GET)
NIL "XIP not addressed to this host: ")))
(\RELEASE.ETHERPACKET XIP])
)
(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: " 7-JUL-83 14:22")
(* 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)
(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: " 5-AUG-83 15:24")
(SETQ XIP (\DTEST XIP (QUOTE ETHERPACKET)))
(PROG ((SCRATCH (create NSADDRESS)))
(\BLT SCRATCH (LOCF (fetch XIPSOURCENET of XIP))
\#WDS.NSADDRESS)
(\BLT (LOCF (fetch XIPSOURCENET of XIP))
(LOCF (fetch XIPDESTNET of XIP))
\#WDS.NSADDRESS)
(\BLT (LOCF (fetch XIPDESTNET of XIP))
SCRATCH \#WDS.NSADDRESS])
(\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])
)
(RPAQQ \ROUTEBOX.HOST NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \ROUTEBOX.HOST)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \ROUTEBOX.HOST)
(QUOTE GLOBALRESOURCES)
(QUOTE (create NSHOSTNUMBER)))
)
(DEFINEQ
(\FILLINXIP
[LAMBDA (TYPE SOURCENSOCKET DESTHOST DESTSOCKET# DESTNET LENGTH EPKT)
(* lmm "11-JUN-83 22:28")
(* 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))
((type? NSHOSTNUMBER DESTHOST) (* Just doesn't put anything in the NET or DESTSOCKET#
fields)
(replace XIPDESTHOST of EPKT with DESTHOST))
(T (SETQ DESTHOST (OR (COND
((LITATOM DESTHOST)
(\PARSE.NSADDRESSCONSTANT (MKSTRING DESTHOST)))
((STRINGP DESTHOST)
(\PARSE.NSADDRESSCONSTANT DESTHOST)))
(ERROR DESTHOST "Isn't a valid DestinationHost specificaton.")))
(replace XIPDESTNSADDRESS of EPKT with DESTHOST)))
(AND (FIXP DESTNET)
(replace XIPDESTNET of EPKT with DESTNET))
(AND DESTSOCKET# (replace XIPDESTSOCKET of EPKT with DESTSOCKET#))
(AND (IGREATERP (fetch XIPLENGTH of EPKT)
0)
(\SETXIPCHECKSUM EPKT))
(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: "31-MAY-83 22:55")
(* 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
([AND (ZEROP (fetch NDBNSNET# of NDB))
(OR [NOT (ZEROP (SETQ NET (fetch XIPDESTNET of XIP]
(PROGN (* For some perverse reason, FatBoy does not put an
explicit net number in the destination of its router
packets)
(AND [NOT (ZEROP (SETQ NET (fetch XIPSOURCENET of XIP]
(EQNSHOSTNUMBER (fetch XIPDESTHOST of XIP)
BROADCASTNSHOSTNUMBER]
(* We didn't know our ns net#, but router tells us)
(replace NDBNSNET# of NDB with NET)
(replace NSNET of \MY.NSADDRESS with (SETQ \MY.NSNETNUMBER NET))
[OR (SETQ ENTRY (\LOCATE.NSNET NET T))
(push (CDR \NS.ROUTING.TABLE)
(SETQ ENTRY (create ROUTING
RTNET# ← NET]
(replace RTHOPCOUNT of ENTRY with 0)
(replace RTGATEWAY# of ENTRY with NIL)
(replace RTNDB of ENTRY with NDB)
(replace RTRECENT of ENTRY with T)))
[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 (.RTLOOKUP. NET \NS.ROUTING.TABLE))
(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 (EPKT) (* lmm "11-JUN-83 23:27")
(* Encapsulates XIP, choosing the right network and
immediate destination host. Returns an NDB for the
transmission)
(GLOBALRESOURCE \ROUTEBOX.HOST (LOADNSHOSTNUMBER (LOCF (fetch XIPDESTWORD1 of EPKT))
\ROUTEBOX.HOST)
(PROG ((NET (fetch XIPDESTNET of EPKT))
PDH ROUTE NDB)
[COND
[(ZEROP NET)
(COND
((SETQ NDB (OR \10MBLOCALNDB \3MBLOCALNDB))
(replace EPNETWORK of EPKT with NDB)
(COND
([SETQ PDH (COND
((EQ (fetch NETTYPE of NDB)
10)
\ROUTEBOX.HOST)
((EQNSHOSTNUMBER \ROUTEBOX.HOST BROADCASTNSHOSTNUMBER)
(* On 3, broadcast goes to zero)
0)
(T (\TRANSLATE.10TO3 \ROUTEBOX.HOST NDB]
(ENCAPSULATE.ETHERPACKET NDB EPKT PDH (fetch XIPLENGTH
of EPKT)
\EPT.XIP]
((SETQ ROUTE (\LOCATE.NSNET NET))
(replace EPNETWORK of EPKT with (SETQ NDB (fetch RTNDB of ROUTE)))
(COND
([SETQ PDH (COND
((NEQ (fetch RTHOPCOUNT of ROUTE)
0)
(fetch RTGATEWAY# of ROUTE))
((EQ (fetch NETTYPE of NDB)
10)
\ROUTEBOX.HOST)
((EQNSHOSTNUMBER \ROUTEBOX.HOST BROADCASTNSHOSTNUMBER)
(* On 3, broadcast goes to zero)
0)
(T (\TRANSLATE.10TO3 \ROUTEBOX.HOST NDB]
(ENCAPSULATE.ETHERPACKET NDB EPKT PDH (fetch XIPLENGTH
of EPKT)
\EPT.XIP]
[COND
(NDB [COND
((ZEROP NET)
(replace XIPDESTNET of EPKT with (fetch NDBNSNET# of NDB]
(replace XIPSOURCENET of EPKT with (fetch NDBNSNET# of NDB]
(RETURN NDB])
(\LOCATE.NSNET
[LAMBDA (NET DONTPROBE) (* lmm "11-JUN-83 23:10")
(for (PREVTAIL ← \NS.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 (ZEROP NET)
(ZEROP (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])
)
(RPAQ? \NS.ROUTING.TABLE NIL)
(RPAQ? \NS.ROUTING.TABLE.RADIUS 5)
(RPAQ? \NSROUTER.PROBECOUNT 0)
(RPAQ? \NSROUTER.PROBETIMER )
(RPAQ? \NSROUTER.PROBEINTERVAL 5670Q)
(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)
(CONSTANTS \NS.ROUTINGINFO.WORDS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NS.ROUTING.TABLE \NS.ROUTING.TABLE.RADIUS \NSROUTER.PROBECOUNT
\NSROUTER.PROBETIMER \NSROUTER.PROBEINTERVAL \NS.READY \NS.READY.EVENT)
)
)
(* 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)
(RPAQQ \XROUTINGINFO.OP.REQUEST 1)
(RPAQQ \XROUTINGINFO.OP.RESPONSE 2)
(CONSTANTS \XECHO.OP.REQUEST \XECHO.OP.REPLY \XROUTINGINFO.OP.REQUEST \XROUTINGINFO.OP.RESPONSE)
)
)
(* 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])
(\XIPTraceWindowButtonEventFn
[LAMBDA (WINDOW) (* bvm: " 4-FEB-83 17:45")
(AND (WINDOWP WINDOW)
(NOT (ACTIVEWP WINDOW))
(OPENW WINDOW))
[COND
((OR (NULL WINDOW)
(LASTMOUSESTATE (NOT UP)))
(printout WINDOW .TAB0 0 "[Tracing " (COND
[(LASTMOUSESTATE LEFT)
(SELECTQ XIPTRACEFLG
(NIL (SETQ XIPTRACEFLG T)
"On]")
(T (SETQ XIPTRACEFLG (QUOTE PEEK))
"Brief]")
(COND
((OR (NOT \RAWTRACING)
(EQ XIPTRACEFLG (QUOTE RAW)))
(SETQ XIPTRACEFLG NIL)
"Off]")
(T (SETQ XIPTRACEFLG (QUOTE RAW))
"only Raw]"]
(T (COND
(\RAWTRACING (SETQ \RAWTRACING NIL)
"Raw Off]")
(T (SETQ \RAWTRACING T)
"Raw On]"]
NIL])
)
(RPAQ? XIPTRACEFLG )
(RPAQ? XIPTRACEFILE T)
(ADDTOVAR XIPONLYTYPES )
(ADDTOVAR XIPIGNORETYPES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS XIPTRACEFLG XIPTRACEFILE XIPIGNORETYPES XIPONLYTYPES)
)
(* Printing routines for XIP's)
(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) (* JonL " 1-AUG-82 19:33")
(OR (ZEROP (POSITION FILE))
(TERPRI FILE))
(AND CALLER (printout FILE CALLER ": "))
(printout FILE "From " (\PRINTNSADDRESS (LOCF (fetch (XIP XIPSOURCENET) of PACKET))
FILE)
" to "
(\PRINTNSADDRESS (LOCF (fetch (XIP XIPDESTNET) of PACKET))
FILE))
(if (NEQ 0 (fetch XIPTCONTROL of PACKET))
then (printout FILE ", Transport = " .P2 (fetch XIPTCONTROL of PACKET)))
(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])
)
(ADDTOVAR XIPPRINTMACROS (1 "Operation = " WORDS 2 "Info: " ...)
(2 "Operation: " WORDS 2 "Data: " CHARS 144Q ...)
(3 . PRINTERRORXIP)
(4 "ID = " INTEGER 4 "Type = " WORDS 6 BYTES 10Q))
(PUTPROPS XIPPRINTMACROS VARTYPE ALIST)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS XIPPRINTMACROS)
)
(ADDTOVAR \PACKET.PRINTERS (3000Q . 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...)
)))
]
)
(RPAQ? \NS.CHECKSUMFLG T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NS.CHECKSUMFLG)
)
(* 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])
(EXCHANGEXIPS
[LAMBDA (SOC OUTXIP IDFILTER TIMEOUT) (* bvm: "24-FEB-83 18:25")
(* 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 (fetch XIPCONTENTS of INXIP))
(fetch PACKETEXCHANGEID of (fetch XIPCONTENTS of OUTXIP]
(RETURN INXIP])
(\LOOKUPPUPNUMBER
[LAMBDA (NSNUMBER) (* bvm: " 7-JUL-83 14:12")
(* * Looks up the pup host number for NSNUMBER. These numbers are in gateway's database)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT BUF)
(SETQ OXIP (\FILLINXIP \XIPT.PUPLOOKUP SOC BROADCASTNSHOSTNUMBER \NS.WKS.PUPLOOKUP 0))
(add (fetch XIPLENGTH of OXIP)
(UNFOLD (IPLUS \#WDS.NSHOSTNUMBER 3)
BYTESPERWORD))
(SETQ BUF (fetch XIPCONTENTS of OXIP))
(replace PACKETEXCHANGEID of BUF with (CLOCK 0))
(replace PACKETEXCHANGETYPE of BUF with \EXTYPE.REQUEST)
(\STORENSHOSTNUMBER (LOCF (fetch PACKETEXCHANGEBODY of BUF))
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 (fetch XIPCONTENTS of INXIP))
(fetch PACKETEXCHANGEID of (fetch XIPCONTENTS of OXIP)))
(SELECTC (fetch PACKETEXCHANGETYPE of (SETQ BUF
(fetch XIPCONTENTS
of INXIP)))
[\EXTYPE.RESPONSE (RETURN (PROG1 (SETQ RESULT
(fetch
PACKETEXCHANGEBODY
of BUF))
(RELEASE.XIP INXIP]
(\EXTYPE.NEGATIVE
(COND
(XIPTRACEFLG (printout
XIPTRACEFILE
[\GETBASESTRING
(LOCF (fetch PACKETEXCHANGEBODY
of BUF))
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])
(RELEASE.XIP
[LAMBDA (XIP) (* bvm: "24-FEB-83 18:08")
(\RELEASE.ETHERPACKET XIP])
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD PACKETEXCHANGEXIP ((PACKETEXCHANGEID FIXP) (* Arbitrary id in packet exchange XIP)
(PACKETEXCHANGETYPE WORD) (* Protocol-specific type)
(PACKETEXCHANGEBODY WORD) (* Body starts here)
))
]
(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)
)
(RPAQ? \MISC.NSOCKET )
(* Time service)
(DEFINEQ
(NSNETDAYTIME0
[LAMBDA NIL (* bvm: " 3-MAR-83 17:15")
(* * Returns a 32-bit unsigned alto time from the network, if possible)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT IXIP BUF)
[SETQ OXIP (\FILLINXIP \XIPT.EXCHANGE SOC BROADCASTNSHOSTNUMBER \TIMESOCKET 0
(IPLUS \XIPOVLEN (UNFOLD 5 BYTESPERWORD]
(SETQ BUF (fetch XIPCONTENTS of OXIP))
(replace PACKETEXCHANGETYPE of BUF with \EXTYPE.TIME)
(replace PACKETEXCHANGEID of BUF with (RAND))
(replace TIMEOP of BUF with \TIMEOP.TIMEREQUEST)
(replace TIMEVERSION of BUF with \TIMEVERSION)
(RETURN (to \MAXETHERTRIES when (SETQ IXIP (EXCHANGEXIPS SOC OXIP T))
do (SELECTC (fetch TIMEOP of (SETQ BUF (fetch XIPCONTENTS of IXIP)))
(\TIMEOP.TIMERESPONSE (RETURN (fetch TIMEVALUE of BUF)))
NIL])
(\NS.SETTIME
[LAMBDA NIL (* bvm: "26-MAY-83 15:46")
(* * Returns a 32-bit unsigned alto time from the network, if possible)
(PROG ((SOC (\GETMISCNSOCKET))
OXIP RESULT IXIP BUF)
[SETQ OXIP (\FILLINXIP \XIPT.EXCHANGE SOC BROADCASTNSHOSTNUMBER \TIMESOCKET 0
(IPLUS \XIPOVLEN (UNFOLD 5 BYTESPERWORD]
(SETQ BUF (fetch XIPCONTENTS of OXIP))
(replace PACKETEXCHANGETYPE of BUF with \EXTYPE.TIME)
(replace PACKETEXCHANGEID of BUF with (RAND))
(replace TIMEOP of BUF with \TIMEOP.TIMEREQUEST)
(replace TIMEVERSION of BUF with \TIMEVERSION)
(RETURN (to \MAXETHERTRIES when (SETQ IXIP (EXCHANGEXIPS SOC OXIP T))
do (SELECTC (fetch TIMEOP of (SETQ BUF (fetch XIPCONTENTS of IXIP)))
(\TIMEOP.TIMERESPONSE (\SETNEWTIME0 (create FIXP
HINUM ←(fetch
TIMEVALUEHI
of BUF)
LONUM ←(fetch
TIMEVALUELO
of BUF)))
(SETQ \TimeZoneComp
(ITIMES (COND
((ZEROP (fetch TIMEZONESIGN
of BUF))
1)
(T -1))
(fetch TIMEZONEHOURS of BUF)))
(SETQ \BeginDST (fetch TIMEBEGINDST
of BUF))
(SETQ \EndDST (fetch TIMEENDDST of BUF))
(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
(BLOCKRECORD TIMEBODY ((NIL 3 WORD) (* Packet exchange header)
(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 5 WORD)
(TIMEVALUEHI WORD)
(TIMEVALUELO WORD))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \TIMESOCKET 10Q)
(RPAQQ \TIMEOP.TIMEREQUEST 1)
(RPAQQ \TIMEOP.TIMERESPONSE 2)
(RPAQQ \TIMEVERSION 2)
(RPAQQ \EXTYPE.TIME 1)
(CONSTANTS \TIMESOCKET \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE \TIMEVERSION \EXTYPE.TIME)
)
)
(* Debugging)
(DEFINEQ
(NS.ECHOUSER
[LAMBDA (ECHOHOST ECHOSTREAM INTERVAL NTIMES) (* bvm: " 7-AUG-83 01:49")
(RESETLST (PROG ((RESULT (QUOTE WIN!))
(NSOC (OPENNSOCKET))
(TIMER (SETUPTIMER 0))
OXIP IXIP EVENT I XIPBASE ECHOXIPLENGTH OXIPBASE)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
NSOC))
(SETQ ECHOHOST (\NS.FINDNSADDRESS ECHOHOST))
(SETQ OXIP (\FILLINXIP \XIPT.ECHO NSOC ECHOHOST \NS.WKS.Echo))
(XIPAPPEND.WORD OXIP \XECHO.OP.REQUEST)
(XIPAPPEND.WORD OXIP (SETQ I 1))
(XIPAPPEND.STRING OXIP "Random string for echo")
(OR INTERVAL (SETQ INTERVAL 1750Q))
(OR NTIMES (SETQ NTIMES 1750Q))
(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" 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (17476Q 25221Q (\NS.FINDNSADDRESS 17510Q . 20157Q) (\PARSE.NSADDRESSCONSTANT 20161Q .
23066Q) (\PARSEANUM 23070Q . 25217Q)) (31037Q 36340Q (OPENNSOCKET 31051Q . 33521Q) (CLOSENSOCKET
33523Q . 35237Q) (NSOCKETEVENT 35241Q . 35515Q) (NSOCKETFROMNUMBER 35517Q . 35734Q) (\FLUSHNSOCQUEUE
35736Q . 36336Q)) (36503Q 41311Q (\NSINIT 36515Q . 40632Q) (STOPNS 40634Q . 41307Q)) (41312Q 51614Q (
\HANDLE.RAW.XIP 41324Q . 47417Q) (\XIPERROR 47421Q . 50750Q) (\FORWARD.XIP 50752Q . 51612Q)) (51615Q
61010Q (GETXIP 51627Q . 53524Q) (DISCARDXIPS 53526Q . 54140Q) (SENDXIP 54142Q . 56222Q) (
SWAPXIPADDRESSES 56224Q . 57206Q) (\SETXIPCHECKSUM 57210Q . 60261Q) (\CLEARXIPHEADER 60263Q . 61006Q))
(61360Q 100234Q (\FILLINXIP 61372Q . 65725Q) (XIPAPPEND.BYTE 65727Q . 67247Q) (XIPAPPEND.WORD 67251Q
. 71140Q) (XIPAPPEND.CELL 71142Q . 73113Q) (XIPAPPEND.STRING 73115Q . 75345Q) (XIPAPPEND.IFSSTRING
75347Q . 76145Q) (XIPAPPEND.INTEGER 76147Q . 100232Q)) (100265Q 120650Q (\NSGATELISTENER 100277Q .
103354Q) (\HANDLE.NS.ROUTING.INFO 103356Q . 112107Q) (\ROUTE.XIP 112111Q . 116161Q) (\LOCATE.NSNET
116163Q . 120646Q)) (122375Q 125170Q (NS.ECHOSERVER 122407Q . 125166Q)) (125725Q 131164Q (XIPTRACE
125737Q . 127517Q) (\XIPTraceWindowButtonEventFn 127521Q . 131162Q)) (131601Q 140136Q (PRINTXIP
131613Q . 134472Q) (PRINTERRORXIP 134474Q . 135506Q) (PRINTXIPROUTE 135510Q . 136643Q) (PRINTXIPDATA
136645Q . 140134Q)) (141675Q 151370Q (\GETMISCNSOCKET 141707Q . 142532Q) (EXCHANGEXIPS 142534Q .
144365Q) (\LOOKUPPUPNUMBER 144367Q . 151150Q) (RELEASE.XIP 151152Q . 151366Q)) (152514Q 160044Q (
NSNETDAYTIME0 152526Q . 154512Q) (\NS.SETTIME 154514Q . 157535Q) (NSNETDATE 157537Q . 160042Q)) (
162233Q 166671Q (NS.ECHOUSER 162245Q . 166667Q)))))
STOP