(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "RPC2")

(il:filecreated "11-Jan-89 14:52:06" il:|{NB:PARC:XEROX}<NFS>SOURCES>RPCDECLS.;2|
 9474   

      il:|changes| il:|to:|  (il:vars il:rpcdeclscoms) (il:variables *rpc-accept-program-unavailable* *portmapper-socket*)

      il:|previous| il:|date:| "19-Oct-88 18:29:59" il:|{NB:PARC:XEROX}<NFS>SOURCES>RPCDECLS.;1|)


; Copyright (c) 1988, 1989 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:rpcdeclscoms)

(il:rpaqq il:rpcdeclscoms ((il:* il:|;;| "Macros useful for low-level RPC hacking.") (il:props (il:rpcdecls il:makefile-environment il:filetype)) (il:functions getbase-integer getbase-unsigned integer-from-bytes unsigned-from-bytes unsigned-from-signed putbase-integer foldlo unfold vector-base vector-offset padding-bytes) (il:* il:\; "Call methods") (il:functions rpc-method rpc-call-method reinitialize-rpcstream getbyte getrawbytes skipbytes getcell getoffset putbyte putrawbytes zerobytes putcell getunsigned putunsigned) (il:variables *words-per-cell* *bytes-per-cell* *bytes-per-word*) (il:* il:\; "Well-known RPC constants") (il:variables *rpc-msg-call* *rpc-msg-reply* *rpc-reply-accepted* *rpc-reply-rejected* *rpc-accept-success* *rpc-accept-program-unavailable* *rpc-version* *internal-time-units-per-msec* *portmapper-socket*) (il:* il:\; "For those that need IP/TCP stuff") (il:functions load-tcp-exports)))



(il:* il:|;;| "Macros useful for low-level RPC hacking.")



(il:putprops il:rpcdecls il:makefile-environment (:readtable "XCL" :package "RPC2"))

(il:putprops il:rpcdecls il:filetype :compile-file)

(defmacro getbase-integer (base byteoffset) "Interpret 32 bits at BYTEOFFSET from BASE as a signed integer." (il:bquote (let ((base (il:\\addbase (il:\\\, base) (foldlo (il:\\\, byteoffset) *bytes-per-word*)))) (il:\\makenumber (il:\\getbase base 0) (il:\\getbase base 1)))))

(defmacro getbase-unsigned (base byteoffset) "Interpret 32 bits at BYTEOFFSET from BASE as an unsigned integer." (il:* il:|;;| "This differs from GETBASE-INTEGER only when the high bit is on, in which case we are forced to make (choke) a bignum, which we try to do efficiently.") (il:bquote (let* ((base (il:\\addbase (il:\\\, base) (foldlo (il:\\\, byteoffset) *bytes-per-word*))) (hi (il:\\getbase base 0))) (if (> hi 32767) (bignum-make-number hi (il:\\getbase base 1)) (il:\\makenumber hi (il:\\getbase base 1))))))

(defmacro integer-from-bytes (byte0 byte1 byte2 byte3) "Interprets these 32 bits as a signed integer" (il:bquote (il:\\makenumber (+ (unfold (il:\\\, byte0) 256) (il:\\\, byte1)) (+ (unfold (il:\\\, byte2) 256) (il:\\\, byte3)))))

(defmacro unsigned-from-bytes (byte0 byte1 byte2 byte3) "Interprets these 32 bits as an unsigned integer" (il:bquote (let* ((hi (+ (unfold (il:\\\, byte0) 256) (il:\\\, byte1))) (lo (+ (unfold (il:\\\, byte2) 256) (il:\\\, byte3)))) (if (> hi 32767) (bignum-make-number hi lo) (il:\\makenumber hi lo)))))

(defmacro unsigned-from-signed (value) "Interpret the 32 bits of VALUE's representation as an unsigned integer." (il:bquote (let ((value (il:\\\, value))) (if (> 0 value) (+ value twoto32nd) value))))

(defmacro putbase-integer (base byteoffset value) "Store integer VALUE at BYTEOFFSET bytes beyond BASE." (il:* il:|;;| "Note this handles both \"signed\" and \"unsigned\" numbers.  We do type analysis here to avoid gratuitous consing when handling anything large.") (il:bquote (let ((base (il:\\addbase (il:\\\, base) (foldlo (il:\\\, byteoffset) *bytes-per-word*))) (value (il:\\\, value))) (cond ((il:smallp value) (il:* il:\; "An immediate value") (il:\\putbase base 0 (if (< value 0) 65535 0)) (il:\\putbase base 1 (il:\\loloc value))) ((eq (il:ntypx value) il:\\fixp) (il:* il:\; "A 32-bit integer box--just blt it") (il:\\blt base value 2)) (t (putbase-bignum base value))))))

(defmacro foldlo (form divisor) (let ((div (if (constantp divisor) (eval divisor) divisor))) (or (and div (il:poweroftwop div)) (il:\\illegal.arg div)) (list (quote il:lrsh) form (il:sub1 (il:integerlength div)))))

(defmacro unfold (form divisor) (let ((div (if (constantp divisor) (eval divisor) divisor))) (or (and div (il:poweroftwop div)) (il:\\illegal.arg div)) (list (quote il:llsh) form (il:sub1 (il:integerlength div)))))

(defmacro vector-base (vector) "Get raw string/vector base address.  Use VECTOR-OFFSET, too, unless you know this is a brand new one without displacement." (il:bquote (il:|fetch| (il:oned-array il:base) il:|of| (il:\\\, vector))))

(defmacro vector-offset (vector) "Get raw vector offset.  Interpretation depends on element type, of course." (il:bquote (il:|fetch| (il:oned-array il:offset) il:|of| (il:\\\, vector))))

