(FILECREATED " 8-Sep-85 23:10:49" {ERIS}<LISPCORE>LIBRARY>TCPUDP.;8 11967
changes to: (FNS UDP.OPEN.SOCKET)
previous date: "25-Jun-85 21:13:26" {ERIS}<LISPCORE>LIBRARY>TCPUDP.;7)
(* 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: " 8-Sep-85 23:10")
(OR (SMALLP SKT#)
(SETQ SKT# (RAND 1000 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 (1558 5955 (UDP.GET.BYTE 1568 . 1929) (UDP.GET.CELL 1931 . 2470) (UDP.GET.STRING 2472 .
3032) (UDP.GET.WORD 3034 . 3415) (\UDP.FLUSH.SOCKET.QUEUE 3417 . 3873) (\UDP.PORTCOMPARE 3875 . 4181)
(\UDP.CHECKSUM 4183 . 5397) (\UDP.SET.CHECKSUM 5399 . 5953)) (5987 11833 (PRINTUDP 5997 . 6596) (
UDP.INIT 6598 . 6954) (UDP.STOP 6956 . 7107) (UDP.OPEN.SOCKET 7109 . 7777) (UDP.CLOSE.SOCKET 7779 .
8045) (UDP.SOCKET.EVENT 8047 . 8214) (UDP.SOCKET.NUMBER 8216 . 8384) (UDP.GET 8386 . 9692) (UDP.SEND
9694 . 9965) (UDP.EXCHANGE 9967 . 10364) (UDP.SETUP 10366 . 10878) (UDP.APPEND.BYTE 10880 . 11086) (
UDP.APPEND.CELL 11088 . 11305) (UDP.APPEND.STRING 11307 . 11612) (UDP.APPEND.WORD 11614 . 11831)))))
STOP