(FILECREATED "10-AUG-83 11:20:09" {PHYLUM}<YONKE>GRAPEVINE.;1 35971  

      changes to:  (VARS GRAPEVINECOMS \GV.OPS)
		   (FNS GV.EXPAND)

      previous date: "11-MAY-83 16:31:59" {PHYLUM}<LISPCORE>SOURCES>GRAPEVINE.;2)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT GRAPEVINECOMS)

(RPAQQ GRAPEVINECOMS [(* High Level Grapevine User Operations as per section 4.1 of the Grapevine 
			 Interface document)
	(COMS (* Functions for interrogating the database)
	      (FNS AUTHENTICATE CHECKSTAMP GV.EXPAND IDENTIFYCALLER IDENTIFYME ISINLIST READCONNECT 
		   READENTRY READFRIENDS READMEMBERS READOWNERS READREMARK)
	      (* Functions which update the database)
	      (FNS ADDFORWARD ADDFRIEND ADDLISTOFMEMBERS ADDMAILBOX ADDMEMBER ADDOWNER CHANGEPASSWORD 
		   CHANGEREMARK CREATEGROUP CREATEINDIVIDUAL DELETEGROUP DELETEINDIVIDUAL NEWNAME 
		   REMOVEFORWARD REMOVEFRIEND REMOVEMAILBOX REMOVEMEMBER REMOVEOWNER)
	      (MACROS SAFELY)
	      (FNS MAKEKEY)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS KEYP CREATEKEY GETKEYBYTE SETKEYBYTE)
			(* Constants for calling ISINLIST)
			(CONSTANTS * \GVU.MEMBEROPS)))
	(COMS (* Higher-level Grapevine User primitives)
	      (FNS \GVOP \GVOP1 \ENQUIRE)
	      (* These functions check and/or coerce arguments to server operations)
	      (FNS \CHECKKEY \CHECKNAME \CHECKSTAMP \CHECKSTRING \NONAMEERR \UNPACKREG)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS TIMESTAMP))
	      (INITRECORDS TIMESTAMP))
	(COMS (* Lower-level Grapevine User primitives)
	      (FNS \SENDITEM \SENDSTRING \SENDWORD)
	      (FNS \RECEIVEBOOL \RECEIVECLIST \RECEIVECOMPONENT \RECEIVERLIST \RECEIVERNAME 
		   \RECEIVESTAMP \RECEIVESTRING \RECEIVEWORD)
	      (FNS FINDREGSERVER LOCATESOCKETS \KILLSOCKET)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS \RECEIVEWORD \SENDWORD)
			(CONSTANTS (\GV.SSLENGTH 64)
				   (\MAXGVSTRING 64)
				   (\REG.SERVERENQUIRYSOC 40)
				   (\REG.SERVERPOLLINGSOC 42)))
	      (VARS (DEFAULTREGISTRY (QUOTE PA))
		    (REGROOT (QUOTE (GV . GV)))
		    (REGROOTNLSNAME "GrapevineRServer")
		    (\3BYTEKLUDGEKEY (QUOTE $$3byte$$))
		    (\REG.IOTIMEOUT 30000)
		    (\REG.SOCKET))
	      (GLOBALVARS DEFAULTREGISTRY REGROOT REGROOTNLSNAME \3BYTEKLUDGEKEY \REG.IOTIMEOUT 
			  \REG.SOCKET))
	(COMS (* Various constant codes)
	      (* Grapevine User Protocol Op Codes)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (CONSTANTS * \GV.OPS)
			(* Grapevine response codes)
			(CONSTANTS * \GV.RESPONSES)
			(* Response codes the user sees)
			(CONSTANTS * \GVU.RESPONSES)))
	[COMS (* Functions for trying to make connection to closest by hopcount and responsiveness)
	      (FNS OPENCLOSESTSOCKET \OPENGVCONNECTION \KILL.RSOCKET)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS GVCONNECTION)
			(CONSTANTS (\DEFAULTPOLLINGSOC 5)))
	      (VARS (\BETWEENPROBEDELAY 100)
		    (\CONNECTTIMEOUT 5000))
	      (GLOBALVARS \BETWEENPROBEDELAY \CONNECTTIMEOUT \EchosFrom \TIMEOUTKEY)
	      (DECLARE: DONTEVAL@LOAD DOCOPY
			(P (COND ((NOT (GETD (QUOTE SORT.PUPHOSTS.BY.DISTANCE)))
				  (FILESLOAD ROUTER)
				  (/MOVD (QUOTE HOPORDER)
					 (QUOTE SORT.PUPHOSTS.BY.DISTANCE]
	(FNS BSPWIN)
	(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (P (SELECTQ (COMPILEMODE)
								  (D (FILESLOAD (LOADCOMP)
										PUP BSP))
								  (PDP-10 (FILESLOAD (LOADCOMP)
										     PUP10 BSPAUX))
								  NIL)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \GVOP1)
									      (NLAML)
									      (LAMA])



(* High Level Grapevine User Operations as per section 4.1 of the Grapevine Interface document)




(* Functions for interrogating the database)

(DEFINEQ

(AUTHENTICATE
  [LAMBDA (NAME KEY)               (* ht: "14-JAN-82 10:24")
    (\GVOP \OP.AUTHENTICATE (\CHECKNAME NAME)
	   (LIST (\CHECKKEY KEY])

(CHECKSTAMP
  [LAMBDA (NAME OLDSTAMP)          (* ht: "22-JAN-82 10:07")
    (\GVOP \OP.CHECKSTAMP (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVESTAMP])

(GV.EXPAND
  [LAMBDA (NAME OLDSTAMP)                                    (* M.Yonke "10-AUG-83 11:10")
                                                             (* Does the database Expand operation -
							     named to avoid conflict with the mail server version 
							     (MSExpand))
    (\GVOP \OP.GVEXPAND (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVERLIST])

(IDENTIFYCALLER
  [LAMBDA (NAME KEY)               (* ht: "14-JAN-82 10:27")
    (\GVOP \OP.IDENTIFYCALLER (\CHECKNAME NAME)
	   (LIST (\CHECKKEY KEY])

(IDENTIFYME
  [LAMBDA NIL                                                (* bvm: " 8-MAR-83 22:39")
                                                             (* Calls IDENTIFYCALLER with info provided by LOGIN)
    (PROG ((npw (\INTERNAL/GETPASSWORD NIL)))
          (RETURN (IDENTIFYCALLER (CAR npw)
				  (CDR npw])

(ISINLIST
  [LAMBDA (NAME STRING WHAT WHICH WHERE)
                                   (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ISINLIST (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING)
		 (LIST \3BYTEKLUDGEKEY (OR WHAT OP.ITSELF)
		       (OR WHICH OP.MEMBERS)
		       (OR WHERE OP.DIRECT)))
	   (FUNCTION \RECEIVEBOOL])

(READCONNECT
  [LAMBDA (NAME)                   (* ht: "14-JAN-82 10:20")
    (\GVOP \OP.READCONNECT (\CHECKNAME NAME)
	   NIL
	   (FUNCTION \RECEIVERNAME])

(READENTRY
  [LAMBDA (NAME OLDSTAMP)          (* ht: "22-JAN-82 10:07")
    (\GVOP \OP.READENTRY (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVECLIST])

(READFRIENDS
  [LAMBDA (NAME OLDSTAMP)          (* lmm "20-JAN-83 00:07")
    (\GVOP \OP.READFRIENDS (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVERLIST])

(READMEMBERS
  [LAMBDA (NAME OLDSTAMP)          (* ht: "22-JAN-82 10:07")
    (\GVOP \OP.READMEMBERS (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVERLIST])

(READOWNERS
  [LAMBDA (NAME OLDSTAMP)          (* ht: "22-JAN-82 10:07")
    (\GVOP \OP.READOWNERS (\CHECKNAME NAME)
	   (LIST (\CHECKSTAMP OLDSTAMP))
	   (FUNCTION \RECEIVERLIST])

(READREMARK
  [LAMBDA (NAME)                   (* ht: "14-JAN-82 10:21")
    (\GVOP \OP.READREMARK (\CHECKNAME NAME)
	   NIL
	   (FUNCTION \RECEIVERNAME])
)



(* Functions which update the database)

(DEFINEQ

(ADDFORWARD
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ADDFORWARD (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(ADDFRIEND
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ADDFRIEND (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(ADDLISTOFMEMBERS
  [LAMBDA (NAME STRINGLIST)        (* ht: "14-JAN-82 14:09")
    (\GVOP \OP.ADDLISTOFMEMBERS (\CHECKNAME NAME)
	   (LIST (COND
		   ([AND (LISTP STRINGLIST)
			 (OR (STRINGP (CAR STRINGLIST))
			     (LITATOM (CAR STRINGLIST)))
			 (for p on STRINGLIST when (CDR p) always (AND (OR (STRINGP (CADR p))
									   (LITATOM (CADR p)))
								       (ALPHORDER (CAR p)
										  (CADR p]
		     STRINGLIST)
		   (T (ERROR "must have ordered list of strings" STRINGLIST])

(ADDMAILBOX
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ADDMAILBOX (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(ADDMEMBER
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ADDMEMBER (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(ADDOWNER
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.ADDOWNER (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(CHANGEPASSWORD
  [LAMBDA (NAME KEY)               (* ht: "14-JAN-82 13:15")
    (\GVOP \OP.CHANGEPASSWORD (\CHECKNAME NAME)
	   (LIST (\CHECKKEY KEY])

(CHANGEREMARK
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.CHANGEREMARK (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(CREATEGROUP
  [LAMBDA (NAME)                   (* ht: "14-JAN-82 13:18")
    (\GVOP \OP.CREATEGROUP (\CHECKNAME NAME])

(CREATEINDIVIDUAL
  [LAMBDA (NAME KEY)               (* ht: "14-JAN-82 13:15")
    (\GVOP \OP.CREATEINDIVIDUAL (\CHECKNAME NAME)
	   (LIST (\CHECKKEY KEY])

(DELETEGROUP
  [LAMBDA (NAME)                   (* ht: "14-JAN-82 13:18")
    (\GVOP \OP.DELETEGROUP (\CHECKNAME NAME])

(DELETEINDIVIDUAL
  [LAMBDA (NAME)                   (* ht: "14-JAN-82 13:18")
    (\GVOP \OP.DELETEINDIVIDUAL (\CHECKNAME NAME])

(NEWNAME
  [LAMBDA (NAME NEWNAME)           (* ht: "14-JAN-82 14:20")
    (\GVOP \OP.NEWNAME (\CHECKNAME NAME)
	   (LIST (\CHECKNAME NEWNAME])

(REMOVEFORWARD
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.REMOVEFORWARD (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(REMOVEFRIEND
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.REMOVEFRIEND (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(REMOVEMAILBOX
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:48")
    (\GVOP \OP.REMOVEMAILBOX (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(REMOVEMEMBER
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:49")
    (\GVOP \OP.REMOVEMEMBER (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])

(REMOVEOWNER
  [LAMBDA (NAME STRING)            (* ht: "22-JAN-82 09:49")
    (\GVOP \OP.REMOVEOWNER (\CHECKNAME NAME)
	   (LIST (\CHECKSTRING STRING])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS SAFELY MACRO [(form name pw)
			(PROG ($id$ $soc$ $val$ ($name$ name)
				    ($pw$ pw))
			  LP  (if (NOT (if $name$
					   then (IDENTIFYCALLER $name$ $pw$)
					 else (IDENTIFYME)))
				  then (ERROR "can't authenticate"))
			      (if (NOT (SETQ $soc$ (\SAVEDREGSOCKET)))
				  then (GO LP))
			      (SETQ $id$ (fetch CONNID of $soc$))
			      (SETQ $val$ form)
			      (if [NOT (AND (SETQ $soc$ (\SAVEDREGSOCKET))
					    (EQUAL $id$ (fetch CONNID of $soc$]
				  then (printout T "[non-atomic, trying again]" T)
				       (GO LP)
				else (RETURN $val$])
)
(DEFINEQ

(MAKEKEY
  [LAMBDA (STRING)                 (* lmm "14-JAN-83 21:58")
                                   (* As per section 2 of the Grapevine Interface document)
    (bind J C (R ←(CREATEKEY)) for I from 0 while (SETQ C (NTHCHARCODE STRING (ADD1 I)))
       do (SETKEYBYTE R (SETQ J (IMOD I 8))
		      (LOGXOR (GETKEYBYTE R J)
			      (LOGAND (LLSH (COND
					      ((AND (IGEQ C (CHARCODE A))
						    (ILEQ C (CHARCODE Z)))
						(IPLUS (IDIFFERENCE C (CHARCODE A))
						       (CHARCODE a)))
					      (T C))
					    1)
				      255)))
       finally (RETURN R])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS KEYP MACRO ((X)
		      (ARRAYP X)))

(PUTPROPS CREATEKEY MACRO (NIL (ARRAY 8 (QUOTE (BITS 8))
				      0 1)))

(PUTPROPS CREATEKEY DMACRO (NIL (ARRAY 8 (QUOTE (BITS 8))
				       0 0)))

(PUTPROPS GETKEYBYTE MACRO ((KEY N)
			    (ELT KEY (ADD1 N))))

(PUTPROPS GETKEYBYTE DMACRO ((KEY N)
			     (ELT KEY N)))

(PUTPROPS SETKEYBYTE MACRO ((KEY N BYTE)
			    (SETA KEY (ADD1 N)
				  BYTE)))

(PUTPROPS SETKEYBYTE DMACRO ((KEY N BYTE)
			     (SETA KEY N BYTE)))
)




(* Constants for calling ISINLIST)



(RPAQQ \GVU.MEMBEROPS ((OP.ITSELF 0)
		       (OP.ITSREGISTRY 1)
		       (OP.MEMBERS 0)
		       (OP.OWNERS 1)
		       (OP.FRIENDS 2)
		       (OP.DIRECT 0)
		       (OP.CLOSURE 1)
		       (OP.UPARROW 2)))
(DECLARE: EVAL@COMPILE 

(RPAQQ OP.ITSELF 0)

(RPAQQ OP.ITSREGISTRY 1)

(RPAQQ OP.MEMBERS 0)

(RPAQQ OP.OWNERS 1)

(RPAQQ OP.FRIENDS 2)

(RPAQQ OP.DIRECT 0)

(RPAQQ OP.CLOSURE 1)

(RPAQQ OP.UPARROW 2)

(CONSTANTS (OP.ITSELF 0)
	   (OP.ITSREGISTRY 1)
	   (OP.MEMBERS 0)
	   (OP.OWNERS 1)
	   (OP.FRIENDS 2)
	   (OP.DIRECT 0)
	   (OP.CLOSURE 1)
	   (OP.UPARROW 2))
)
)



(* Higher-level Grapevine User primitives)

(DEFINEQ

(\GVOP
  [LAMBDA (OP name itemList READFN)                          (* bvm: "11-MAY-83 16:19")

          (* Supervises a registration database operation. Does the initial interaction, applies READFN to the input side of
	  \REG.SOCKET to collec tresults, and interprets same if necessary)


    (PROG (RC)
          (RETURN (SELECTC [SETQ RC (\ENQUIRE name (FUNCTION \GVOP1)
					      (CONS OP (CONS name itemList]
			   (\RC.DONE (COND
				       (READFN               (* I assume that no error protection is necessary here 
							     as we are guaranteed to have already successfully read 
							     something in \ENQUIRE)
					       (APPLY* READFN (fetch GVINSTREAM of \REG.SOCKET)))
				       (T T)))
			   (COND
			     ((NUMBERP RC)
			       (SELECTC RC
					(\RC.BADRNAME EC.BADRNAME)
					(\RC.NOCHANGE EC.NOCHANGE)
					(\RC.NOTALLOWED EC.NOTALLOWED)
					(\RC.BADPASSWORD EC.BADPASSWORD)
					(\RC.ALLDOWN EC.ALLDOWN)
					(SHOULDNT)))
			     (T RC])

(\GVOP1
  [NLAMBDA itemList                                          (* bvm: "11-MAY-83 16:14")
                                                             (* Tries to actually exchange some info with the server)
    (PROG (RESULT)
          (RETURN (COND
		    ([ERSETQ (PROG ((STREAM (fetch GVOUTSTREAM of \REG.SOCKET)))
			           (for e in itemList do (\SENDITEM STREAM e))
			           (BSPFORCEOUTPUT STREAM)
			           (SETQ RESULT (\RECEIVEWORD (fetch GVINSTREAM of \REG.SOCKET]
                                                             (* we ignore the name type and return the code part of 
							     the return code)
		      (LRSH RESULT 8))
		    (T 

          (* The usual causes for this are the stream is not in fact open despite our efforts to insure that it is, or that 
	  the other end has gone to sleep and the BSPIOTIMEOUT occurs. If this happens too often, \REG.IOTIMEOUT should be 
	  lengthened)


		       EC.STREAMLOST])

(\ENQUIRE
  [LAMBDA (NAME PROC ARGS)                                   (* bvm: "11-MAY-83 16:15")

          (* Attempt to accomplish some interaction with a reg. server. Implements the Taft/Birrell approach of first trying
	  anybody we're connected to, failing that trying the closest reg. server we can find, and only if that fails as 
	  well do we get down to basics and actually go thru the lookup procedure to find someone who knows what we need)


    (PROG (val)
      LP  [COND
	    (\REG.SOCKET                                     (* if we've got a socket, try first just using it.
							     Any failure other than rcWrongServer is real, as is 
							     success.)
			 (SELECTC (SETQ val (APPLY PROC ARGS))
				  (\RC.WRONGSERVER (GO FullStory))
				  [EC.STREAMLOST (AND \REG.SOCKET (\BSP.FLUSHINPUT (fetch GVINSTREAM
										      of \REG.SOCKET]
				  (RETURN val]

          (* here if no socket or the one we have loses -
	  in either case open a new one to (the closest of) any R-server at all)


          (COND
	    ((NOT (FINDREGSERVER REGROOT))
	      (RETURN EC.ALLDOWN)))                          (* try this guy -
							     he might know)
          (SELECTC (SETQ val (APPLY PROC ARGS))
		   (\RC.WRONGSERVER                          (* so we have to do it right after all))
		   (EC.STREAMLOST (GO Lose))
		   (RETURN val))
      FullStory
          (RETURN (COND
		    ((FINDREGSERVER (CONS (CDR NAME)
					  (QUOTE GV)))       (* last chance ...)
		      (SELECTC (SETQ val (APPLY PROC ARGS))
			       (\RC.WRONGSERVER \RC.BADRNAME)
			       (EC.STREAMLOST (GO Lose))
			       val))
		    (T EC.ALLDOWN)))
      Lose(AND \REG.SOCKET (\BSP.FLUSHINPUT (fetch GVINSTREAM of \REG.SOCKET)))
          (GO LP])
)



(* These functions check and/or coerce arguments to server operations)

(DEFINEQ

(\CHECKKEY
  [LAMBDA (KEY)                    (* lmm "14-JAN-83 21:59")
    (COND
      ((KEYP KEY)
	KEY)
      (T (MAKEKEY KEY])

(\CHECKNAME
  [LAMBDA (NAME)                   (* lmm "14-JAN-83 20:34")
    (COND
      ((NOT NAME)
	(\NONAMEERR)))
    [COND
      ((NLISTP NAME)
	(SETQ NAME (\UNPACKREG NAME]
    (COND
      ((ILESSP (IPLUS (NCHARS (CAR NAME))
		      (NCHARS (CDR NAME)))
	       \MAXGVSTRING)       (* less than because the dot takes 1 more)
	NAME)
      (T (ERROR "name too long - must be < 65 chars" NAME])

(\CHECKSTAMP
  [LAMBDA (STAMP)                  (* lmm "23-JAN-83 18:23")
    (COND
      [STAMP (COND
	       ((type? TIMESTAMP STAMP)
		 STAMP)
	       (T (ERROR "not a time stamp" STAMP]
      (T (create TIMESTAMP])

(\CHECKSTRING
  [LAMBDA (STRING)                 (* Beau " 7-SEP-82 13:43")
    (SELECTQ (TYPENAME STRING)
	     (STRINGP)
	     [LISTP (COND
		      [(AND (CAR STRING)
			    (LITATOM (CAR STRING))
			    (CDR STRING)
			    (LITATOM (CDR STRING)))
			(SETQ STRING (CONCAT (CAR STRING)
					     (QUOTE %.)
					     (CDR STRING]
		      (T (ERROR "bad string arg" STRING]
	     (LITATOM (SETQ STRING (MKSTRING STRING)))
	     (ERROR "bad string arg" STRING))
    (COND
      ((IGREATERP (NCHARS STRING)
		  \MAXGVSTRING)
	(ERROR "string too long" STRING))
      (T STRING])

(\NONAMEERR
  [LAMBDA NIL                      (* ht: "13-JAN-82 12:05")
    (ERROR "must have name for GV user op"])

(\UNPACKREG
  [LAMBDA (REG)                    (* lmm "15-JAN-83 23:19")
    (PROG ((PPOS (STRPOS "." REG)))
          (RETURN (COND
		    [PPOS (CONS (SUBATOM REG 1 (SUB1 PPOS))
				(SUBATOM REG (ADD1 PPOS]
		    ((STRPOS "@" REG)
		      (CONS (MKATOM REG)
			    (QUOTE ArpaGateway)))
		    (T (CONS (MKATOM REG)
			     DEFAULTREGISTRY])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(DATATYPE TIMESTAMP ((TIMEHOST BITS 16)
		     (TIMETIME FIXP)))
]
(/DECLAREDATATYPE (QUOTE TIMESTAMP)
		  (QUOTE ((BITS 16)
			  FIXP)))
)
(/DECLAREDATATYPE (QUOTE TIMESTAMP)
		  (QUOTE ((BITS 16)
			  FIXP)))



(* Lower-level Grapevine User primitives)

(DEFINEQ

(\SENDITEM
  [LAMBDA (OUTSTREAM ITEM)                                   (* bvm: "11-MAY-83 16:29")
                                                             (* send out ITEM as determined by its type as per the 
							     specs in section 4.0 of the Grapevine Interface 
							     document)
    (COND
      ((FIXP ITEM)
	(\SENDWORD OUTSTREAM ITEM))
      [(OR (LITATOM ITEM)
	   (STRINGP ITEM))
	(COND
	  (ITEM (\SENDSTRING OUTSTREAM ITEM))
	  (T                                                 (* not a string at all but an empty string list)
	     (\SENDWORD OUTSTREAM 0]
      [(KEYP ITEM)
	(for I from 0 to 7 do (BOUT OUTSTREAM (GETKEYBYTE ITEM I]
      ((type? TIMESTAMP ITEM)
	(\SENDWORD OUTSTREAM (fetch TIMEHOST of ITEM))
	(\SENDWORD OUTSTREAM (LOGAND (fetch TIMETIME of ITEM)
				     65535))
	(\SENDWORD OUTSTREAM (LRSH (fetch TIMETIME of ITEM)
				   16)))
      [(LISTP ITEM)                                          (* may be a name pair, a string list, or a byte kludge)
	(COND
	  [(EQ (CAR ITEM)
	       \3BYTEKLUDGEKEY)                              (* somewhat miss-named now, this gives a way of sending 
							     small numbers as bytes instead of words)
	    (for b in (CDR ITEM) do (BOUT OUTSTREAM (LOGAND b 255]
	  [(LITATOM (CDR ITEM))                              (* an RName -
							     cons pair of two atoms)
	    (PROG (length)
	          [\SENDWORD OUTSTREAM (SETQ length (IPLUS 1 (NCHARS (CAR ITEM))
							   (NCHARS (CDR ITEM]
	          (\SENDWORD OUTSTREAM 0)
	          (PRIN3 (CAR ITEM)
			 OUTSTREAM)
	          (BOUT OUTSTREAM (CHARCODE %.))
	          (PRIN3 (CDR ITEM)
			 OUTSTREAM)
	          (COND
		    ((ODDP length)                           (* padding needed)
		      (BOUT OUTSTREAM 0]
	  (T                                                 (* string list)
	     [\SENDWORD OUTSTREAM (for e in ITEM sum (IPLUS 2 (FOLDHI (NCHARS e)
								      BYTESPERWORD]
	     (for e in ITEM do (\SENDSTRING OUTSTREAM e]
      (T (SHOULDNT])

(\SENDSTRING
  [LAMBDA (STREAM STRING)                                    (* bvm: "11-MAY-83 16:26")
    (PROG ((L (NCHARS STRING)))
          (COND
	    ((IGREATERP L \MAXGVSTRING)
	      (ERROR "string too long" STRING)
	      (RETURN)))
          (\SENDWORD STREAM L)
          (\SENDWORD STREAM 64)
          (PRIN3 STRING STREAM)
          (COND
	    ((ODDP L)                                        (* pad)
	      (BOUT STREAM 0])

(\SENDWORD
  [LAMBDA (OUTSTREAM WORD)                                   (* bvm: "11-MAY-83 15:10")
    (\WOUT OUTSTREAM WORD])
)
(DEFINEQ

(\RECEIVEBOOL
  [LAMBDA (STREAM)                                           (* bvm: "11-MAY-83 14:51")
    (SELECTQ (BIN STREAM)
	     (1 T)
	     (0 NIL)
	     (SHOULDNT])

(\RECEIVECLIST
  [LAMBDA (STREAM)                                           (* bvm: "11-MAY-83 14:57")
                                                             (* receive a list of components)
    (\RECEIVESTAMP STREAM T)
    (to (\RECEIVEWORD STREAM) collect (\RECEIVECOMPONENT STREAM])

(\RECEIVECOMPONENT
  [LAMBDA (STREAM)                                           (* bvm: "11-MAY-83 14:57")
                                                             (* receive a component -
							     just a list of words)
    (to (\RECEIVEWORD STREAM) collect (\RECEIVEWORD STREAM])

(\RECEIVERLIST
  [LAMBDA (INSTREAM)                                         (* bvm: "11-MAY-83 15:58")
                                                             (* receive a list of RNames -
							     prefix the result with the time STAMP)
    (bind STRLEN (STAMP ←(\RECEIVESTAMP INSTREAM))
	  (NWORDS ←(\RECEIVEWORD INSTREAM)) while (IGREATERP NWORDS 0)
       collect [PROG1 (\RECEIVESTRING INSTREAM (SETQ STRLEN (\RECEIVEWORD INSTREAM)))
                                                             (* mind the possible odd length, and add 2 NWORDS for 
							     STRLEN and max)
		      (SETQ NWORDS (IDIFFERENCE NWORDS (IPLUS (FOLDHI STRLEN BYTESPERWORD)
							      2]
       finally (RETURN (CONS STAMP $$VAL])

(\RECEIVERNAME
  [LAMBDA (INSTREAM)                                         (* bvm: "11-MAY-83 15:59")
    (\RECEIVESTRING INSTREAM (\RECEIVEWORD INSTREAM])

(\RECEIVESTAMP
  [LAMBDA (STREAM OLDSTAMP)                                  (* bvm: "11-MAY-83 14:54")
    [COND
      ((EQ OLDSTAMP T)
	(\WIN STREAM)
	(\WIN STREAM)
	(\WIN STREAM)
	T)
      (T [COND
	   ((NOT (type? TIMESTAMP OLDSTAMP))
	     (SETQ OLDSTAMP (create TIMESTAMP]
	 (replace TIMEHOST of OLDSTAMP with (\WIN STREAM))
	 (replace TIMETIME of OLDSTAMP with (LOGOR (\WIN STREAM)
						   (LLSH (\WIN STREAM)
							 16]
    OLDSTAMP])

(\RECEIVESTRING
  [LAMBDA (STREAM LENGTH)                                    (* bvm: "11-MAY-83 14:52")
    (COND
      ((IGREATERP LENGTH \MAXGVSTRING)
	(ERROR "stream must be confused - string too long" LENGTH))
      (T (\RECEIVEWORD STREAM)                               (* ignore maxLength)
	 (CONCATLIST (for i from 1 to LENGTH collect (FCHARACTER (BIN STREAM))
			finally (COND
				  ((ODDP LENGTH)             (* read padding)
				    (BIN STREAM])

(\RECEIVEWORD
  [LAMBDA (SOCKET)                 (* ht: "11-JAN-82 17:46")
    (LOGOR (LSH (BSPBIN SOCKET)
		8)
	   (BSPBIN SOCKET])
)
(DEFINEQ

(FINDREGSERVER
  [LAMBDA (REGISTRY ERRORFLG)                                (* bvm: "11-MAY-83 16:13")
                                                             (* Find a registration server for REGISTRY -
							     the closest one available)
    (PROG (NEWSOC)
          [COND
	    ((NLISTP REGISTRY)
	      (SETQ REGISTRY (\UNPACKREG REGISTRY]
          (COND
	    ((SETQ NEWSOC (OPENCLOSESTSOCKET (LOCATESOCKETS REGISTRY ERRORFLG)
					     \REG.SERVERPOLLINGSOC \REG.SERVERENQUIRYSOC 
					     \REG.IOTIMEOUT))
	      (RETURN (SETQ \REG.SOCKET NEWSOC)))
	    (ERRORFLG (ERROR "Couldn't open connection for" REGISTRY])

(LOCATESOCKETS
  [LAMBDA (SITE ERRORFLG)          (* ht: "22-JAN-82 13:17")

          (* get a list of sockets for a SITE -
	  a three step process (except for GV.GV) -
	  find the members of the site, find the connect sites for each, turn those into sockets)


    (COND
      ((EQUAL SITE REGROOT)        (* treat the root -
				   "GV.GV" -
				   specially)
	(ETHERPORT REGROOTNLSNAME ERRORFLG T))
      (T (bind cn for rName in [CDR (OR (LISTP (READMEMBERS SITE))
					(COND
					  (ERRORFLG (ERROR "Not a valid site" SITE]
	    join (OR (AND (SETQ cn (STRINGP (READCONNECT rName)))
			  (ETHERPORT cn NIL T))
		     (ETHERPORT rName NIL T)
		     (COND
		       (ERRORFLG (HELP "Can't look up connect name" (CONS rName cn])

(\KILLSOCKET
  [LAMBDA (SOC)                                              (* bvm: "11-MAY-83 16:16")
    (SELECTQ (SYSTEMTYPE)
	     (D (ENDBSPSTREAM (fetch GVINSTREAM of SOC)))
	     (CLOSECONNECTION SOC])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \RECEIVEWORD MACRO (= . \WIN))

(PUTPROPS \SENDWORD MACRO (= . \WOUT))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ \GV.SSLENGTH 64)

(RPAQQ \MAXGVSTRING 64)

(RPAQQ \REG.SERVERENQUIRYSOC 40)

(RPAQQ \REG.SERVERPOLLINGSOC 42)

(CONSTANTS (\GV.SSLENGTH 64)
	   (\MAXGVSTRING 64)
	   (\REG.SERVERENQUIRYSOC 40)
	   (\REG.SERVERPOLLINGSOC 42))
)
)

(RPAQQ DEFAULTREGISTRY PA)

(RPAQQ REGROOT (GV . GV))

(RPAQ REGROOTNLSNAME "GrapevineRServer")

(RPAQQ \3BYTEKLUDGEKEY $$3byte$$)

(RPAQQ \REG.IOTIMEOUT 30000)

(RPAQQ \REG.SOCKET NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS DEFAULTREGISTRY REGROOT REGROOTNLSNAME \3BYTEKLUDGEKEY \REG.IOTIMEOUT 
	  \REG.SOCKET)
)



(* Various constant codes)




(* Grapevine User Protocol Op Codes)

(DECLARE: DOEVAL@COMPILE DONTCOPY 

(RPAQQ \GV.OPS ((\OP.GVEXPAND 1)
		(\OP.READMEMBERS 2)
		(\OP.READOWNERS 3)
		(\OP.READFRIENDS 4)
		(\OP.READENTRY 5)
		(\OP.CHECKSTAMP 6)
		(\OP.READCONNECT 7)
		(\OP.READREMARK 8)
		(\OP.AUTHENTICATE 9)
		(\OP.IDENTIFYCALLER 33)
		(\OP.ISMEMBERDIRECT 40)
		(\OP.ISOWNERDIRECT 41)
		(\OP.ISFRIENDDIRECT 42)
		(\OP.ISMEMBERCLOSURE 43)
		(\OP.ISOWNERCLOSURE 44)
		(\OP.ISFRIENDCLOSURE 45)
		(\OP.ISINLIST 46)
		(\OP.CREATEINDIVIDUAL 12)
		(\OP.DELETEINDIVIDUAL 13)
		(\OP.CREATEGROUP 14)
		(\OP.DELETEGROUP 15)
		(\OP.CHANGEPASSWORD 16)
		(\OP.CHANGECONNECT 17)
		(\OP.CHANGEREMARK 18)
		(\OP.ADDMEMBER 19)
		(\OP.ADDMAILBOX 20)
		(\OP.ADDFORWARD 21)
		(\OP.ADDOWNER 22)
		(\OP.ADDFRIEND 23)
		(\OP.REMOVEMEMBER 24)
		(\OP.REMOVEMAILBOX 25)
		(\OP.REMOVEFORWARD 26)
		(\OP.REMOVEOWNER 27)
		(\OP.REMOVEFRIEND 28)
		(\OP.ADDSELF 29)
		(\OP.REMOVESELF 30)
		(\OP.ADDLISTOFMEMBERS 31)
		(\OP.NEWNAME 32)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \OP.GVEXPAND 1)

(RPAQQ \OP.READMEMBERS 2)

(RPAQQ \OP.READOWNERS 3)

(RPAQQ \OP.READFRIENDS 4)

(RPAQQ \OP.READENTRY 5)

(RPAQQ \OP.CHECKSTAMP 6)

(RPAQQ \OP.READCONNECT 7)

(RPAQQ \OP.READREMARK 8)

(RPAQQ \OP.AUTHENTICATE 9)

(RPAQQ \OP.IDENTIFYCALLER 33)

(RPAQQ \OP.ISMEMBERDIRECT 40)

(RPAQQ \OP.ISOWNERDIRECT 41)

(RPAQQ \OP.ISFRIENDDIRECT 42)

(RPAQQ \OP.ISMEMBERCLOSURE 43)

(RPAQQ \OP.ISOWNERCLOSURE 44)

(RPAQQ \OP.ISFRIENDCLOSURE 45)

(RPAQQ \OP.ISINLIST 46)

(RPAQQ \OP.CREATEINDIVIDUAL 12)

(RPAQQ \OP.DELETEINDIVIDUAL 13)

(RPAQQ \OP.CREATEGROUP 14)

(RPAQQ \OP.DELETEGROUP 15)

(RPAQQ \OP.CHANGEPASSWORD 16)

(RPAQQ \OP.CHANGECONNECT 17)

(RPAQQ \OP.CHANGEREMARK 18)

(RPAQQ \OP.ADDMEMBER 19)

(RPAQQ \OP.ADDMAILBOX 20)

(RPAQQ \OP.ADDFORWARD 21)

(RPAQQ \OP.ADDOWNER 22)

(RPAQQ \OP.ADDFRIEND 23)

(RPAQQ \OP.REMOVEMEMBER 24)

(RPAQQ \OP.REMOVEMAILBOX 25)

(RPAQQ \OP.REMOVEFORWARD 26)

(RPAQQ \OP.REMOVEOWNER 27)

(RPAQQ \OP.REMOVEFRIEND 28)

(RPAQQ \OP.ADDSELF 29)

(RPAQQ \OP.REMOVESELF 30)

(RPAQQ \OP.ADDLISTOFMEMBERS 31)

(RPAQQ \OP.NEWNAME 32)

(CONSTANTS (\OP.GVEXPAND 1)
	   (\OP.READMEMBERS 2)
	   (\OP.READOWNERS 3)
	   (\OP.READFRIENDS 4)
	   (\OP.READENTRY 5)
	   (\OP.CHECKSTAMP 6)
	   (\OP.READCONNECT 7)
	   (\OP.READREMARK 8)
	   (\OP.AUTHENTICATE 9)
	   (\OP.IDENTIFYCALLER 33)
	   (\OP.ISMEMBERDIRECT 40)
	   (\OP.ISOWNERDIRECT 41)
	   (\OP.ISFRIENDDIRECT 42)
	   (\OP.ISMEMBERCLOSURE 43)
	   (\OP.ISOWNERCLOSURE 44)
	   (\OP.ISFRIENDCLOSURE 45)
	   (\OP.ISINLIST 46)
	   (\OP.CREATEINDIVIDUAL 12)
	   (\OP.DELETEINDIVIDUAL 13)
	   (\OP.CREATEGROUP 14)
	   (\OP.DELETEGROUP 15)
	   (\OP.CHANGEPASSWORD 16)
	   (\OP.CHANGECONNECT 17)
	   (\OP.CHANGEREMARK 18)
	   (\OP.ADDMEMBER 19)
	   (\OP.ADDMAILBOX 20)
	   (\OP.ADDFORWARD 21)
	   (\OP.ADDOWNER 22)
	   (\OP.ADDFRIEND 23)
	   (\OP.REMOVEMEMBER 24)
	   (\OP.REMOVEMAILBOX 25)
	   (\OP.REMOVEFORWARD 26)
	   (\OP.REMOVEOWNER 27)
	   (\OP.REMOVEFRIEND 28)
	   (\OP.ADDSELF 29)
	   (\OP.REMOVESELF 30)
	   (\OP.ADDLISTOFMEMBERS 31)
	   (\OP.NEWNAME 32))
)




(* Grapevine response codes)



(RPAQQ \GV.RESPONSES ((\RC.DONE 0)
		      (\RC.NOCHANGE 1)
		      (\RC.OUTOFDATE 2)
		      (\RC.NOTALLOWED 3)
		      (\RC.BADOPERATION 4)
		      (\RC.BADPROTOCOL 5)
		      (\RC.BADRNAME 6)
		      (\RC.BADPASSWORD 7)
		      (\RC.WRONGSERVER 8)
		      (\RC.ALLDOWN 9)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \RC.DONE 0)

(RPAQQ \RC.NOCHANGE 1)

(RPAQQ \RC.OUTOFDATE 2)

(RPAQQ \RC.NOTALLOWED 3)

(RPAQQ \RC.BADOPERATION 4)

(RPAQQ \RC.BADPROTOCOL 5)

(RPAQQ \RC.BADRNAME 6)

(RPAQQ \RC.BADPASSWORD 7)

(RPAQQ \RC.WRONGSERVER 8)

(RPAQQ \RC.ALLDOWN 9)

(CONSTANTS (\RC.DONE 0)
	   (\RC.NOCHANGE 1)
	   (\RC.OUTOFDATE 2)
	   (\RC.NOTALLOWED 3)
	   (\RC.BADOPERATION 4)
	   (\RC.BADPROTOCOL 5)
	   (\RC.BADRNAME 6)
	   (\RC.BADPASSWORD 7)
	   (\RC.WRONGSERVER 8)
	   (\RC.ALLDOWN 9))
)




(* Response codes the user sees)



(RPAQQ \GVU.RESPONSES ((EC.STREAMLOST (QUOTE StreamLost))
		       (EC.ALLDOWN (QUOTE AllDown))
		       (EC.NOCHANGE (QUOTE NoChange))
		       (EC.BADRNAME (QUOTE BadRName))
		       (EC.BADPASSWORD (QUOTE BadPassword))
		       (EC.NOTALLOWED (QUOTE NotAllowed))))
(DECLARE: EVAL@COMPILE 

(RPAQQ EC.STREAMLOST StreamLost)

(RPAQQ EC.ALLDOWN AllDown)

(RPAQQ EC.NOCHANGE NoChange)

(RPAQQ EC.BADRNAME BadRName)

(RPAQQ EC.BADPASSWORD BadPassword)

(RPAQQ EC.NOTALLOWED NotAllowed)

(CONSTANTS (EC.STREAMLOST (QUOTE StreamLost))
	   (EC.ALLDOWN (QUOTE AllDown))
	   (EC.NOCHANGE (QUOTE NoChange))
	   (EC.BADRNAME (QUOTE BadRName))
	   (EC.BADPASSWORD (QUOTE BadPassword))
	   (EC.NOTALLOWED (QUOTE NotAllowed)))
)
)



(* Functions for trying to make connection to closest by hopcount and responsiveness)

(DEFINEQ

(OPENCLOSESTSOCKET
  [LAMBDA (PORTLIST POLLSOC CONNSOC TIMEOUT)                 (* bvm: "11-MAY-83 15:24")

          (* Open a BSP connection with the "closest" respondant on portList. EchoMe polling to determine responsiveness is 
	  to pollSoc, connection will go to connSoc. We poll in order from nearest to farest by hop order, use broadcast on 
	  local net if appropriate, and hope not to engage too many folks before the real thing comes along.
	  The basic structure of this is owed to Taft)


    (PROG (PUP SOC CNTIME BETWEENPROBE NEXTPORT PORT VAL LOCALFLG (MYNET (\LOCALPUPNETNUMBER)))
          [COND
	    ([SETQ PORTLIST (for PORT in PORTLIST collect PORT
			       unless (COND
					((AND POLLSOC (EQ (fetch PUPNET# of (CAR PORT))
							  MYNET))
					  (SETQ LOCALFLG T]
	      (SETQ PORTLIST (SORT.PUPHOSTS.BY.DISTANCE PORTLIST]
          (COND
	    [LOCALFLG                                        (* if there were some local hosts on the list, remove 
							     them and add a broadcast port)
		      (push PORTLIST (LIST (create PUPADDRESS
						   PUPNET# ← MYNET
						   PUPHOST# ← 0]
	    ((NULL PORTLIST)
	      (RETURN)))
          (SETQ SOC (\GETMISCSOCKET))
          (SETQ CNTIME (SETUPTIMER \CONNECTTIMEOUT))
          (SETQ NEXTPORT PORTLIST)
          (DISCARDPUPS SOC)                                  (* clear out anything left over from other activities)
          (RETURN (do [COND
			((OR (NULL BETWEENPROBE)
			     (TIMEREXPIRED? BETWEENPROBE))
			  [SETQ PORT (PROG1 (CAR NEXTPORT)
					    (SETQ NEXTPORT (OR (CDR NEXTPORT)
							       PORTLIST]
			  (SETQ PUP (ALLOCATE.PUP))
			  (SETUPPUP PUP (CAR PORT)
				    (OR POLLSOC (CDR PORT)
					\DEFAULTPOLLINGSOC)
				    \PT.ECHOME NIL SOC (QUOTE FREE))
			  (SENDPUP SOC PUP)
			  (SETQ BETWEENPROBE (SETUPTIMER \BETWEENPROBEDELAY BETWEENPROBE]
		      (BLOCK)
		      (COND
			((AND (SETQ PUP (GETPUP SOC))
			      (EQ (fetch PUPTYPE of PUP)
				  \PT.IAMECHO)
			      (SETQ VAL (\OPENGVCONNECTION (CONS (fetch PUPSOURCE of PUP)
								 (OR CONNSOC (fetch PUPSOURCESOCKET
										of PUP)))
							   TIMEOUT)))
			  (RETURN VAL)))
		     repeatuntil (TIMEREXPIRED? CNTIME])

(\OPENGVCONNECTION
  [LAMBDA (FRNSOCKET TIMEOUT)                                (* bvm: "11-MAY-83 15:23")
    (PROG [(INSTREAM (CREATEBSPSTREAM FRNSOCKET NIL NIL TIMEOUT NIL (FUNCTION \KILL.RSOCKET]
          (RETURN (AND INSTREAM (CONS INSTREAM (BSPOUTPUTSTREAM INSTREAM])

(\KILL.RSOCKET
  [LAMBDA (BSPSTREAM)                                        (* bvm: "11-MAY-83 15:26")
                                                             (* Called when BSPSTREAM is killed)
    (COND
      ((EQ BSPSTREAM (fetch GVINSTREAM of \REG.SOCKET))
	(SETQ \REG.SOCKET NIL))
      ((EQ BSPSTREAM (fetch GVINSTREAM of \MAILSOCKET))
	(SETQ \MAILSOCKET NIL))
      ((EQ BSPSTREAM (fetch GVINSTREAM of \RMAILSOCKET))
	(SETQ \RMAILSOCKET NIL])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD GVCONNECTION (GVINSTREAM . GVOUTSTREAM))
]

(DECLARE: EVAL@COMPILE 

(RPAQQ \DEFAULTPOLLINGSOC 5)

(CONSTANTS (\DEFAULTPOLLINGSOC 5))
)
)

(RPAQQ \BETWEENPROBEDELAY 100)

(RPAQQ \CONNECTTIMEOUT 5000)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \BETWEENPROBEDELAY \CONNECTTIMEOUT \EchosFrom \TIMEOUTKEY)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
[COND ((NOT (GETD (QUOTE SORT.PUPHOSTS.BY.DISTANCE)))
       (FILESLOAD ROUTER)
       (/MOVD (QUOTE HOPORDER)
	      (QUOTE SORT.PUPHOSTS.BY.DISTANCE]
)
(DEFINEQ

(BSPWIN
  [LAMBDA (X)                      (* lmm "14-JAN-83 22:11")
    (LOGOR (LLSH (BSPBIN X)
		 8)
	   (BSPBIN X])
)
(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY 
(SELECTQ (COMPILEMODE)
	 (D (FILESLOAD (LOADCOMP)
		       PUP BSP))
	 (PDP-10 (FILESLOAD (LOADCOMP)
			    PUP10 BSPAUX))
	 NIL)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA \GVOP1)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(PUTPROPS GRAPEVINE COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3672 6496 (AUTHENTICATE 3682 . 3849) (CHECKSTAMP 3851 . 4051) (GV.EXPAND 4053 . 4483) (
IDENTIFYCALLER 4485 . 4656) (IDENTIFYME 4658 . 4994) (ISINLIST 4996 . 5338) (READCONNECT 5340 . 5512) 
(READENTRY 5514 . 5712) (READFRIENDS 5714 . 5916) (READMEMBERS 5918 . 6120) (READOWNERS 6122 . 6322) (
READREMARK 6324 . 6494)) (6545 9911 (ADDFORWARD 6555 . 6724) (ADDFRIEND 6726 . 6893) (ADDLISTOFMEMBERS
 6895 . 7415) (ADDMAILBOX 7417 . 7586) (ADDMEMBER 7588 . 7755) (ADDOWNER 7757 . 7922) (CHANGEPASSWORD 
7924 . 8095) (CHANGEREMARK 8097 . 8270) (CREATEGROUP 8272 . 8407) (CREATEINDIVIDUAL 8409 . 8584) (
DELETEGROUP 8586 . 8721) (DELETEINDIVIDUAL 8723 . 8868) (NEWNAME 8870 . 9032) (REMOVEFORWARD 9034 . 
9209) (REMOVEFRIEND 9211 . 9384) (REMOVEMAILBOX 9386 . 9561) (REMOVEMEMBER 9563 . 9736) (REMOVEOWNER 
9738 . 9909)) (10580 11200 (MAKEKEY 10590 . 11198)) (12477 16353 (\GVOP 12487 . 13497) (\GVOP1 13499
 . 14527) (\ENQUIRE 14529 . 16351)) (16433 18303 (\CHECKKEY 16443 . 16584) (\CHECKNAME 16586 . 17002) 
(\CHECKSTAMP 17004 . 17238) (\CHECKSTRING 17240 . 17823) (\NONAMEERR 17825 . 17950) (\UNPACKREG 17952
 . 18301)) (18629 21393 (\SENDITEM 18639 . 20797) (\SENDSTRING 20799 . 21255) (\SENDWORD 21257 . 21391
)) (21394 24313 (\RECEIVEBOOL 21404 . 21583) (\RECEIVECLIST 21585 . 21908) (\RECEIVECOMPONENT 21910 . 
22229) (\RECEIVERLIST 22231 . 23012) (\RECEIVERNAME 23014 . 23186) (\RECEIVESTAMP 23188 . 23671) (
\RECEIVESTRING 23673 . 24169) (\RECEIVEWORD 24171 . 24311)) (24314 25993 (FINDREGSERVER 24324 . 24979)
 (LOCATESOCKETS 24981 . 25767) (\KILLSOCKET 25769 . 25991)) (31779 34848 (OPENCLOSESTSOCKET 31789 . 
34070) (\OPENGVCONNECTION 34072 . 34354) (\KILL.RSOCKET 34356 . 34846)) (35436 35574 (BSPWIN 35446 . 
35572)))))
STOP