(defmacro padding-bytes (bytecount) "Returns number of bytes needed to pad BYTECOUNT bytes out to a multiple of 32 bits." (il:bquote (let ((n (il:\\\, bytecount))) (- (logand (+ n 3) -4) n))))



(il:* il:\; "Call methods")



(defmacro rpc-method (op stream) "Returns the function that implements OP (unevaluated) on STREAM." (il:bquote ((il:\\\, (intern (concatenate (quote string) "RPC-METHODS-" (string op)) "RPC2")) (rpc-stream-methods (il:\\\, stream)))))

(defmacro rpc-call-method (op &rest args) "Invoke the OP method on ARGS, the first of which must be the RPC-STREAM that defines the method" (il:bquote (funcall (rpc-method (il:\\\, op) (il:\\\, (first args))) (il:\\\,@ args))))

(defmacro reinitialize-rpcstream (stream destaddr destsocket) "Reuse an existing RPC Stream to send a new packet. Resets length counters, reinitializes packets, etc." (il:bquote (rpc-call-method initialize (il:\\\, stream) (il:\\\, destaddr) (il:\\\, destsocket))))

(defmacro getbyte (xdrstream) "Applies the GETBYTE method of an RPC Stream to read in and return the next byte of the stream." (il:bquote (rpc-call-method getbyte (il:\\\, xdrstream))))

(defmacro getrawbytes (xdrstream base offset nbytes) "Applies the GETRAWBYTES method of an RPC stream to read NBYTES bytes from the stream to BASE,OFFSET." (il:bquote (rpc-call-method getrawbytes (il:\\\, xdrstream) (il:\\\, base) (il:\\\, offset) (il:\\\, nbytes))))

(defmacro skipbytes (rpcstream nbytes) "Applies the SKIPBYTES method of an RPC stream to skip NBYTES bytes of input." (il:bquote (rpc-call-method skipbytes (il:\\\, rpcstream) (il:\\\, nbytes))))

(defmacro getcell (xdrstream) "Applies the GETCELL method of an RPC Stream to read in and return the next cell of the stream. A cell is a 32-bit two's complement integer." (il:bquote (rpc-call-method getcell (il:\\\, xdrstream))))

(defmacro getoffset (xdrstream) "Returns dotted pair (base . byteoffset), pointing at current position in incoming packet" (il:bquote (rpc-call-method getoffset (il:\\\, xdrstream))))

(defmacro putbyte (rpcstream value) "Applies the PUTBYTE method of an RPC Stream to write the byte VALUE on that stream. VALUE is an integer between 0 and 255 inclusive." (il:bquote (rpc-call-method putbyte (il:\\\, rpcstream) (il:\\\, value))))

(defmacro putrawbytes (rpcstream base offset nbytes) "Applies the PUTRAWBYTES method of an RPC stream to write the NBYTES bytes from BASE,OFFSET to the stream." (il:bquote (rpc-call-method putrawbytes (il:\\\, rpcstream) (il:\\\, base) (il:\\\, offset) (il:\\\, nbytes))))

(defmacro zerobytes (rpcstream nbytes) "Applies the ZEROBYTES method of an RPC stream to write NBYTES bytes of zero to the output." (il:bquote (rpc-call-method zerobytes (il:\\\, rpcstream) (il:\\\, nbytes))))

(defmacro putcell (rpcstream value) "Applies the PUTCELL method of an RPC Stream to write the cell VALUE on that stream. A cell is a 32-bit two's complement integer." (il:bquote (rpc-call-method putcell (il:\\\, rpcstream) (il:\\\, value))))

(defmacro getunsigned (rpcstream) "Fetch an unsigned 32-bit integer from RPCSTREAM.  Uses the GETUNSIGNED method." (il:bquote (rpc-call-method getunsigned (il:\\\, rpcstream))))

(defmacro putunsigned (rpcstream value) "Write a 32-bit unsigned integer to RPCSTREAM.  Uses PUTCELL method." (il:* il:|;;| "Note that no coercion is need here, because the bits of the bignum are the same as the bits of the signed integer.") (il:bquote (putcell (il:\\\, rpcstream) (il:\\\, value))))

(defconstant *words-per-cell* 2 "The number of words (16 bits) per cell.")

(defconstant *bytes-per-cell* 4 "Number of 8-bit bytes per RPC cell.")

(defconstant *bytes-per-word* 2)



(il:* il:\; "Well-known RPC constants")



(defconstant *rpc-msg-call* 0 "Constant 0 in packet means RPC call, 1 means reply")

(defconstant *rpc-msg-reply* 1)

(defconstant *rpc-reply-accepted* 0 "Switch in reply body")

(defconstant *rpc-reply-rejected* 1 "Switch in reply body")

(defconstant *rpc-accept-success* 0 "Switch in accepted reply.")

(defconstant *rpc-accept-program-unavailable* 1)

(defconstant *rpc-version* 2 "This code will only work for SUN RPC Version 2")

(defconstant *internal-time-units-per-msec* (/ internal-time-units-per-second 1000) "This gets used in EXCHANGE-UDP-PACKETS.")

(defconstant *portmapper-socket* 111 "Well-known socket for portmapper")



(il:* il:\; "For those that need IP/TCP stuff")



(defun load-tcp-exports nil (prog1 (il:filesload (il:source) il:tcpexports) (il:* il:\; "Now stop us from loading it again (This really ought to be on TCPEXPORTS)") (or (get (quote il:tcpexports) (quote il:filedates)) (setf (get (quote il:tcpexports) (quote il:filedates)) t))))
(il:putprops il:rpcdecls il:copyright ("Xerox Corporation" 1988 1989))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop