(FILECREATED "15-Apr-85 16:40:10" {ERIS}<LISPCORE>LIBRARY>TCPUDP.;1 9484
changes to: (VARS UDPCOMS TCPUDPCOMS)
previous date: "10-Feb-85 00:17:30" {ERIS}<LISPCORE>LIBRARY>UDP.;6)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPUDPCOMS)
(RPAQQ TCPUDPCOMS ((COMS (* User Datagram Protocol - Definitions)
(RECORDS UDP)
(CONSTANTS (\UDPOVLEN 8))
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPLLIP))
(COMS (* Internal functions)
(FNS \UDP.FLUSH.SOCKET.QUEUE \UDP.PORTCOMPARE \UDP.CHECKSUM \UDP.SET.CHECKSUM))
(COMS (* External functions)
(FNS UDP.INIT UDP.STOP UDP.OPEN.SOCKET UDP.CLOSE.SOCKET UDP.SOCKET.EVENT
UDP.SOCKET.NUMBER UDP.GET UDP.SEND UDP.EXCHANGE UDP.SETUP UDP.APPEND.BYTE
UDP.APPEND.CELL UDP.APPEND.STRING UDP.APPEND.WORD)
(P (UDP.INIT)))))
(* User Datagram Protocol - Definitions)
[DECLARE: EVAL@COMPILE
(ACCESSFNS UDP ((UDPBASE (\IPDATABASE DATUM)))
(BLOCKRECORD UDPBASE ((UDPSOURCEPORT WORD)
(UDPDESTPORT WORD)
(UDPLENGTH WORD)
(UDPCHECKSUM WORD)))
(ACCESSFNS UDP ((UDPCONTENTS (\ADDBASE (\IPDATABASE DATUM)
(FOLDHI \UDPOVLEN BYTESPERWORD))))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \UDPOVLEN 8)
(CONSTANTS (\UDPOVLEN 8))
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPLLIP)
(* Internal functions)
(DEFINEQ
(\UDP.FLUSH.SOCKET.QUEUE
(LAMBDA (IPSOCKET) (* ejs: " 9-Feb-85 15:03")
(* * Called to flush input packet queue on an IPSOCKET)
(LET ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET))
PACKET)
(while (SETQ PACKET (\DEQUEUE QUEUE)) do (\RELEASE.ETHERPACKET PACKET)
finally (replace (IPSOCKET IPSQUEUELENGTH) of IPSOCKET with 0)))))
(\UDP.PORTCOMPARE
(LAMBDA (UDP IPSOCKET) (* ejs: " 9-Feb-85 14:37")
(* * Compare IPSOCKET until we find the one this UDP was destined for)
(EQ (fetch (UDP UDPDESTPORT) of UDP)
(fetch (IPSOCKET IPSOCKET) of IPSOCKET))))
(\UDP.CHECKSUM
(LAMBDA (UDP) (* ejs: " 9-Feb-85 17:55")
(* * Compute the UDP checksum for the packet UDP. The packet is assumed to have been setup by UDP.SETUP so that
source and destination addresses, protocol, and UDP length have already been set.)
(LET ((SOURCE (fetch (IP IPSOURCEADDRESS) of UDP))
(DEST (fetch (IP IPDESTINATIONADDRESS) of UDP))
(LENGTH (fetch (UDP UDPLENGTH) of UDP))
CHECKSUM)
(SETQ CHECKSUM (IPLUS (bind (BASE ←(LOCF (fetch (IP IPSOURCEADDRESS) of UDP))) for I
from 0 to (CONSTANT (SUB1 (TIMES 2 WORDSPERCELL)))
sum (\GETBASE BASE I))
(ffetch (IP IPPROTOCOL) of UDP)
LENGTH
(\IPCHECKSUM UDP (\IPDATABASE UDP)
LENGTH)))
(SETQ CHECKSUM (IPLUS (LDB (BYTE 16 16)
CHECKSUM)
(LDB (BYTE 16 0)
CHECKSUM)))
(COND
((NOT (EQ (LDB (BYTE 16 16)
CHECKSUM)
0))
(SETQ CHECKSUM (IPLUS (LDB (BYTE 16 16)
CHECKSUM)
(LDB (BYTE 16 0)
CHECKSUM)))))
CHECKSUM)))
(\UDP.SET.CHECKSUM
(LAMBDA (UDP) (* ejs: " 9-Feb-85 17:58")
(* * Called to set the UDP checksum in a packet ready to be transmitted)
(LET (CHECKSUM)
(replace (UDP UDPCHECKSUM) of UDP with 0)
(SETQ CHECKSUM (\UDP.CHECKSUM UDP))
(replace (UDP UDPCHECKSUM) of UDP with (COND
((NEQ CHECKSUM MAX.SMALLP)
(BITCLEAR (LOGNOT CHECKSUM)
(CONSTANT (MASK.1'S 16 16))))
(T MAX.SMALLP))))))
)
(* External functions)
(DEFINEQ
(UDP.INIT
(LAMBDA NIL (* ejs: " 9-Feb-85 16:53")
(COND
((NOT \IPFLG)
(SELECTQ (ASKUSER 15 (QUOTE Y)
"IP is not running. Shall I attempt to initialize it? ")
(Y (\IPINIT))
NIL)))
(\IP.ADD.PROTOCOL \UDP.PROTOCOL (FUNCTION \UDP.PORTCOMPARE))))
(UDP.STOP
(LAMBDA NIL (* ejs: " 9-Feb-85 14:43")
(\IP.DELETE.PROTOCOL \UDP.PROTOCOL)))
(UDP.OPEN.SOCKET
(LAMBDA (SKT# IFCLASH) (* ejs: " 9-Feb-85 14:57")
(OR (SMALLP SKT#)
(SETQ SKT# (RAND 1 MAX.SMALLP)))
(LET* ((UDPCHAIN (\IP.FIND.PROTOCOL \UDP.PROTOCOL))
(IPSOCKET (AND UDPCHAIN (\IP.FIND.SOCKET SKT# UDPCHAIN))))
(COND
((NULL UDPCHAIN)
(UDP.INIT)))
(COND
((NULL IPSOCKET)
(\IP.OPEN.SOCKET \UDP.PROTOCOL SKT#))
(T (SELECTQ IFCLASH
((T ACCEPT)
(\UDP.FLUSH.SOCKET.QUEUE IPSOCKET)
IPSOCKET)
((DON'T FAIL)
NIL)
(ERROR "UDP Port is already in use" SKT#)))))))
(UDP.CLOSE.SOCKET
(LAMBDA (IPSOCKET NOERRORFLG) (* ejs: " 9-Feb-85 15:00")
(\UDP.FLUSH.SOCKET.QUEUE IPSOCKET)
(\IP.CLOSE.SOCKET (fetch (IPSOCKET IPSOCKET) of IPSOCKET)
\UDP.PROTOCOL NOERRORFLG)))
(UDP.SOCKET.EVENT
(LAMBDA (IPSOCKET) (* ejs: " 9-Feb-85 15:07")
(fetch (IPSOCKET IPSEVENT) of IPSOCKET)))
(UDP.SOCKET.NUMBER
(LAMBDA (IPSOCKET) (* ejs: " 9-Feb-85 15:08")
(fetch (IPSOCKET IPSOCKET) of IPSOCKET)))
(UDP.GET
(LAMBDA (IPSOCKET WAIT) (* ejs: " 9-Feb-85 16:00")
(* * Returns the next UDP packet on the queue, or NIL if none exist and WAIT is NIL. If WAIT is T, this function
waits forever. If WAIT is an integer, it is interpreted as the number of milliseconds to wait before returning NIL
or a packet which arrives during that time. This function therefore is like GETXIP and GETPUP)
(LET* ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET))
(UDP (COND
((\QUEUEHEAD QUEUE)
(PROG1 (\DEQUEUE QUEUE)
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1)))
(T (COND
((NULL WAIT)
NIL)
((FIXP WAIT)
(AWAIT.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET)
WAIT)
(COND
((\QUEUEHEAD QUEUE)
(PROG1 (\DEQUEUE QUEUE)
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1)))))
((EQ WAIT T)
(bind (EVENT ←(fetch (IPSOCKET IPSEVENT) of IPSOCKET)) do (AWAIT.EVENT EVENT)
repeatuntil (\QUEUEHEAD QUEUE)
finally (RETURN (PROG1 (\DEQUEUE QUEUE)
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1))))))))))
(COND
((AND UDP (\IP.CHECKSUM.OK (\UDP.CHECKSUM UDP)))
UDP)))))
(UDP.SEND
(LAMBDA (IPSOCKET UDP) (* ejs: " 9-Feb-85 15:24")
(* * Sends a UDP packet. IP and UDP header assumed set up by UDP.SETUP and \IP.SETUPIP)
(\UDP.SET.CHECKSUM UDP)
(\IP.TRANSMIT UDP)))
(UDP.EXCHANGE
(LAMBDA (IPSOCKET OUTUDP TIMEOUT) (* ejs: " 9-Feb-85 22:28")
(* * Send a UDP packet and wait for TIMEOUT to receive a packet (TIMEOUT defaults to \ETHERTIMEOUT))
(\UDP.FLUSH.SOCKET.QUEUE IPSOCKET)
(UDP.SEND IPSOCKET OUTUDP)
(BLOCK)
(UDP.GET IPSOCKET (OR (FIXP TIMEOUT)
\ETHERTIMEOUT))))
(UDP.SETUP
(LAMBDA (UDP DESTHOST DESTSOCKET ID IPSOCKET REQUEUE) (* ejs: " 9-Feb-85 16:04")
(\IP.SETUPIP UDP DESTHOST ID IPSOCKET REQUEUE)
(add (fetch (IP IPTOTALLENGTH) of UDP)
\UDPOVLEN)
(AND (SMALLP DESTSOCKET)
(replace (UDP UDPDESTPORT) of UDP with DESTSOCKET))
(replace (UDP UDPSOURCEPORT) of UDP with (fetch (IPSOCKET IPSOCKET) of IPSOCKET))
(replace (UDP UDPLENGTH) of UDP with \UDPOVLEN)
UDP))
(UDP.APPEND.BYTE
(LAMBDA (UDP BYTE) (* ejs: " 9-Feb-85 16:07")
(\IP.APPEND.BYTE UDP BYTE)
(add (fetch (UDP UDPLENGTH) of UDP)
1)))
(UDP.APPEND.CELL
(LAMBDA (UDP CELL) (* ejs: " 9-Feb-85 16:06")
(\IP.APPEND.CELL UDP CELL)
(add (fetch (UDP UDPLENGTH) of UDP)
BYTESPERCELL)))
(UDP.APPEND.STRING
(LAMBDA (UDP STRING) (* ejs: " 9-Feb-85 16:10")
(OR (STRINGP STRING)
(SETQ STRING (MKSTRING STRING)))
(\IP.APPEND.STRING UDP STRING)
(add (fetch (UDP UDPLENGTH) of UDP)
(NCHARS STRING))))
(UDP.APPEND.WORD
(LAMBDA (UDP WORD) (* ejs: " 9-Feb-85 16:07")
(\IP.APPEND.WORD UDP WORD)
(add (fetch (UDP UDPLENGTH) of UDP)
WORDSPERCELL)))
)
(UDP.INIT)
(PUTPROPS TCPUDP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1441 4002 (\UDP.FLUSH.SOCKET.QUEUE 1451 . 1907) (\UDP.PORTCOMPARE 1909 . 2215) (
\UDP.CHECKSUM 2217 . 3431) (\UDP.SET.CHECKSUM 3433 . 4000)) (4034 9396 (UDP.INIT 4044 . 4400) (
UDP.STOP 4402 . 4553) (UDP.OPEN.SOCKET 4555 . 5213) (UDP.CLOSE.SOCKET 5215 . 5481) (UDP.SOCKET.EVENT
5483 . 5650) (UDP.SOCKET.NUMBER 5652 . 5820) (UDP.GET 5822 . 7255) (UDP.SEND 7257 . 7528) (
UDP.EXCHANGE 7530 . 7927) (UDP.SETUP 7929 . 8441) (UDP.APPEND.BYTE 8443 . 8649) (UDP.APPEND.CELL 8651
. 8868) (UDP.APPEND.STRING 8870 . 9175) (UDP.APPEND.WORD 9177 . 9394)))))
STOP