(FILECREATED " 9-Feb-85 16:36:31" {ERIS}<LISPCORE>LIBRARY>LLAR.;1 9081
previous date: " 2-Jan-85 19:37:04" {ERIS}<SCHOEN>LLAR.;2)
(* Copyright (c) 1985 by xerox. All rights reserved.)
(PRETTYCOMPRINT LLARCOMS)
(RPAQQ LLARCOMS ((COMS (* * IP Ethernet address translation module)
(DECLARE: DONTCOPY (EXPORT (RECORDS AR ARETHER)
(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))
(RECORDS AREXPETHER)))
(* * 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 ((ARLCLHDW 3 WORD)
(ARLCLPTCL FIXP)
(ARFRNHDW 3 WORD)
(ARFRNPTCL FIXP))
(ACCESSFNS ARLCLHDW ((ARSENDERHDW (\LOADNSHOSTNUMBER (LOCF DATUM))
(\STORENSHOSTNUMBER (LOCF DATUM)
NEWVALUE))))
(ACCESSFNS ARFRNHDW ((ARTARGETHDW (\LOADNSHOSTNUMBER (LOCF DATUM))
(\STORENSHOSTNUMBER (LOCF DATUM)
NEWVALUE))))))
]
(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: "27-Dec-84 17:03")
(* * Add an address resolution to our database)
(SPUTASSOC (fetch (ARETHER ARLCLPTCL) of AR)
(fetch (ARETHER ARSENDERHDW) of AR)
\AR.IP.TO.10MB.ALIST)
(COND
((EQ (fetch (AR AROPCODE) of AR)
\AR.RESPONSE)
(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: "27-Dec-84 17:55")
(* * Try to respond to an address resolution request. Release the packet if we can't)
(PROG [(TargetHardwareAddress (CDR (SASSOC (fetch (ARETHER ARFRNPTCL) of AR)
\AR.IP.TO.10MB.ALIST]
(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: "27-Dec-84 19:24")
(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])
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS AREXPETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM)))
(BLOCKRECORD ARETHERBASE ((ARLCLHDW WORD)
(ARLCLPTCL FIXP)
(ARFRNHDW WORD)
(ARFRNPTCL FIXP))))
]
(PUTPROPS LLAR COPYRIGHT ("xerox" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2446 8777 (\AR.NOTE.RESOLUTION 2456 . 2998) (SPUTASSOC 3000 . 3354) (
\AR.TRANSLATE.TO.10MB 3356 . 3779) (\AR.REQUEST.IP.TO.10MB 3781 . 4966) (\AR.REQUEST.IP.TO.3MB 4968 .
6114) (\AR.RESOLVE 6116 . 7256) (\AR.TRANSLATE.TO.3MB 7258 . 7793) (\HANDLE.RAW.AR 7795 . 8775)))))
STOP