(FILECREATED "25-Jun-85 21:13:26" {ERIS}<LISPCORE>LIBRARY>TCPUDP.;7 12018
changes to: (VARS TCPUDPCOMS)
(FNS UDP.GET.STRING UDP.GET.CELL UDP.GET.WORD UDP.GET.BYTE)
previous date: "21-Jun-85 19:31:45" {ERIS}<LISPCORE>LIBRARY>TCPUDP.;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.GET.BYTE UDP.GET.CELL UDP.GET.STRING UDP.GET.WORD \UDP.FLUSH.SOCKET.QUEUE
\UDP.PORTCOMPARE \UDP.CHECKSUM \UDP.SET.CHECKSUM))
(COMS (* External functions)
(FNS PRINTUDP 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)
(ADDVARS (IPPRINTMACROS (17 . PRINTUDP)))
(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.GET.BYTE
(LAMBDA (UDP BYTE#) (* ejs: "25-Jun-85 21:04")
(* * Return a byte from the UDP data area)
(COND
((AND (IGEQ BYTE# 0)
(ILESSP BYTE# (fetch (UDP UDPLENGTH) of UDP)))
(\GETBASEBYTE (fetch (UDP UDPCONTENTS) of UDP)
BYTE#)))))
(UDP.GET.CELL
(LAMBDA (UDP CELL#) (* ejs: "25-Jun-85 21:09")
(* * Return a cell from the UDP data area)
(COND
((AND (IGEQ CELL# 0)
(ILESSP CELL# (FOLDLO (fetch (UDP UDPLENGTH) of UDP)
BYTESPERCELL)))
(\MAKENUMBER (\GETBASE (fetch (UDP UDPCONTENTS) of UDP)
(UNFOLD CELL# WORDSPERCELL))
(\GETBASE (fetch (UDP UDPCONTENTS) of UDP)
(ADD1 (UNFOLD CELL# WORDSPERCELL))))))))
(UDP.GET.STRING
(LAMBDA (UDP OFFSET) (* ejs: "25-Jun-85 21:12")
(* * Fetch a string out of the UDP packet)
(OR (SMALLP OFFSET)
(SETQ OFFSET 0))
(LET* ((LENGTH (IDIFFERENCE (fetch (UDP UDPLENGTH) of UDP)
OFFSET))
(STRING (ALLOCSTRING LENGTH)))
(\MOVEBYTES (fetch (UDP UDPCONTENTS) of UDP)
OFFSET
(fetch (STRINGP BASE) of STRING)
(fetch (STRINGP OFFST) of STRING)
LENGTH)
STRING)))
(UDP.GET.WORD
(LAMBDA (UDP WORD#) (* ejs: "25-Jun-85 21:06")
(* * Return a word from the UDP data area)
(COND
((AND (IGEQ WORD# 0)
(ILESSP WORD# (FOLDLO (fetch (UDP UDPLENGTH) of UDP)
BYTESPERWORD)))
(\GETBASE (fetch (UDP UDPCONTENTS) of UDP)
WORD#)))))
(\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: " 3-Jun-85 00:19")
(* * 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)
(LOGAND (LOGNOT CHECKSUM)
(CONSTANT (MASK.1'S 0 16))))
(T MAX.SMALLP))))))
)
(* External functions)
(DEFINEQ
(PRINTUDP
(LAMBDA (UDP FILE) (* ejs: " 2-Jun-85 12:44")
(printout FILE "Source port: " (fetch (UDP UDPSOURCEPORT) of UDP)
" Dest port: "
(fetch (UDP UDPDESTPORT) of UDP)
T "Length: " (fetch (UDP UDPLENGTH) of UDP)
" Checksum: "
(fetch (UDP UDPCHECKSUM) of UDP)
T)
(COND
((OR (EQ (fetch (UDP UDPDESTPORT) of UDP)
\TFTP.SOCKET)
(EQ (fetch (UDP UDPSOURCEPORT) of UDP)
\TFTP.SOCKET))
(PRINTTFTP UDP FILE)))))
(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) (* MPL " 2-Jun-85 17:57")
(* * 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)
(PROG ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET))
UDP TIMER)
LP (UNINTERRUPTABLY
(COND
((SETQ UDP (\DEQUEUE QUEUE))
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1))))
(COND
((NULL UDP)
(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 (fetch (IPSOCKET IPSEVENT) of IPSOCKET)
TIMER T)
(GO LP))
(T (BLOCK))))
((NOT (\IP.CHECKSUM.OK (\UDP.CHECKSUM UDP)))
(\RELEASE.ETHERPACKET UDP)
(GO LP)))
(RETURN 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)))
)
(ADDTOVAR IPPRINTMACROS (17 . PRINTUDP))
(UDP.INIT)
(PUTPROPS TCPUDP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1619 6016 (UDP.GET.BYTE 1629 . 1990) (UDP.GET.CELL 1992 . 2531) (UDP.GET.STRING 2533 .
3093) (UDP.GET.WORD 3095 . 3476) (\UDP.FLUSH.SOCKET.QUEUE 3478 . 3934) (\UDP.PORTCOMPARE 3936 . 4242)
(\UDP.CHECKSUM 4244 . 5458) (\UDP.SET.CHECKSUM 5460 . 6014)) (6048 11884 (PRINTUDP 6058 . 6657) (
UDP.INIT 6659 . 7015) (UDP.STOP 7017 . 7168) (UDP.OPEN.SOCKET 7170 . 7828) (UDP.CLOSE.SOCKET 7830 .
8096) (UDP.SOCKET.EVENT 8098 . 8265) (UDP.SOCKET.NUMBER 8267 . 8435) (UDP.GET 8437 . 9743) (UDP.SEND
9745 . 10016) (UDP.EXCHANGE 10018 . 10415) (UDP.SETUP 10417 . 10929) (UDP.APPEND.BYTE 10931 . 11137) (
UDP.APPEND.CELL 11139 . 11356) (UDP.APPEND.STRING 11358 . 11663) (UDP.APPEND.WORD 11665 . 11882)))))
STOP