(FILECREATED "26-May-84 14:50:12" {PHYLUM}<LISPCORE>LIBRARY>GATEWAY.;7 43046
changes to: (VARS GATEWAYCOMS \XIPT.OLDTIME GATEWAYSERVICES)
(FNS \NSTIMESERVER \HANDLE.NS.TIMEREQ)
previous date: "16-Dec-83 14:25:29" {PHYLUM}<LISPCORE>LIBRARY>GATEWAY.;6)
(* Copyright (c) 1983, 1984 by Schlumberger Technology Corporation)
(PRETTYCOMPRINT GATEWAYCOMS)
(RPAQQ GATEWAYCOMS ((FNS GATEWAY GATEWAY.BYE \INIT.GATEWAY)
(COMS (* Pup Gateway)
(FNS \BUILD.PUP.ROUTING.PACKET \GATEWAY.FORWARD.PUP \UPDATECHECKSUM
\HANDLE.PUP.ADDRLOOKUP \HANDLE.PUP.ALTOTIMEREQ \HANDLE.PUP.MISC
\HANDLE.PUP.MISC.BACKGROUND \HANDLE.PUP.NAMELOOKUP \HANDLE.PUP.ROUTING
\PUPGATESERVER \PUPGATESERVERDYING \PUPGATE.BROADCAST \PUPMISCSERVER)
(VARS (\PUP.ROUTEDBAD 0)
(\PUP.ROUTEDPUPS 0)
GATEWAYSERVICES))
(COMS (* NS Gateway)
(FNS \GATEWAY.FORWARD.XIP \NSGATESERVER \NSGATESERVERDYING
\NSGATE.BROADCAST \BUILD.NS.ROUTING.PACKET \HANDLE.NS.ROUTING)
(VARS (\XIP.ROUTEDBAD 0)
(\XIP.ROUTEDGOOD 0))
(FNS \NSTIMESERVER \HANDLE.NS.TIMEREQ)
(DECLARE: EVAL@COMPILE DONTCOPY
(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \XIPT.OLDTIME
\TIMEVERSION \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE
\NSTIMELENGTH \XIPOVLEN)
(RECORDS TIMEBODY)))
(COMS (* Utilities for handling lookup requests)
(FNS AddressFromEntry BCPLStringFromFile LOADBITS MAKEOCTALSTRING
NameFromAddress NetDirAddressLookup NetDirNameLookup PortCompare
PortFromAddress PrintNameBlock SearchNetDirForAddress
SearchNetDirForName StringCompare))
(COMS (* Currently unused)
(FNS MapNameTable NameFromEntry))
(INITVARS (\GATEWAYFLG)
(\PUP.MISC.BACKGROUND.INTERVAL 300000)
(EXTRA10MBTRANSLATIONLST)
(LOCALNETWORKLST))
(CURSORS GATEWAYCURSOR)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS \TIMEPUPLENGTH)
(RECORDS PUPROUTINGINFO TIMEPUPCONTENTS)
(GLOBALVARS \PUP.ROUTEDBAD \PUP.ROUTEDPUPS \XIP.ROUTEDBAD
\XIP.ROUTEDGOOD)
(GLOBALVARS \BeginDST \EndDST \TimeZoneComp)
(MACROS WORDIN WORDOUT)
(FILES (SOURCE)
ETHERRECORDS)
(FILES (LOADCOMP)
LLETHER LLNS))
(FILES PUPIDSERVER)))
(DEFINEQ
(GATEWAY
[LAMBDA (FLG) (* bvm: "13-NOV-83 00:20")
(SELECTQ
FLG
[(ON RESTART)
(PROG NIL
RETRY
(COND
([OR (NLISTP LOCALNETWORKLST)
(CDDR LOCALNETWORKLST)
(NOT (for TRIPLE in LOCALNETWORKLST
always (SELECTQ (CAR TRIPLE)
[(3 10)
(AND (LISTP (SETQ TRIPLE (CDR TRIPLE)))
(OR (NULL (CAR TRIPLE))
(FIXP (CAR TRIPLE)))
[OR (NULL (SETQ TRIPLE (CDR TRIPLE)))
(AND (LISTP TRIPLE)
(OR (NULL (CAR TRIPLE))
(FIXP (CAR TRIPLE]
(NULL (CDR TRIPLE]
(SELECTQ (CDR TRIPLE)
((3 10)
(* Old style, let's fix it)
[/SETATOMVAL (QUOTE LOCALNETWORKLST)
(for PAIR in LOCALNETWORKLST
collect (LIST (CDR PAIR)
(CAR PAIR)
(CAR PAIR]
(GO RETRY))
NIL]
(ERROR "Need to set LOCALNETWORKLST correctly"))
(T (SETQ \GATEWAYFLG T)
(RESTART.ETHER]
(OFF (SETQ \GATEWAYFLG NIL)
(for SERVICE in GATEWAYSERVICES do (DEL.PROCESS SERVICE))
(DISMISS 5000) (* Wait for cleanups)
(RESTART.ETHER))
(NIL)
(BYE (GATEWAY.BYE))
(\ILLEGAL.ARG FLG))
(COND
(\GATEWAYFLG (QUOTE ON))
(T (QUOTE OFF])
(GATEWAY.BYE
(LAMBDA NIL (* ejs: " 5-AUG-83 20:21")
(* * Save processor cycles and the screen)
(RESETLST (RESETSAVE (VIDEOCOLOR T))
(RESETSAVE (SETDISPLAYHEIGHT 0))
(RESETSAVE (CURSOR GATEWAYCURSOR))
(until (READP)
do (ADJUSTCURSORPOSITION (ITIMES (RAND -1 1)
20Q)
(ITIMES (RAND -1 1)
20Q))
(BLOCK 1750Q)))))
(\INIT.GATEWAY
[LAMBDA (EXTRA10MBTRANSLATIONLST) (* bvm: "13-NOV-83 00:04")
(* * Start the Pup gateway. LOCALNETWORKLST is a list of dotted pairs (NET# . NETTYPE), where nettype is either 3
or 10.. EXTRA10MBTRANSLATIONLST is a list of (PUPHOST# . NSHOSTNUMBER) pairs, NSHOSTNUMBER being an instance of
the NSHOSTNUMBER typerecord)
(COND
((NEQ \MACHINETYPE \DOLPHIN)
(ERROR "Pup Gateway runs only on Dolphins"))
((NOT (FIND.PROCESS (QUOTE \10MBWATCHER)))
(ERROR "Either you don't have a 10MB Ethernet in this machine,"
" or you did not start Lisp with LISP/Z X3DOLPHINLISPMC.EB/M"))
((NOT (FIND.PROCESS (QUOTE \3MBWATCHER)))
(ERROR "There's no 3 MB Ethernet!")))
(DEL.PROCESS (QUOTE \PUPGATELISTENER))
(DEL.PROCESS (QUOTE \NSGATELISTENER))
(for SERVERNAME in GATEWAYSERVICES bind PROC when (SETQ PROC (FIND.PROCESS SERVERNAME))
do (SUSPEND.PROCESS PROC))
(SETQ \PUP.ROUTING.TABLE (CONS))
(SETQ \NS.ROUTING.TABLE (CONS))
(COND
((IGREATERP (LENGTH LOCALNETWORKLST)
2)
(ERROR "We only support one 3 and one 10 MB network now")))
(* Ram the routing table down our throats)
[for ROUTE in LOCALNETWORKLST bind NDB NET
do (SETQ NDB (SELECTC (CAR ROUTE)
(3 \3MBLOCALNDB)
(10 \10MBLOCALNDB)
(ERROR "CDR of NETLST entry must be 3 or 10")))
[COND
((SETQ NET (CADR ROUTE))
(NCONC1 \PUP.ROUTING.TABLE
(create ROUTING
RTNET# ← NET
RTHOPCOUNT ← 0
RTNDB ← NDB
RTTIMER ←(SETUPTIMER 0)
RTRECENT ← T))
(replace (NDB NDBPUPNET#) of NDB with NET)
(replace (NDB NDBPUPHOST#) of NDB with (\SERIALNUMBER]
(COND
((SETQ NET (CADDR ROUTE))
(NCONC1 \NS.ROUTING.TABLE
(create ROUTING
RTNET# ← NET
RTHOPCOUNT ← 0
RTNDB ← NDB
RTTIMER ←(SETUPTIMER 0)
RTRECENT ← T))
(replace (NDB NDBNSNET#) of NDB with NET]
[PROGN (* This hardly seems necessary)
(replace (NDB NDBTRANSLATIONS) of \10MBLOCALNDB with (CONS))
(for ENTRY in EXTRA10MBTRANSLATIONLST do (PUTASSOC (CAR ENTRY)
(LIST (CDR ENTRY)
(CLOCK 0))
(fetch (NDB NDBTRANSLATIONS)
of \10MBLOCALNDB]
(SETQ NETDIRSTREAM (OPENSTREAM (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
(QUOTE INPUT)
(QUOTE OLD)))
(for SERVERNAME in GATEWAYSERVICES bind PROC do (COND
((SETQ PROC (FIND.PROCESS SERVERNAME))
(RESTART.PROCESS PROC))
(T (ADD.PROCESS (LIST SERVERNAME)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
(QUOTE DELETE])
)
(* Pup Gateway)
(DEFINEQ
(\BUILD.PUP.ROUTING.PACKET
[LAMBDA (PUP GATESOC OLDPUPFLG DYING) (* bvm: "13-NOV-83 00:13")
(* * Create a routing info Pup to be broadcast over all networks)
(PROG [(BYTE 0)
(MYHOST# (LOGAND 255 \LOCALPUPNETHOST))
(MYNET# (LOGAND 255 (LRSH \LOCALPUPNETHOST 8]
(COND
(OLDPUPFLG (replace (PUP PUPTYPE) of PUP with \PT.GATEWAYRESPONSE))
(T (SETUPPUP PUP 0 \PUPSOCKET.ROUTING \PT.GATEWAYRESPONSE NIL GATESOC)))
[\MAP.ROUTING.TABLE \PUP.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
(PUTPUPBYTE PUP BYTE (fetch (ROUTING RTNET#) of NETWORK))
(PUTPUPBYTE PUP (\ADDBASE BYTE 1)
MYNET#)
(PUTPUPBYTE PUP (\ADDBASE BYTE 2)
MYHOST#)
[PUTPUPBYTE PUP (\ADDBASE BYTE 3)
(COND
(DYING \RT.INFINITY)
(T (fetch (ROUTING RTHOPCOUNT) of NETWORK]
(SETQ BYTE (\ADDBASE BYTE 4]
(replace (PUP PUPLENGTH) of PUP with (IPLUS \PUPOVLEN BYTE])
(\GATEWAY.FORWARD.PUP
[LAMBDA (PUP) (* bvm: "10-NOV-83 23:01")
(* * Pup forwarding for Interlisp gateways)
(PROG (CSUM NDB TRANSPORT)
(COND
([AND \PUP.CHECKSUMFLG (NEQ (SETQ CSUM (fetch PUPCHECKSUM of PUP))
MASKWORD1'S)
(NEQ CSUM (\CHECKSUM (fetch PUPCHECKSUMBASE of PUP)
(SUB1 (FOLDHI (fetch PUPLENGTH of PUP)
BYTESPERWORD]
(add \PUP.ROUTEDBAD 1)
(AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
NIL "Gateway: Discarding Pup with bad checksum: "))
(\PUPERROR PUP \PUPE.GATEWAY.BADPUP "Packet discarded because checksum bad"))
[(SETQ NDB (\ROUTE.PUP PUP T)) (* Update the hop count, rechecksum and transmit)
(SETQ TRANSPORT (fetch PUPTCONTROL of PUP))
(COND
((IGEQ (add TRANSPORT (CONSTANT (LLSH 1 4)))
(CONSTANT (LLSH 15 4)))
(add \PUP.ROUTEDBAD 1)
(AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
NIL "Gateway: Discarding looping Pup: "))
(\PUPERROR PUP \PUPE.LOOPED "Discarding Pup because too many gateway hops"))
(T (BITBLT (SCREENBITMAP)
0 0 (SCREENBITMAP)
0 0 16 16 (QUOTE INVERT)
(QUOTE REPLACE))
[COND
((AND \PUP.CHECKSUMFLG (NEQ CSUM MASKWORD1'S))
(replace PUPCHECKSUM of PUP
with (\UPDATECHECKSUM CSUM (fetch PUPTCONTROL of PUP)
TRANSPORT
(IDIFFERENCE (FOLDLO (SUB1 (fetch PUPLENGTH
of PUP))
BYTESPERWORD)
(PROG1 1
(* (INDEXF (fetch PUPTCONTROL of PUP)))]
(replace PUPTCONTROL of PUP with TRANSPORT)
(add \PUP.ROUTEDPUPS 1)
(replace EPREQUEUE of PUP with (QUOTE FREE))
(AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUT)
NIL "Gateway: Forwarding Pup: "))
(TRANSMIT.ETHERPACKET NDB PUP)
(BLOCK)
(BITBLT (SCREENBITMAP)
0 0 (SCREENBITMAP)
0 0 16 16 (QUOTE INVERT)
(QUOTE REPLACE]
(T (add \PUP.ROUTEDBAD 1)
(AND PUPTRACEFLG (PRINTPUP PUP (QUOTE PUP)
NIL "Gateway: Discarding Pup addressed to wrong gateway: "))
(\PUPERROR PUP \PUPE.WRONG.GATEWAY
"Packet discarded because I'm not the gateway you want"])
(\UPDATECHECKSUM
[LAMBDA (OLDCSUM OLDWORD NEWWORD #AFTERWORDS) (* bvm: "10-NOV-83 23:03")
(* * Compute a new checksum from OLDCSUM that results from changing OLDWORD to NEWWORD when there are #AFTERWORDS
after the changed word)
(* * (ONESCOMPLEMENTADD OLDCSUM (LEFTCYCLE (ONESCOMPLEMENTSUBTRACT NEWWORD OLDWORD) #AFTERWORDS)))
MASKWORD1'S])
(\HANDLE.PUP.ADDRLOOKUP
(LAMBDA (MISCSOC PUP) (* ejs: " 6-AUG-83 07:07")
(* * Address lookup)
(DECLARE (GLOBALVARS \ETHERPORTS))
(PROG ((PORT (CONS (GETPUPWORD PUP 0)
(\MAKENUMBER (GETPUPWORD PUP 1)
(GETPUPWORD PUP 2))))
NAME)
(SETQ NAME (NetDirAddressLookup PORT))
(SWAPPUPPORTS PUP)
(COND
(NAME (* Found it!)
(replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
(PUTPUPSTRING PUP NAME)
(replace (PUP PUPTYPE) of PUP with \PT.ADDRRESPONSE))
(T (replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
(replace (PUP PUPTYPE) of PUP with \PT.NAME/ADDRERROR)))
(SENDPUP MISCSOC PUP)
(\RELEASE.ETHERPACKET PUP))))
(\HANDLE.PUP.ALTOTIMEREQ
[LAMBDA (MISCSOC PUP) (* bvm: "16-NOV-83 10:48")
(* * Alto time request)
(PROG [(DATA (fetch (PUP PUPCONTENTS) of PUP))
(TIME (ALTO.TO.LISP.DATE (IDATE]
(SWAPPUPPORTS PUP)
(replace TIMEPUPVALUEHI of DATA with (\HINUM TIME))
(replace TIMEPUPVALUELO of DATA with (\LONUM TIME))
(COND
((MINUSP \TimeZoneComp)
(replace TIMEPUPEASTP of DATA with T)
(replace TIMEPUPHOURS of DATA with (IMINUS \TimeZoneComp)))
(T (replace TIMEPUPEASTP of DATA with NIL)
(replace TIMEPUPHOURS of DATA with \TimeZoneComp)))
(replace TIMEPUPMINUTES of DATA with 0)
(replace TIMEPUPBEGINDST of DATA with \BeginDST)
(replace TIMEPUPENDDST of DATA with \EndDST)
(replace (PUP PUPTYPE) of PUP with \PT.ALTOTIMERESPONSE)
(replace (PUP PUPLENGTH) of PUP with (CONSTANT (IPLUS \PUPOVLEN \TIMEPUPLENGTH)))
(SENDPUP MISCSOC PUP)
(\RELEASE.ETHERPACKET PUP])
(\HANDLE.PUP.MISC
(LAMBDA (MISCSOC PUP) (* ejs: " 6-AUG-83 07:53")
(* * Handle a request for miscellaneous services)
(SELECTC (fetch (PUP PUPTYPE) of PUP)
(\PT.NAMELOOKUP (\HANDLE.PUP.NAMELOOKUP MISCSOC PUP))
(\PT.ADDRLOOKUP (\HANDLE.PUP.ADDRLOOKUP MISCSOC PUP))
(\PT.ALTOTIMEREQUEST (\HANDLE.PUP.ALTOTIMEREQ MISCSOC PUP))
NIL)))
(\HANDLE.PUP.MISC.BACKGROUND
(LAMBDA (MISCSOCKET) (* edited: " 9-AUG-83 09:19")
(* * Background processing for the miscserver)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(* * Check for a new version of the pup-network.directory having arrived while we were sleeping)
(COND
((IGREATERP (FILENAMEFIELD (INFILEP (QUOTE {DSK}PUP-NETWORK.DIRECTORY))
(QUOTE VERSION))
(FILENAMEFIELD (fetch (STREAM FULLFILENAME) of NETDIRSTREAM)
(QUOTE VERSION)))
(CLOSEF NETDIRSTREAM)
(SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
(QUOTE INPUT)
(QUOTE OLD))))))))
(\HANDLE.PUP.NAMELOOKUP
(LAMBDA (MISCSOC PUP) (* ejs: " 6-AUG-83 07:07")
(* * Name lookup)
(DECLARE (GLOBALVARS \ETHERPORTS))
(PROG ((NAME (GETPUPSTRING PUP))
PORTS)
(SETQ PORTS (OR (GETHASH (MKATOM NAME)
\ETHERPORTS)
(PUTHASH (MKATOM NAME)
(NetDirNameLookup NAME)
\ETHERPORTS)))
(SWAPPUPPORTS PUP)
(COND
(PORTS (* Found it!)
(bind (I ← 0) for PORT in PORTS
do (PUTPUPWORD PUP I (CAR PORT))
(PUTPUPWORD PUP (ADD1 I)
(\HINUM (CDR PORT)))
(PUTPUPWORD PUP (IPLUS I 2)
(\LONUM (CDR PORT)))
(SETQ I (\ADDBASE I 3))
finally (replace (PUP PUPLENGTH) of PUP with (IPLUS \PUPOVLEN (LLSH I 1)))
(replace (PUP PUPTYPE) of PUP with \PT.NAMERESPONSE)))
(T (replace (PUP PUPLENGTH) of PUP with \PUPOVLEN)
(replace (PUP PUPTYPE) of PUP with \PT.NAME/ADDRERROR)))
(SENDPUP MISCSOC PUP)
(\RELEASE.ETHERPACKET PUP))))
(\HANDLE.PUP.ROUTING
[LAMBDA (PUP GATESOC) (* bvm: " 6-NOV-83 17:34")
(* * Handle a pup received on the gateway socket)
(SELECTC (fetch (PUP PUPTYPE) of PUP)
[\PT.GATEWAYRESPONSE (COND
((NEQ (fetch (PUP PUPSOURCE) of PUP)
\LOCALPUPNETHOST)
(\HANDLE.PUP.ROUTING.INFO PUP]
(\PT.GATEWAYREQUEST [COND
((AND (ZEROP (fetch (PUP PUPSOURCENET) of PUP))
(ZEROP (fetch (PUP PUPDESTHOST) of PUP)))
(replace (PUP PUPSOURCENET) of PUP with (fetch (PUP PUPDESTNET)
of PUP]
(\BUILD.PUP.ROUTING.PACKET PUP GATESOC T)
(SWAPPUPPORTS PUP)
(SENDPUP GATESOC PUP))
(COND
(PUPTRACEFLG (PRINTPUP PUP (QUOTE GET)
NIL "Gateway: Received non-gateway Pup on gateway socket"])
(\PUPGATESERVER
[LAMBDA NIL (* bvm: "13-NOV-83 00:19")
(PROG ((SOCKET (OPENPUPSOCKET \PUPSOCKET.ROUTING T))
(TIMER (SETUPTIMER 0))
PUP EVENT)
(RESETSAVE NIL (LIST (QUOTE \PUPGATESERVERDYING)
SOCKET))
(SETQ EVENT (PUPSOCKETEVENT SOCKET))
LP (COND
((SETQ PUP (GETPUP SOCKET))
(\HANDLE.PUP.ROUTING PUP)
(BLOCK))
((EQ (AWAIT.EVENT EVENT \RT.AGEINTERVAL)
EVENT) (* Waiting for pup to arrive or timer to expire--pup
arrived.)
(GO LP)))
(COND
((TIMEREXPIRED? TIMER)
(\AGE.ROUTING.TABLE \PUP.ROUTING.TABLE)
(SETUPTIMER \RT.AGEINTERVAL TIMER)
(\PUPGATE.BROADCAST SOCKET)))
(GO LP])
(\PUPGATESERVERDYING
[LAMBDA (SOCKET) (* bvm: "13-NOV-83 00:14")
(* Called when \PUPGATESERVER is deleted)
(COND
((NULL \GATEWAYFLG) (* Tell everyone we're not a gateway anymore)
(\PUPGATE.BROADCAST SOCKET T])
(\PUPGATE.BROADCAST
[LAMBDA (SOCKET DYING) (* bvm: "13-NOV-83 00:14")
(* * Broadcast our routing table. If DYING, say we are maxhops away)
(PROG ((PUP (ALLOCATE.PUP))) (* NOTE: this code is wrong if our routing table doesn't
fit in one pup!)
(\BUILD.PUP.ROUTING.PACKET PUP SOCKET NIL DYING)
[\MAP.ROUTING.TABLE \PUP.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
(COND
((ZEROP (fetch (ROUTING RTHOPCOUNT) of NETWORK))
(replace (PUP PUPDESTNET) of PUP with (fetch (ROUTING RTNET#)
of NETWORK))
(replace (PUP PUPSOURCENET) of PUP with (fetch (ROUTING RTNET#)
of NETWORK))
(SENDPUP SOCKET PUP)
(BLOCK]
(\RELEASE.ETHERPACKET PUP])
(\PUPMISCSERVER
[LAMBDA NIL (* bvm: "14-SEP-83 15:15")
(* * The miscsellaneous services socket)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG ((SOCKET (OPENPUPSOCKET \PUPSOCKET.MISCSERVICES T))
(TIMER (SETUPTIMER \PUP.MISC.BACKGROUND.INTERVAL))
EVENT PUP)
(SETQ EVENT (PUPSOCKETEVENT SOCKET))
(SETQ NETDIRSTREAM (OPENSTREAM (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
(QUOTE INPUT)
(QUOTE OLD)))
LP (COND
((SETQ PUP (GETPUP SOCKET))
(\HANDLE.PUP.MISC SOCKET PUP)
(BLOCK))
((EQ (AWAIT.EVENT EVENT TIMER T)
EVENT) (* Wait for a Pup)
(GO LP))
(T (\HANDLE.PUP.MISC.BACKGROUND SOCKET)
(SETUPTIMER \PUP.MISC.BACKGROUND.INTERVAL TIMER)))
(GO LP])
)
(RPAQQ \PUP.ROUTEDBAD 0)
(RPAQQ \PUP.ROUTEDPUPS 0)
(RPAQQ GATEWAYSERVICES (\PUP.ID.SERVER \PUPGATESERVER \NSGATESERVER \PUPMISCSERVER \NSTIMESERVER))
(* NS Gateway)
(DEFINEQ
(\GATEWAY.FORWARD.XIP
[LAMBDA (XIP) (* bvm: "10-NOV-83 23:01")
(* * XIP forwarding for Interlisp gateways)
(PROG (CSUM NDB TRANSPORT)
(COND
([AND \NS.CHECKSUMFLG (NEQ (SETQ CSUM (fetch XIPCHECKSUM of XIP))
MASKWORD1'S)
(NEQ CSUM (\CHECKSUM (fetch XIPCHECKSUMBASE of XIP)
(SUB1 (FOLDHI (fetch XIPLENGTH of XIP)
BYTESPERWORD]
(add \XIP.ROUTEDBAD 1)
(AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
NIL "Gateway: Discarding XIP with bad checksum: "))
(\XIPERROR XIP \XIPE.GATEWAY.CHECKSUM))
[(SETQ NDB (\ROUTE.XIP XIP T)) (* Update the hop count, rechecksum and transmit)
(SETQ TRANSPORT (fetch XIPTCONTROL of XIP))
(COND
((IGEQ (add TRANSPORT 1)
15)
(add \XIP.ROUTEDBAD 1)
(AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
NIL "Gateway: Discarding looping XIP: "))
(\XIPERROR XIP \XIPE.LOOPED))
(T (BITBLT (SCREENBITMAP)
0 0 (SCREENBITMAP)
0 0 16 16 (QUOTE INVERT)
(QUOTE REPLACE))
[COND
((AND \NS.CHECKSUMFLG (NEQ CSUM MASKWORD1'S))
(replace XIPCHECKSUM of XIP
with (\UPDATECHECKSUM CSUM (fetch XIPTCONTROL of XIP)
TRANSPORT
(IDIFFERENCE (FOLDLO (SUB1 (fetch XIPLENGTH
of XIP))
BYTESPERWORD)
(PROG1 2
(* (INDEXF (fetch XIPTCONTROL of XIP)))]
(replace XIPTCONTROL of XIP with TRANSPORT)
(add \XIP.ROUTEDGOOD 1)
(replace EPREQUEUE of XIP with (QUOTE FREE))
(AND XIPTRACEFLG (PRINTXIP XIP (QUOTE PUT)
NIL "Gateway: Forwarding XIP: "))
(TRANSMIT.ETHERPACKET NDB XIP)
(BLOCK)
(BITBLT (SCREENBITMAP)
0 0 (SCREENBITMAP)
0 0 16 16 (QUOTE INVERT)
(QUOTE REPLACE]
(T (add \XIP.ROUTEDBAD 1)
(AND XIPTRACEFLG (PRINTXIP XIP (QUOTE XIP)
NIL "Gateway: Discarding XIP addressed to wrong gateway: "))
(\XIPERROR XIP \XIPE.NOROUTE])
(\NSGATESERVER
[LAMBDA NIL (* bvm: "13-NOV-83 00:19")
(PROG ((SOCKET (OPENNSOCKET \NS.WKS.RoutingInformation T))
(TIMER (SETUPTIMER 0))
XIP EVENT)
(RESETSAVE NIL (LIST (QUOTE \NSGATESERVERDYING)
SOCKET))
(SETQ EVENT (NSOCKETEVENT SOCKET))
LP (COND
((SETQ XIP (GETXIP SOCKET))
(\HANDLE.NS.ROUTING XIP)
(BLOCK))
((EQ (AWAIT.EVENT EVENT \RT.AGEINTERVAL)
EVENT) (* Waiting for pup to arrive or timer to expire--pup
arrived.)
(GO LP)))
(COND
((TIMEREXPIRED? TIMER)
(\AGE.ROUTING.TABLE \XIP.ROUTING.TABLE)
(SETUPTIMER \RT.AGEINTERVAL TIMER)
(\NSGATE.BROADCAST SOCKET)))
(GO LP])
(\NSGATESERVERDYING
[LAMBDA (SOCKET) (* bvm: "13-NOV-83 00:16")
(* Called when \NSGATESERVER is deleted)
(COND
((NULL \GATEWAYFLG) (* Tell everyone we're not a gateway anymore)
(\NSGATE.BROADCAST SOCKET T])
(\NSGATE.BROADCAST
[LAMBDA (SOCKET DYING) (* bvm: "13-NOV-83 00:19")
(PROG ((XIP (ALLOCATE.XIP))) (* Note: wrong if our routing table takes up more than
one packet)
(\BUILD.NS.ROUTING.PACKET XIP SOCKET NIL DYING)
[\MAP.ROUTING.TABLE \NS.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
(COND
((ZEROP (fetch (ROUTING RTHOPCOUNT) of NETWORK))
(replace (XIP XIPDESTNET) of XIP with (fetch (ROUTING RTNET#)
of NETWORK))
(replace (XIP XIPSOURCENET) of XIP with (fetch (ROUTING RTNET#)
of NETWORK))
(SENDXIP SOCKET XIP)
(BLOCK]
(\RELEASE.ETHERPACKET XIP])
(\BUILD.NS.ROUTING.PACKET
[LAMBDA (XIP GATESOC OLDXIPFLG DYING) (* bvm: "16-Dec-83 14:14")
(* * Create a routing info XIP to be broadcast over all networks or as a reply to a routing request)
(PROG ((BASE (fetch XIPCONTENTS of XIP))
(LENGTH (ADD1 \XIPOVLEN)))
(replace XIPTYPE of XIP with \XIPT.ROUTINGINFO)
(COND
((NOT OLDXIPFLG)
(replace XIPSOURCENSADDRESS of XIP with (\LOCALNSADDRESS))
(replace XIPSOURCESOCKET of XIP with (fetch (NSOCKET ID#) of GATESOC))
(replace XIPDESTHOST of XIP with BROADCASTNSHOSTNUMBER)
(replace XIPDESTNET of XIP with 0)
(replace XIPDESTSOCKET of XIP with \NS.WKS.RoutingInformation)))
(\PUTBASE BASE 0 \XROUTINGINFO.OP.RESPONSE)
(SETQ BASE (\ADDBASE BASE 1))
[\MAP.ROUTING.TABLE \NS.ROUTING.TABLE (FUNCTION (LAMBDA (NETWORK)
(replace (NSROUTINGINFO NET#) of BASE with (fetch (ROUTING RTNET#)
of NETWORK))
[replace (NSROUTINGINFO #HOPS) of BASE
with (COND
(DYING \RT.INFINITY)
(T (ADD1 (fetch (ROUTING RTHOPCOUNT) of NETWORK]
(SETQ BASE (\ADDBASE BASE \NS.ROUTINGINFO.WORDS))
(add LENGTH (UNFOLD \NS.ROUTINGINFO.WORDS BYTESPERWORD]
(replace (XIP XIPLENGTH) of XIP with LENGTH])
(\HANDLE.NS.ROUTING
[LAMBDA (XIP GATESOC) (* bvm: " 6-NOV-83 18:06")
(* * Handle a XIP received on the gateway socket)
(SELECTC (AND (EQ (fetch (XIP XIPTYPE) of XIP)
\XIPT.ROUTINGINFO)
(fetch XIPFIRSTDATAWORD of XIP))
[\XROUTINGINFO.OP.RESPONSE (COND
((EQNSHOSTNUMBER (fetch (XIP XIPSOURCEHOST) of XIP)
(\LOCALNSHOSTNUMBER))
(RELEASE.XIP XIP))
(T (\HANDLE.NS.ROUTING.INFO XIP]
(\XROUTINGINFO.OP.REQUEST [COND
((AND (ZEROP (fetch (XIP XIPSOURCENET) of XIP))
(ZEROP (fetch (XIP XIPDESTHOST) of XIP)))
(replace (XIP XIPSOURCENET) of XIP
with (fetch (XIP XIPDESTNET) of XIP]
(SWAPXIPADDRESSES XIP)
(\BUILD.NS.ROUTING.PACKET XIP GATESOC T)
(SENDXIP GATESOC XIP))
(PROGN (COND
(XIPTRACEFLG (PRINTXIP XIP (QUOTE GET)
NIL
"Gateway: Received non-gateway Pup on gateway socket")))
(RELEASE.XIP XIP])
)
(RPAQQ \XIP.ROUTEDBAD 0)
(RPAQQ \XIP.ROUTEDGOOD 0)
(DEFINEQ
(\NSTIMESERVER
[LAMBDA NIL (* bvm: "26-May-84 14:43")
(PROG ((SOCKET (OPENNSOCKET \TIMESOCKET T))
EVENT XIP)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
SOCKET))
(SETQ EVENT (NSOCKETEVENT SOCKET))
LP (COND
((SETQ XIP (GETXIP SOCKET))
(\HANDLE.NS.TIMEREQ SOCKET XIP)
(BLOCK))
(T (* Wait for a XIP)
(AWAIT.EVENT EVENT)))
(GO LP])
(\HANDLE.NS.TIMEREQ
[LAMBDA (SOCKET XIP) (* bvm: "26-May-84 14:42")
(DECLARE (GLOBALVARS \BeginDST \EndDST \TimeZoneComp))
(PROG (DAYTIME0 BUF LENGTH)
(SELECTC (fetch (XIP XIPTYPE) of XIP)
(\XIPT.EXCHANGE (* Official NS time protocol)
[COND
((OR (NEQ (fetch PACKETEXCHANGETYPE
of (SETQ BUF (fetch XIPCONTENTS of XIP)))
\EXTYPE.TIME)
(NEQ (fetch TIMEVERSION of BUF)
\TIMEVERSION))
(* Looking for client type Time and same version as we
implement)
(RETURN (RELEASE.XIP XIP]
(SETQ LENGTH (IPLUS \NSTIMELENGTH \XIPOVLEN)))
(\XIPT.OLDTIME (* Old format, omits client type and version)
(SETQ BUF (\ADDBASE (fetch XIPCONTENTS of XIP)
-2))
(SETQ LENGTH (IPLUS \NSTIMELENGTH \XIPOVLEN -4)))
(RELEASE.XIP XIP))
(SELECTC (fetch TIMEOP of BUF)
(\TIMEOP.TIMEREQUEST [replace TIMEVALUEHI of BUF
with (\HINUM (SETQ DAYTIME0 (\DAYTIME0 (\CREATECELL \FIXP]
(replace TIMEVALUELO of BUF with (\LONUM DAYTIME0))
(replace TIMEZONEHOURS of BUF
with (COND
((ILESSP \TimeZoneComp 0)
(replace TIMEZONESIGN of BUF with 1)
(IMINUS \TimeZoneComp))
(T (replace TIMEZONESIGN of BUF with 0)
\TimeZoneComp)))
(replace TIMEBEGINDST of BUF with \BeginDST)
(replace TIMEENDDST of BUF with \EndDST)
(replace TIMEOP of BUF with \TIMEOP.TIMERESPONSE)
(replace XIPLENGTH of XIP with LENGTH)
(SWAPXIPADDRESSES XIP)
(SENDXIP SOCKET XIP))
(RELEASE.XIP XIP])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \TIMESOCKET 8)
(RPAQQ \XIPT.EXCHANGE 4)
(RPAQQ \EXTYPE.TIME 1)
(RPAQQ \XIPT.OLDTIME 123)
(RPAQQ \TIMEVERSION 2)
(RPAQQ \TIMEOP.TIMEREQUEST 1)
(RPAQQ \TIMEOP.TIMERESPONSE 2)
(RPAQQ \NSTIMELENGTH 24)
(RPAQQ \XIPOVLEN 30)
(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \XIPT.OLDTIME \TIMEVERSION \TIMEOP.TIMEREQUEST
\TIMEOP.TIMERESPONSE \NSTIMELENGTH \XIPOVLEN)
)
[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))))
]
)
(* Utilities for handling lookup requests)
(DEFINEQ
(AddressFromEntry
(LAMBDA (ADDRESS) (* ejs: " 5-AUG-83 15:31")
(* * Given the address of an entry block in the network directory, return the address of the address block in the
directory)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(COND
(ADDRESS (SETFILEPTR NETDIRSTREAM (LLSH (ADD1 ADDRESS)
1))
(WORDIN NETDIRSTREAM)))))
(BCPLStringFromFile
(LAMBDA (STREAM) (* ejs: " 5-AUG-83 11:34")
(* * Produce a string from the BCPL string in STREAM starting at current place in file)
(PROG ((STRING (ALLOCSTRING (BIN STREAM))))
(\BINS STREAM (fetch (STRINGP BASE) of STRING)
(fetch (STRINGP OFFST) of STRING)
(fetch (STRINGP LENGTH) of STRING))
(RETURN STRING))))
(LOADBITS
[LAMBDA (INTEGERLST RIGHTBIT SIZE) (* ejs: "14-SEP-83 13:15")
(PROG (INTEGER WHICH REALBIT OVERFLOW)
[SETQ INTEGER (CAR (FNTH (REVERSE INTEGERLST)
(ADD1 (SETQ WHICH (IQUOTIENT RIGHTBIT 16]
(SETQ REALBIT (IDIFFERENCE RIGHTBIT (ITIMES 16 WHICH)))
(RETURN (COND
[(NOT (IGEQ (SETQ OVERFLOW (IDIFFERENCE (IPLUS REALBIT (SUB1 SIZE))
16))
0))
(LOGAND (LRSH INTEGER REALBIT)
(SUB1 (EXPT 2 SIZE]
(T (LOGOR (LOGAND (LRSH INTEGER REALBIT)
(SUB1 (EXPT 2 SIZE)))
(LLSH (LOADBITS INTEGERLST (ITIMES 16 (ADD1 WHICH))
(ADD1 OVERFLOW))
(IDIFFERENCE 16 REALBIT])
(MAKEOCTALSTRING
[LAMBDA (WORDS) (* ejs: "14-SEP-83 13:29")
(* * Convert three 16 bit words to an octal string)
(PROG ((STRING (ALLOCSTRING 16)))
[for B from 0 to 47 by 3 as I from 1 do (\PUTBASEBYTE (fetch (STRINGP BASE) of STRING)
(IPLUS (fetch (STRINGP OFFST)
of STRING)
(IDIFFERENCE 16 I))
(IPLUS (CHARCODE 0)
(LOADBITS WORDS B 3]
(for C instring STRING as I from 1 until (NEQ (CHARCODE 0)
C)
finally (SUBSTRING STRING I NIL STRING))
(RETURN STRING])
(NameFromAddress
[LAMBDA (ADDRESS ONEFLG) (* bvm: "10-NOV-83 23:07")
(* * Given the address of an address block, return a name like ETHERHOSTNAME would)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (SOCKET NET/HOST (ADDRESSLIST (CONS)))
(COND
((NULL ADDRESS)
(RETURN)))
LOOP[COND
((AND (NUMBERP ADDRESS)
(NOT (ZEROP ADDRESS)))
(SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDRESS 1)
4))
(SETQ NET/HOST (WORDIN NETDIRSTREAM))
(SETQ SOCKET (\MAKENUMBER (WORDIN NETDIRSTREAM)
(WORDIN NETDIRSTREAM)))
(TCONC ADDRESSLIST (CONS NET/HOST SOCKET))
(SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
(SETQ ADDRESS (WORDIN NETDIRSTREAM)))
(T (RETURN (CAR ADDRESSLIST]
(COND
(ONEFLG (RETURN (CAR ADDRESSLIST)))
(T (GO LOOP])
(NetDirAddressLookup
(LAMBDA (PORT) (* ejs: " 6-AUG-83 06:51")
(* * Digest a pup network directory and lookup a port)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (ENTRYADDRESS ADDRBLOCKCNT ADDRBLOCKTABLE)
(COND
((OR (NULL NETDIRSTREAM)
(NOT (OPENP NETDIRSTREAM)))
(SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
(QUOTE INPUT)
(QUOTE OLD))
(QUOTE INPUT)))))
(SETFILEPTR NETDIRSTREAM 4)
(SETQ ADDRBLOCKCNT (WORDIN NETDIRSTREAM))
(SETQ ADDRBLOCKTABLE (WORDIN NETDIRSTREAM))
(RETURN (NameFromEntry (SearchNetDirForAddress PORT ADDRBLOCKTABLE ADDRBLOCKCNT))))))
(NetDirNameLookup
(LAMBDA (NAME) (* ejs: " 6-AUG-83 06:09")
(* * Digest a pup network directory and lookup a name)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (ENTRYADDRESS (NAMEBLOCKCNT (CREATECELL \FIXP))
(NAMEBLOCKTABLE (CREATECELL \FIXP)))
(COND
((OR (NULL NETDIRSTREAM)
(NOT (OPENP NETDIRSTREAM)))
(SETQ NETDIRSTREAM (GETSTREAM (OPENFILE (QUOTE {DSK}PUP-NETWORK.DIRECTORY)
(QUOTE INPUT)
(QUOTE OLD))
(QUOTE INPUT)))))
(SETQ NAMEBLOCKCNT (WORDCONTENTS (MAPWORD 0 NETDIRSTREAM)))
(SETQ NAMEBLOCKTABLE (WORDCONTENTS (MAPWORD 1 NETDIRSTREAM)))
(RETURN (PortFromAddress (AddressFromEntry (SearchNetDirForName NAME NAMEBLOCKTABLE
NAMEBLOCKCNT)))))))
(PortCompare
(LAMBDA (PORT1 PORT2) (* ejs: " 6-AUG-83 06:22")
(* * Compare two ports for equality. A port is a (NET/HOST . SOCKET) dotted pair)
(COND
((ILESSP (CAR PORT1)
(CAR PORT2))
(QUOTE LESS))
((IGREATERP (CAR PORT1)
(CAR PORT2))
(QUOTE GREATER))
((ILESSP (CDR PORT1)
(CDR PORT2))
(QUOTE LESS))
((IGREATERP (CDR PORT1)
(CDR PORT2))
(QUOTE GREATER))
(T (QUOTE EQ)))))
(PortFromAddress
(LAMBDA (ADDRESS ONEFLG) (* ejs: " 6-AUG-83 06:37")
(* * Given the address of an address block, return a port, like ETHERPORT would)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (SOCKET NET/HOST (ADDRESSLIST (CONS)))
(COND
((NULL ADDRESS)
(RETURN)))
LOOP(COND
((AND (NUMBERP ADDRESS)
(NOT (ZEROP ADDRESS)))
(SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDRESS 1)
4))
(SETQ NET/HOST (WORDIN NETDIRSTREAM))
(SETQ SOCKET (\MAKENUMBER (WORDIN NETDIRSTREAM)
(WORDIN NETDIRSTREAM)))
(TCONC ADDRESSLIST (CONS NET/HOST SOCKET))
(SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
(SETQ ADDRESS (WORDIN NETDIRSTREAM)))
(T (RETURN (CAR ADDRESSLIST))))
(COND
(ONEFLG (RETURN (CAAR ADDRESSLIST)))
(T (GO LOOP))))))
(PrintNameBlock
(LAMBDA (A)
(DECLARE (GLOBALVARS NETDIRSTREAM)) (* ejs: " 6-AUG-83 19:18")
(SETFILEPTR NETDIRSTREAM (IPLUS (LLSH A 1)
4))
(PRINT (BCPLStringFromFile NETDIRSTREAM))))
(SearchNetDirForAddress
(LAMBDA (PORT BLOCK LENGTH) (* ejs: " 6-AUG-83 06:57")
(* * Binary search for name in the name block)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (PORT1 PROBE ADDR DONE (BOTTOM 0)
(TOP (SUB1 LENGTH)))
(until (OR (AND (EQ (IDIFFERENCE TOP BOTTOM)
1)
(NOT (EQUAL PORT PORT1)))
DONE)
eachtime (SETQ PROBE (LRSH (IPLUS TOP BOTTOM)
1))
do (SETFILEPTR NETDIRSTREAM (LLSH (IPLUS PROBE BLOCK)
1))
(SETQ ADDR (WORDIN NETDIRSTREAM))
(SETQ PORT1 (PortFromAddress ADDR T))
(SELECTQ (PortCompare PORT PORT1)
(EQ (SETQ DONE T))
(LESS (SETQ TOP PROBE))
(SETQ BOTTOM PROBE)))
(RETURN (COND
(DONE (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
2))
(WORDIN NETDIRSTREAM))
(T NIL))))))
(SearchNetDirForName
(LAMBDA (NAME BLOCK LENGTH) (* ejs: " 6-AUG-83 19:34")
(* * Binary search for name in the name block)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(PROG (STRING PROBE ADDR DONE (BOTTOM 0)
(TOP (SUB1 LENGTH)))
(bind FAIL? FAIL until (OR FAIL DONE) eachtime (SETQ PROBE (LRSH (IPLUS TOP BOTTOM)
1))
do (SETFILEPTR NETDIRSTREAM (LLSH (IPLUS PROBE BLOCK)
1))
(SETQ ADDR (WORDIN NETDIRSTREAM))
(SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
4))
(SETQ STRING (BCPLStringFromFile NETDIRSTREAM))
(COND
(FAIL? (SETQ FAIL T)))
(SELECTQ (StringCompare NAME STRING)
(EQ (SETQ DONE T))
(LESS (COND
((EQ TOP PROBE)
(SETQ TOP BOTTOM)
(SETQ FAIL? T))
(T (SETQ TOP PROBE))))
(COND
((EQ BOTTOM PROBE)
(SETQ BOTTOM TOP)
(SETQ FAIL? T))
(T (SETQ BOTTOM PROBE)))))
(RETURN (COND
(DONE (SETFILEPTR NETDIRSTREAM (IPLUS (LLSH ADDR 1)
2))
(WORDIN NETDIRSTREAM))
(T NIL))))))
(StringCompare
[LAMBDA (S1 S2) (* bvm: "28-OCT-83 16:29")
(PROG (S1BASE S1LEN S1OFFSET S2BASE S2LEN S2OFFSET C1 C2)
[COND
((LITATOM S1)
(SETQ S1BASE (fetch (LITATOM PNAMEBASE) of S1))
(SETQ S1OFFSET 1)
(SETQ S1LEN (fetch (LITATOM PNAMELENGTH) of S1)))
(T (OR (STRINGP S1)
(SETQ S1 (MKSTRING S1)))
(SETQ S1BASE (fetch (STRINGP BASE) of S1))
(SETQ S1OFFSET (fetch (STRINGP OFFST) of S1))
(SETQ S1LEN (fetch (STRINGP LENGTH) of S1]
[COND
((LITATOM S2)
(SETQ S2BASE (fetch (LITATOM PNAMEBASE) of S2))
(SETQ S2OFFSET 1)
(SETQ S2LEN (fetch (LITATOM PNAMELENGTH) of S2)))
(T (OR (STRINGP S2)
(SETQ S2 (MKSTRING S2)))
(SETQ S2BASE (fetch (STRINGP BASE) of S2))
(SETQ S2OFFSET (fetch (STRINGP OFFST) of S2))
(SETQ S2LEN (fetch (STRINGP LENGTH) of S2]
(RETURN (for I from 0 do (COND
[(IGEQ I S1LEN)
(RETURN (COND
((EQ S1LEN S2LEN)
(QUOTE EQ))
(T (QUOTE LESS]
((IGEQ I S2LEN)
(RETURN (QUOTE GREATER)))
[(EQ (SETQ C1 (\GETBASEBYTE S1BASE (IPLUS I S1OFFSET)))
(SETQ C2 (\GETBASEBYTE S2BASE (IPLUS I S2OFFSET]
(T [COND
((AND (IGEQ C1 (CHARCODE a))
(ILEQ C1 (CHARCODE z)))
(SETQ C1 (IDIFFERENCE C1 (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
[COND
((AND (IGEQ C2 (CHARCODE a))
(ILEQ C2 (CHARCODE z)))
(SETQ C2 (IDIFFERENCE C2 (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
(COND
((EQ C1 C2))
((ILESSP C1 C2)
(RETURN (QUOTE LESS)))
(T (RETURN (QUOTE GREATER])
)
(* Currently unused)
(DEFINEQ
(MapNameTable
(LAMBDA (FN)
(DECLARE (GLOBALVARS NETDIRSTREAM)) (* ejs: " 6-AUG-83 19:15")
(PROG (NAMEBLOCKTABLE NAMEBLOCKCNT)
(SETFILEPTR NETDIRSTREAM 0)
(SETQ NAMEBLOCKCNT (WORDIN NETDIRSTREAM))
(SETQ NAMEBLOCKTABLE (WORDIN NETDIRSTREAM))
(for I from 1 to NAMEBLOCKCNT
do (SETFILEPTR NETDIRSTREAM (LLSH NAMEBLOCKTABLE 1))
(APPLY FN (LIST (WORDIN NETDIRSTREAM)))
(SETQ NAMEBLOCKTABLE (ADD1 NAMEBLOCKTABLE))))))
(NameFromEntry
(LAMBDA (ADDRESS) (* ejs: " 6-AUG-83 06:29")
(* * Given the address of an entry block, return the primary name)
(DECLARE (GLOBALVARS NETDIRSTREAM))
(COND
(ADDRESS (SETFILEPTR NETDIRSTREAM (LLSH ADDRESS 1))
(SETFILEPTR NETDIRSTREAM (LLSH (IPLUS (WORDIN NETDIRSTREAM)
2)
1))
(BCPLStringFromFile NETDIRSTREAM)))))
)
(RPAQ? \GATEWAYFLG )
(RPAQ? \PUP.MISC.BACKGROUND.INTERVAL 300000)
(RPAQ? EXTRA10MBTRANSLATIONLST )
(RPAQ? LOCALNETWORKLST )
(RPAQ GATEWAYCURSOR (CURSORCREATE (READBITMAP) 0 15))
(16 16
"@@@@"
"OOOO"
"OOOO"
"D@@@"
"DOO@"
"DHA@"
"GJM@"
"@HA@"
"@HAN"
"@HAB"
"@OOB"
"@@@B"
"OOOO"
"OOOO"
"@@@@"
"@@@@")(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \TIMEPUPLENGTH 10)
(CONSTANTS \TIMEPUPLENGTH)
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD PUPROUTINGINFO ( (* Format of each entry in a pup routing info packet.
We only actually use NET# and #HOPS)
(NET# BYTE)
(GATENET# BYTE)
(GATEHOST# BYTE)
(#HOPS BYTE)))
(BLOCKRECORD TIMEPUPCONTENTS ((TIMEPUPVALUEHI WORD)
(TIMEPUPVALUELO WORD)
(TIMEPUPEASTP FLAG)
(TIMEPUPHOURS BITS 7)
(TIMEPUPMINUTES BITS 8)
(TIMEPUPBEGINDST WORD)
(TIMEPUPENDDST WORD)) (* format of alto time response)
)
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \PUP.ROUTEDBAD \PUP.ROUTEDPUPS \XIP.ROUTEDBAD \XIP.ROUTEDGOOD)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \BeginDST \EndDST \TimeZoneComp)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS WORDIN DMACRO (= . \WIN))
(PUTPROPS WORDOUT DMACRO (= . \WOUT))
)
(FILESLOAD (SOURCE)
ETHERRECORDS)
(FILESLOAD (LOADCOMP)
LLETHER LLNS)
)
(FILESLOAD PUPIDSERVER)
(PUTPROPS GATEWAY COPYRIGHT ("Schlumberger Technology Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2343 7229 (GATEWAY 2353 . 3798) (GATEWAY.BYE 3800 . 4247) (\INIT.GATEWAY 4249 . 7227))
(7254 19316 (\BUILD.PUP.ROUTING.PACKET 7264 . 8289) (\GATEWAY.FORWARD.PUP 8291 . 10673) (
\UPDATECHECKSUM 10675 . 11084) (\HANDLE.PUP.ADDRLOOKUP 11086 . 11958) (\HANDLE.PUP.ALTOTIMEREQ 11960
. 13160) (\HANDLE.PUP.MISC 13162 . 13603) (\HANDLE.PUP.MISC.BACKGROUND 13605 . 14304) (
\HANDLE.PUP.NAMELOOKUP 14306 . 15457) (\HANDLE.PUP.ROUTING 15459 . 16338) (\PUPGATESERVER 16340 .
17164) (\PUPGATESERVERDYING 17166 . 17546) (\PUPGATE.BROADCAST 17548 . 18447) (\PUPMISCSERVER 18449 .
19314)) (19505 26282 (\GATEWAY.FORWARD.XIP 19515 . 21708) (\NSGATESERVER 21710 . 22534) (
\NSGATESERVERDYING 22536 . 22913) (\NSGATE.BROADCAST 22915 . 23719) (\BUILD.NS.ROUTING.PACKET 23721 .
25190) (\HANDLE.NS.ROUTING 25192 . 26280)) (26344 28800 (\NSTIMESERVER 26354 . 26877) (
\HANDLE.NS.TIMEREQ 26879 . 28798)) (30158 40467 (AddressFromEntry 30168 . 30595) (BCPLStringFromFile
30597 . 31051) (LOADBITS 31053 . 31768) (MAKEOCTALSTRING 31770 . 32470) (NameFromAddress 32472 . 33360
) (NetDirAddressLookup 33362 . 34132) (NetDirNameLookup 34134 . 34978) (PortCompare 34980 . 35481) (
PortFromAddress 35483 . 36376) (PrintNameBlock 36378 . 36618) (SearchNetDirForAddress 36620 . 37514) (
SearchNetDirForName 37516 . 38634) (StringCompare 38636 . 40465)) (40497 41483 (MapNameTable 40507 .
41026) (NameFromEntry 41028 . 41481)))))
STOP