(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