(FILECREATED "22-Apr-85 14:18:32" {ERIS}<LISPCORE>LIBRARY>TCPLLAR.;2 9992
changes to: (VARS TCPLLARCOMS)
(RECORDS ARETHER)
(FNS \AR.NOTE.RESOLUTION \HANDLE.RAW.AR)
previous date: "15-Apr-85 16:55:25" {ERIS}<LISPCORE>LIBRARY>TCPLLAR.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPLLARCOMS)
(RPAQQ TCPLLARCOMS ((COMS (* * IP Ethernet address translation module)
(DECLARE: DONTCOPY (EXPORT (RECORDS AR ARETHER AREXPETHER)
(CONSTANTS (\AR.HARDWARE.SPACE.ETHERNET 1)
(\AR.ETHERNET.ADDRESS.LENGTH 6)
(\AR.IP.ADDRESS.LENGTH 4)
(\AR.REQUEST 1)
(\AR.RESPONSE 2)
(\AR.ETHER.PACKET.LENGTH 28))))
(INITVARS (\AR.IP.TO.10MB.ALIST (CONS)))
(GLOBALVARS \AR.IP.TO.10MB.ALIST)
(FNS \AR.NOTE.RESOLUTION SPUTASSOC \AR.TRANSLATE.TO.10MB
\AR.REQUEST.IP.TO.10MB \AR.REQUEST.IP.TO.3MB \AR.RESOLVE
\AR.TRANSLATE.TO.3MB \HANDLE.RAW.AR))))
(* * IP Ethernet address translation module)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(ACCESSFNS AR ((ARBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM))))
(BLOCKRECORD ARBASE ((ARHARDWARESPACE WORD)
(ARPROTOCOLSPACE WORD)
(ARHARDWARELEN BYTE)
(ARPROTOCOLLEN BYTE)
(AROPCODE WORD)
(AR1STWORD WORD))
(ACCESSFNS AR1STWORD ((ARCONTENTS (LOCF DATUM))))))
(ACCESSFNS ARETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM)))
(BLOCKRECORD ARETHERBASE ((ARLCLHDW0 WORD)
(ARLCLHDW1 WORD)
(ARLCLHDW2 WORD)
(ARLCLPTCL FIXP)
(ARFRNHDW0 WORD)
(ARFRNHDW1 WORD)
(ARFRNHDW2 WORD)
(ARFRNPTCL FIXP))
(ACCESSFNS ARLCLHDW0 ((ARSENDERHDW (\LOADNSHOSTNUMBER (LOCF DATUM))
(\STORENSHOSTNUMBER (LOCF DATUM)
NEWVALUE))))
(ACCESSFNS ARFRNHDW0 ((ARTARGETHDW (\LOADNSHOSTNUMBER (LOCF DATUM))
(\STORENSHOSTNUMBER (LOCF DATUM)
NEWVALUE))))))
(ACCESSFNS AREXPETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM)))
(BLOCKRECORD ARETHERBASE ((ARLCLHDW WORD)
(ARLCLPTCL FIXP)
(ARFRNHDW WORD)
(ARFRNPTCL FIXP))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \AR.HARDWARE.SPACE.ETHERNET 1)
(RPAQQ \AR.ETHERNET.ADDRESS.LENGTH 6)
(RPAQQ \AR.IP.ADDRESS.LENGTH 4)
(RPAQQ \AR.REQUEST 1)
(RPAQQ \AR.RESPONSE 2)
(RPAQQ \AR.ETHER.PACKET.LENGTH 28)
(CONSTANTS (\AR.HARDWARE.SPACE.ETHERNET 1)
(\AR.ETHERNET.ADDRESS.LENGTH 6)
(\AR.IP.ADDRESS.LENGTH 4)
(\AR.REQUEST 1)
(\AR.RESPONSE 2)
(\AR.ETHER.PACKET.LENGTH 28))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \AR.IP.TO.10MB.ALIST (CONS))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \AR.IP.TO.10MB.ALIST)
)
(DEFINEQ
(\AR.NOTE.RESOLUTION
(LAMBDA (AR) (* ejs: "22-Apr-85 14:17")
(* * Add an address resolution to our database)
(COND
((NOT (AND (EQ (fetch (ARETHER ARLCLHDW0) of AR)
0)
(EQ (fetch (ARETHER ARLCLHDW1) of AR)
0)
(EQ (fetch (ARETHER ARLCLHDW2) of AR)
0)))
(SPUTASSOC (fetch (ARETHER ARLCLPTCL) of AR)
(fetch (ARETHER ARSENDERHDW) of AR)
\AR.IP.TO.10MB.ALIST)))
(COND
((AND (EQ (fetch (AR AROPCODE) of AR)
\AR.RESPONSE)
(NOT (AND (EQ (fetch (ARETHER ARFRNHDW0) of AR)
0)
(EQ (fetch (ARETHER ARFRNHDW1) of AR)
0)
(EQ (fetch (ARETHER ARFRNHDW2) of AR)
0))))
(SPUTASSOC (fetch (ARETHER ARFRNPTCL) of AR)
(fetch (ARETHER ARTARGETHDW) of AR)
\AR.IP.TO.10MB.ALIST)))))
(SPUTASSOC
[LAMBDA (KEY VAL ALIST) (* ejs: "27-Dec-84 17:52")
(PROG (OLDENTRY)
[COND
([SETQ OLDENTRY (for ENTRY in ALIST thereis (EQUAL KEY (CAR ENTRY]
(RPLACD OLDENTRY VAL))
(T (NCONC1 ALIST (CONS KEY VAL]
(RETURN VAL])
(\AR.TRANSLATE.TO.10MB
[LAMBDA (IPADDRESS) (* ejs: "27-Dec-84 16:17")
(* * Translate an IPADDRESS to a 10MBHOSTNUMBER, or initiate request and fail for now)
(COND
((\IP.BROADCAST.ADDRESS IPADDRESS)
BROADCASTNSHOSTNUMBER)
((CDR (SASSOC IPADDRESS \AR.IP.TO.10MB.ALIST)))
(T (\AR.REQUEST.IP.TO.10MB IPADDRESS)
NIL])
(\AR.REQUEST.IP.TO.10MB
[LAMBDA (IPADDRESS) (* ejs: "27-Dec-84 17:55")
(* * Broadcast a request for an address translation)
(PROG ((AR (\ALLOCATE.ETHERPACKET)))
(replace (AR ARHARDWARESPACE) of AR with \AR.HARDWARE.SPACE.ETHERNET)
(replace (AR ARPROTOCOLSPACE) of AR with \EPT.IP)
(replace (AR ARHARDWARELEN) of AR with \AR.ETHERNET.ADDRESS.LENGTH)
(replace (AR ARPROTOCOLLEN) of AR with \AR.IP.ADDRESS.LENGTH)
(replace (AR AROPCODE) of AR with \AR.REQUEST)
(replace (ARETHER ARSENDERHDW) of AR with \MY.NSHOSTNUMBER)
(replace (ARETHER ARLCLPTCL) of AR with (ffetch (NDB NDBIPHOST#) of \10MBLOCALNDB))
(replace (ARETHER ARFRNPTCL) of AR with IPADDRESS)
(ENCAPSULATE.ETHERPACKET \10MBLOCALNDB AR BROADCASTNSHOSTNUMBER \AR.ETHER.PACKET.LENGTH
\EPT.AR)
(COND
(IPTRACEFLG (PRINTPACKET AR (QUOTE PUT)
IPTRACEFILE)))
(TRANSMIT.ETHERPACKET \10MBLOCALNDB AR])
(\AR.REQUEST.IP.TO.3MB
(LAMBDA (IPADDRESS) (* ejs: " 2-Jan-85 17:12")
(* * Broadcast a request for an address translation)
(PROG ((AR (\ALLOCATE.ETHERPACKET)))
(replace (AR ARHARDWARESPACE) of AR with \AR.HARDWARE.SPACE.ETHERNET)
(replace (AR ARPROTOCOLSPACE) of AR with \EET.IP)
(replace (AR ARHARDWARELEN) of AR with 2)
(replace (AR ARPROTOCOLLEN) of AR with \AR.IP.ADDRESS.LENGTH)
(replace (AR AROPCODE) of AR with \AR.REQUEST)
(replace (AREXPETHER ARLCLHDW) of AR with (LOGAND \LOCALPUPNETHOST (MASK.1'S 0 8)))
(replace (AREXPETHER ARLCLPTCL) of AR with (ffetch (NDB NDBIPHOST#) of \3MBLOCALNDB))
(replace (AREXPETHER ARFRNPTCL) of AR with IPADDRESS)
(ENCAPSULATE.ETHERPACKET \3MBLOCALNDB AR 0 20 \EPT.AR)
(COND
(IPTRACEFLG (PRINTPACKET AR (QUOTE PUT)
IPTRACEFILE)))
(TRANSMIT.ETHERPACKET \3MBLOCALNDB AR))))
(\AR.RESOLVE
(LAMBDA (AR) (* ejs: "13-Apr-85 15:44")
(* * Try to respond to an address resolution request. Release the packet if we can't)
(DECLARE (GLOBALVARS \10MBLOCALNDB \MY.NSHOSTNUMBER))
(LET* ((TargetProtocolAddress (fetch (ARETHER ARFRNPTCL) of AR))
(TargetHardwareAddress (COND
((CDR (SASSOC TargetProtocolAddress \AR.IP.TO.10MB.ALIST)))
((MEMBER TargetProtocolAddress \IP.LOCAL.ADDRESSES)
(SPUTASSOC TargetProtocolAddress \MY.NSHOSTNUMBER
\AR.IP.TO.10MB.ALIST)
\MY.NSHOSTNUMBER))))
(COND
(TargetHardwareAddress (swap (fetch (ARETHER ARLCLPTCL) of AR)
(fetch (ARETHER ARFRNPTCL) of AR))
(replace (ARETHER ARTARGETHDW) of AR with (fetch (ARETHER ARSENDERHDW)
of AR))
(replace (ARETHER ARSENDERHDW) of AR with TargetHardwareAddress)
(replace (AR AROPCODE) of AR with \AR.RESPONSE)
(ENCAPSULATE.ETHERPACKET \10MBLOCALNDB AR (fetch (ARETHER ARTARGETHDW)
of AR)
\AR.ETHER.PACKET.LENGTH \EPT.AR)
(COND
(IPTRACEFLG (PRINTPACKET AR (QUOTE PUT)
IPTRACEFILE)))
(TRANSMIT.ETHERPACKET \10MBLOCALNDB AR))
(T (\RELEASE.ETHERPACKET AR))))))
(\AR.TRANSLATE.TO.3MB
(LAMBDA (IPADDRESS) (* ejs: " 2-Jan-85 19:22")
(COND
((\IP.BROADCAST.ADDRESS IPADDRESS)
0)
((NEQ (LDB (BYTE 8 16)
IPADDRESS)
(LDB (BYTE 8 16)
(CAR \IP.LOCAL.ADDRESSES)))
(fetch (ROUTING RTGATEWAY#) of (for RT in \IP.ROUTING.TABLE
thereis (EQ (fetch (ROUTING RTTIMER) of RT)
(LDB (BYTE 8 16)
IPADDRESS)))))
(T (LDB (BYTE 8 0)
IPADDRESS)
NIL))))
(\HANDLE.RAW.AR
(LAMBDA (AR TYPE) (* ejs: "22-Apr-85 14:14")
(PROG ((NDB (ffetch (ETHERPACKET EPNETWORK) of AR)))
(SELECTQ (ffetch (NDB NETTYPE) of NDB)
(10 (COND
((NEQ TYPE \EPT.AR)
(RETURN))))
(3 (RETURN))
(ERROR "Unknown net type" (fetch (NDB NETTYPE) of NDB)))
(COND
((AND (EQ (fetch (AR ARHARDWARESPACE) of AR)
\AR.HARDWARE.SPACE.ETHERNET)
(EQ (fetch (AR ARHARDWARELEN) of AR)
\AR.ETHERNET.ADDRESS.LENGTH)
(EQ (fetch (AR ARPROTOCOLSPACE) of AR)
\EPT.IP)
(EQ (fetch (AR ARPROTOCOLLEN) of AR)
\AR.IP.ADDRESS.LENGTH))
(\AR.NOTE.RESOLUTION AR)
(COND
((EQ (fetch (AR AROPCODE) of AR)
\AR.REQUEST)
(\AR.RESOLVE AR))
(T (\RELEASE.ETHERPACKET AR)))))
(RETURN T))))
)
(PUTPROPS TCPLLAR COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2855 9914 (\AR.NOTE.RESOLUTION 2865 . 3853) (SPUTASSOC 3855 . 4209) (
\AR.TRANSLATE.TO.10MB 4211 . 4634) (\AR.REQUEST.IP.TO.10MB 4636 . 5821) (\AR.REQUEST.IP.TO.3MB 5823 .
6969) (\AR.RESOLVE 6971 . 8384) (\AR.TRANSLATE.TO.3MB 8386 . 8921) (\HANDLE.RAW.AR 8923 . 9912)))))
STOP