(FILECREATED "18-JUN-83 16:48:27" {PHYLUM}<LISPCORE>SOURCES>EVALSERVER.;19
 79057  

      changes to:  (FNS \P4S.FOOT PRINT.INTO.PUP \P4S.PERCHAR)
		   (VARS EVALSERVERCOMS)

      previous date: "14-JUN-83 23:02:52" {PHYLUM}<LISPCORE>SOURCES>EVALSERVER.;18)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT EVALSERVERCOMS)

(RPAQQ EVALSERVERCOMS
 ((LOCALVARS . T)
	(COMS (* Generally useful utilities)
	      (FNS ORDINALSUFFIXSTRING PRIN4.INTO.STRING \P4S.FOOT \P4S.PERCHAR \UNTCONC)
	      (MACROS \UNTCONC)
	      (DECLARE: DONTCOPY (MACROS \FILLINSTRPTR SETQ.IFNN))
	      (GLOBALRESOURCES \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER)
	      (COMS (* STREAM interface to Read and Write to random memory)
		    (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS BASEBYTESTREAM))
		    (FNS \BASEBYTES.IO.INIT \MAKEBASEBYTESTREAM \BASEBYTES.NAME.FROM.STREAM 
			 \BASEBYTES.BLOCKIO)
		    (GLOBALVARS \BASEBYTESDEVICE)
		    (P (\BASEBYTES.IO.INIT))))
	(COMS (* Pup/Net assistance)
	      (DECLARE: DONTCOPY (MACROS \ALLOCATE.BIGPUP HOSTNUMBERP PROBABLYSOCKETP 
					 HOST#.FROM.ADDRESS NTWK#.FROM.ADDRESS))
	      (MACROS #PUPDATABYTES #PUPDATABYTES.LEFT)
	      (GLOBALRESOURCES (\PIP.SCRATCHSPTR (ALLOCSTRING 0))
			       (\GFP.TIMER (SETUPTIMER 0))
			       \READPUPSTREAM \WRITEPUPSTREAM)
	      (FNS READ.FROM.PUP PRINT.INTO.PUP \ES.LOCALHOSTNUMBER \HNM.MEMBER \NORMALIZEHOSTNUM 
		   \BROADCASTADDRESS.ON.MYNET \ES.PUP2DEADSOCKET? \GETFILTEREDPUP \SENDUNFILTEREDPUP)
	      (VARS (\BROADCASTADDRESS.ON.MYNET NIL)
		    (\ES.LOCALHOSTNUMBER NIL))
	      (GLOBALVARS \PUPSOCKETS \BROADCASTADDRESS.ON.MYNET \ES.LOCALHOSTNUMBER)
	      (ALISTS (PUPPRINTMACROS 4)))
	(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TRANSACTIONNOTE)
		  (MACROS TYPE\ID.OF.PUP? CONNECTIONIDP TRACEAPUP 1BYTETOPUP))
	(CONSTANTS (\SOCKET#.EVALREQUEST 668)
		   (\PT.EVALREQUEST 200)
		   (\PT.ACKNOWLEDGE 201)
		   (\PT.EVALRESPONSE 202)
		   (\PT.EVALREQUEST.NORESULT 203)
		   (\PT.EVALERROR 204)
		   (\PT.EVALREQUEST.CERTIFY 205))
	(INITVARS (EvalServerClientHosts NIL)
		  (EvalServerGaggedHosts (QUOTE (T)))
		  (\EVALREQUEST.SOCKET NIL)
		  (\ES.MESSAGESTREAM NIL)
		  (\ES.PURGEINTERVAL.SECS 180)
		  (\ES.PENDINGSERVICES NIL)
		  (\ES.COMPLETEDSERVICES NIL)
		  (\PUPINQUEUE NIL)
		  (\PUPINQUEUE.MAXLENGTH 50)
		  (\PUPINQUEUE.MAXAGE (TIMES 6 60 1000))
		  (\ES.LOSTSOCKETSLST NIL)
		  (\ES.CurrentlyPendingService NIL))
	(GLOBALVARS \PUPINQUEUE \PUPINQUEUE.MAXLENGTH \PUPINQUEUE.MAXAGE \EVALREQUEST.SOCKET 
		    \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS \ES.COMPLETEDSERVICES 
		    \ES.PENDINGSERVICES \ES.LOSTSOCKETSLST)
	(SPECVARS \ES.CurrentlyPendingService FluidVariableForInterlospLissage)
	(FNS REMOTEVAL \ES.EXITREMOTEVAL REMOTEABORT REMOTEAPPLY \ES.APPLYQQ EVALSERVER \ES.LISTENER 
	     \ES.DO1THING \ES.ABORTQQ EVALSERVER.ABORT EVALSERVER.STATUS \ES.MakeClientHostInfo 
	     \ES.DELETE1PENDING \ES.ABORTPENDING \ES.PURGEOLDTHINGS)
	(COMS (* Things related to coordination of Broadcast case of REMOTEVAL)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS BROADAPNOTE))
	      (INITVARS (\ES.BroadSweepQ (LIST NIL))
			(\ES.BroadAppEVENT (CREATE.EVENT (QUOTE \ES.BroadAppEVENT))))
	      (GLOBALVARS \ES.BroadSweepQ \ES.BroadAppEVENT \ES.BroadAppSweeper)
	      (FNS \ES.BroadAppSweeper \ES.RejectApplicants \ES.ApplicantValid?))
	(P (push AFTERSYSOUTFORMS (QUOTE (PROGN (RPAQQ \BROADCASTADDRESS.ON.MYNET)
						(RPAQQ \ES.LOCALHOSTNUMBER)
						(RPAQQ \ES.LOSTSOCKETSLST)))))
	(ALISTS (PUPPRINTMACROS 200 202 203 204 205))
	(COMS (* Debugging aids)
	      (VARS (\ES.TRACE?)
		    (EVALSERVER.STATUS.WINDOW)
		    (\ES.LASTSTATUSLIST)
		    (\ES.IQMENU)
		    (\ES.RUNMENU)
		    (\ES.DONEMENU))
	      (FNS EVALSERVER.TRACE \ES.BUGGERTRACEWINDOW \ES.PRINTRACE)
	      (FNS EVALSERVER.STATUS.WINDOW \ES.STATUSW.GETITEMS \ES.STATUSW.SELECTEDFN 
		   \ES.STATUSW.HELDFN \ES.INVALIDATE.STATUSW \ES.UPDATE.STATUSW)
	      (DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS \ES.TRACE? EVALSERVER.STATUS.WINDOW 
							  \ES.LASTSTATUSLIST \ES.IQMENU \ES.RUNMENU 
							  \ES.DONEMENU)
			(CONSTANTS LIGHTGRAYSHADE FUZZYSHADE)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \ES.ABORTQQ 
										     \ES.APPLYQQ)
									      (NLAML \ES.ABORTPENDING 
										     \ES.DO1THING 
										     \ES.LISTENER)
									      (LAMA)))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)



(* Generally useful utilities)


(DEFINEQ

(ORDINALSUFFIXSTRING

  (LAMBDA (N)                                                (* JonL " 5-JAN-83 23:54")

    (SETQ N (IABS N))
    (if
 (AND (ILEQ 5 N)
	     (ILEQ N 20))
	then
 "th"
      else
 (SELECTC (SETQ N (IREMAINDER N 10))
		    (1 "st")
		    (2 "nd")
		    (3 "rd")
		    "th"))))

(PRIN4.INTO.STRING

  (LAMBDA (FORM MAX#CHARS.WANTED? OLDSTRING)                 (* JonL "27-MAY-83 17:51")


          (* FORM is someting to be prin4'd, MAX#CHARS.WANTED? if non-NULL is a limit on the permissible number of chars to 

	  be printed, OLDSTRING is a working buffer (NIL means cons one up, otherwise use one supplied by caller))



    (DECLARE
 (SPECVARS OLDSTRING))
    (PROG (CHARSLIST)
          (if
 (STRINGP OLDSTRING)
	      then
 (SETQ MAX#CHARS.WANTED? (IMIN (ffetch
 (STRINGP LENGTH) of
 OLDSTRING)
						 (OR (SMALLP MAX#CHARS.WANTED?)
						     MAX.SMALLP)))
	    else
 (SETQ OLDSTRING (ALLOCSTRING (if
 (SMALLPOSP MAX#CHARS.WANTED?)
						  then
 MAX#CHARS.WANTED?
						else
 (GLOBALRESOURCE (\P4S.SCRATCHLIST)
								     (SETQ \P4S.SCRATCHLIST
								       (DCHCON FORM \P4S.SCRATCHLIST 
									       T))
								     (SETQ CHARSLIST \P4S.SCRATCHLIST)
								     )
						     (ADD1 (SETQ MAX#CHARS.WANTED? (LENGTH CHARSLIST))
							   )))))
          (GLOBALRESOURCE (\P4S.STR.BYTEPOINTER)
			  (PROG ((P4STRPTR \P4S.STR.BYTEPOINTER)
				 (BASE (ffetch
 (STRINGP BASE) of
 OLDSTRING))
				 (OFFST (ffetch
 (STRINGP OFFST) of
 OLDSTRING))
				 (LEN (ffetch
 (STRINGP LENGTH) of
 OLDSTRING)))
			        (DECLARE
 (SPECVARS P4STRPTR))
                                                             (* P4STRPTR is used as a byte-pointer into OLDSTRING)

			        (\FILLINSTRPTR P4STRPTR BASE OFFST LEN)
			        (\P4S.FOOT
 FORM CHARSLIST)
			        (PROG ((#PRINTED (IDIFFERENCE (ffetch
 (STRINGP OFFST) of
 P4STRPTR)
							      OFFST)))
				      (if
 (AND (NOT (LISTP FORM))
					       (ILESSP #PRINTED LEN))
					  then
 (\PUTBASEBYTE BASE (IPLUS OFFST #PRINTED)
							     (CHARCODE SPACE))
					       (add
 #PRINTED 1))
				      (freplace
 (STRINGP LENGTH) of
 OLDSTRING with
 #PRINTED)))))
    OLDSTRING))

(\P4S.FOOT

  (LAMBDA (FORM CHARSLIST FN)                                (* JonL "18-JUN-83 16:08")


          (* Here's a "foot" to stand on while mapping over the characters in form. A "foot" is needed so that RETFROM can 

	  be used in the limiting case.)



    (if
 CHARSLIST
	then
 (MAPC CHARSLIST (QUOTE \P4S.PERCHAR))
      else
 (\MAPCHARS (QUOTE \P4S.PERCHAR)
		      FORM T))))

(\P4S.PERCHAR

  (LAMBDA (C)                                                (* JonL "18-JUN-83 16:08")

    (DECLARE
 (SPECVARS P4STRPTR))
    ((LAMBDA (OFFST NEWLEN)
	(OR (IGEQ NEWLEN 0)
	    (RETFROM (QUOTE \P4S.FOOT)))
	(\PUTBASEBYTE (ffetch
 (STRINGP BASE) of
 P4STRPTR)
		      OFFST C)
	(freplace
 (STRINGP LENGTH) of
 P4STRPTR with
 NEWLEN)
	(freplace
 (STRINGP OFFST) of
 P4STRPTR with
 (ADD1 OFFST)))
      (ffetch
 (STRINGP OFFST) of
 P4STRPTR)
      (SUB1 (ffetch
 (STRINGP LENGTH) of
 P4STRPTR)))))

(\UNTCONC

  (LAMBDA (QUEUE ITEM)                                       (* JonL "31-MAY-83 02:47")

    (if
 (NULL QUEUE)
	then
 NIL
      elseif
 (NLISTP QUEUE)
	then
 (\ILLEGAL.ARG QUEUE)
      elseif
 (NULL (CDR QUEUE))
	then
                                                 (* Darnd QUEUE ought to be empty if it has no last 

							     cell.)

	     (OR (NULL (CAR QUEUE))
		 (\ILLEGAL.ARG QUEUE))
	     NIL
      elseif
 (NLISTP (CAR QUEUE))
	then
 (\ILLEGAL.ARG QUEUE)
      else
 (\MACRO.MX (\UNTCONC
 QUEUE ITEM)))))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS \UNTCONC MACRO 
(OPENLAMBDA (QUEUE ITEM)
  (PROG ((\List (CAR QUEUE))
	 (\EndOfQ (CDR QUEUE))
	 \BackL)
        (DECLARE
 (LOCALVARS \List \EndOfQ \BackL))
    \UNTCONCloop
        (if
 (NLISTP \List)
	    then
 (RETURN)
	  elseif
 (EQ ITEM (CAR \List))
	    then
 (if
 \BackL
		     then
 (RPLACD \BackL (CDR \List))
		   else
 (RPLACA QUEUE (CDR \List)))
		 (if
 (EQ \List \EndOfQ)
		     then
 (RPLACD QUEUE \BackL))
		 (RETURN T)
	  else
 (SETQ \BackL \List))
        (pop
 \List)
        (GO \UNTCONCloop))))
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \FILLINSTRPTR MACRO 
(OPENLAMBDA (STRPTR STRBASE STROFFST STRLENGTH)
  (replace
 (STRINGP BASE) of
 STRPTR with
 STRBASE)
  (replace
 (STRINGP OFFST) of
 STRPTR with
 STROFFST)
  (replace
 (STRINGP LENGTH) of
 STRPTR with
 STRLENGTH)
  STRPTR))

(PUTPROPS SETQ.IFNN MACRO 
((VAR FORM)
  ((LAMBDA (\TempVar)
      (DECLARE
 (LOCALVARS \TempVar))
      (if
 \TempVar
	  then
 (SETQ VAR \TempVar))
      \TempVar)
    FORM)))
)
)

(RPAQQ \P4S.SCRATCHLIST
 NIL)

(RPAQQ \P4S.STR.BYTEPOINTER
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \P4S.SCRATCHLIST)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (LIST NIL)))
(PUTDEF (QUOTE \P4S.STR.BYTEPOINTER)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (ALLOCSTRING 0)))
)



(* STREAM interface to Read and Write to random memory)


(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD BASEBYTESTREAM
 STREAM (SUBRECORD STREAM)
			      (ACCESSFNS ((BIASOFFST (fetch
 (STREAM FW6) of
 DATUM)
						     (replace
 (STREAM FW6) of
 DATUM with
 NEWVALUE))
					  (BBSNCHARS (fetch
 (STREAM FW7) of
 DATUM)
						     (replace
 (STREAM FW7) of
 DATUM with
 NEWVALUE)))))
]
)
(DEFINEQ

(\BASEBYTES.IO.INIT

  (LAMBDA NIL
    (DECLARE
 (GLOBALVARS \BASECHARDEVICE))                   (* JonL "14-JUN-83 20:14")

    (SETQ \BASEBYTESDEVICE
      (create
 FDEV
	      DEVICENAME ←(QUOTE BASEBYTES)
	      RESETABLE ← T
	      RANDOMACCESSP ← T
	      PAGEMAPPED ← NIL
	      CLOSEFILE ←(FUNCTION NILL)
	      DELETEFILE ←(FUNCTION NILL)
	      DIRECTORYNAMEP ←(FUNCTION NILL)
	      EVENTFN ←(FUNCTION NILL)
	      GENERATEFILES ←(FUNCTION \GENERATENOFILES)
	      GETFILEINFO ←(FUNCTION NILL)
	      GETFILENAME ←(FUNCTION \BASEBYTES.NAME.FROM.STREAM)
	      HOSTNAMEP ←(FUNCTION NILL)
	      OPENFILE ←(FUNCTION \MAKEBASEBYTESTREAM)
	      READPAGES ←(FUNCTION NILL)
	      REOPENFILE ←(FUNCTION (LAMBDA (STREAM)         (* JonL "13-JUN-83 19:47")

		  (APPLY (QUOTE \MAKEBASEBYTESTREAM)
			 (NCONC1 (\BASEBYTES.NAME.FROM.STREAM
 STREAM)
				 STREAM))))
	      SETFILEINFO ←(FUNCTION NILL)
	      TRUNCATEFILE ←(FUNCTION (LAMBDA (STREAM I)
		  ((LAMBDA (I' BO EO)
		      (add
 I' BO)
		      (if
 (ILESSP I 0)
			  then
 (add
 I' EO))
		      (if
 (OR (ILESSP I BO)
			      (IGREATERP I' EO))
			  then
 (ERROR "Beyond end of byte range" I)
			else
 (replace
 EOFFSET of
 STREAM with
 I')))
		    I
		    (fetch
 BIASOFFST of
 STREAM)
		    (fetch
 EOFFSET of
 STREAM))))
	      WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
	      BIN ←(FUNCTION \PAGEDBIN)
	      BOUT ←(FUNCTION (LAMBDA (STREAM BYTE)
		  (PROG ((CO (fetch
 COFFSET of
 STREAM)))
		        (if
 (IGREATERP CO (fetch
 EOFFSET of
 STREAM))
			    then
 (ERROR "Attempt to write past end of bytes block"))
		        (RETURN (\PUTBASEBYTE (fetch
 CPPTR of
 STREAM)
					      (PROG1 CO (freplace
 COFFSET of
 STREAM
							   with
 (ADD1 CO)))
					      BYTE)))))
	      PEEKBIN ←(FUNCTION \PAGEDPEEKBIN)
	      READP ←(FUNCTION (LAMBDA (STREAM FLG)          (* JonL "13-JUN-83 19:06")

		  (PROG ((CO (fetch
 COFFSET of
 STREAM))
			 (#LEFT (fetch
 EOFFSET of
 STREAM)))
		        (add
 #LEFT (IMINUS CO))
		        (RETURN (OR (IGEQ #LEFT 2)
				    (if
 (ZEROP #LEFT)
					then
 NIL
				      elseif
 FLG
				      else
 (NEQ (\GETBASEBYTE (fetch
 CPPTR of
 STREAM)
							      (fetch
 COFFSET of
 STREAM))
						(CHARCODE CR))))))))
	      BACKFILEPTR ←(FUNCTION (LAMBDA (STREAM)
		  (AND (NEQ (fetch
 COFFSET of
 STREAM)
			    (fetch
 BIASOFFST of
 STREAM))
		       (\PAGEDBACKFILEPTR STREAM))))
	      SETFILEPTR ←(FUNCTION (LAMBDA (STREAM I)
		  ((LAMBDA (I')
		      (if
 (IGREATERP I'(fetch
 EOFFSET of
 STREAM))
			  then
 (ERROR "Beyond end of byte range" I)
			else
 (replace
 COFFSET of
 STREAM with
 I')))
		    (IPLUS I (fetch
 BIASOFFST of
 STREAM)))))
	      GETFILEPTR ←(FUNCTION (LAMBDA (STREAM)
		  (IDIFFERENCE (\PAGEDGETFILEPTR STREAM)
			       (fetch
 BIASOFFST of
 STREAM))))
	      GETEOFPTR ←(FUNCTION (LAMBDA (STREAM)
		  (IDIFFERENCE (\PAGEDGETEOFPTR STREAM)
			       (fetch
 BIASOFFST of
 STREAM))))
	      EOFP ←(FUNCTION (LAMBDA (STREAM)
		  (IGEQ (fetch
 COFFSET of
 STREAM)
			(fetch
 EOFFSET of
 STREAM))))
	      BLOCKIN ←(FUNCTION (LAMBDA (STREAM BASE OFFST N)
		  (\BASEBYTES.BLOCKIO
 STREAM BASE OFFST N (QUOTE INPUT))))
	      BLOCKOUT ←(FUNCTION (LAMBDA (STREAM BASE OFFST N)
		  (\BASEBYTES.BLOCKIO
 STREAM BASE OFFST N (QUOTE OUTPUT))))
	      RENAMEFILE ←(FUNCTION \ILLEGAL.DEVICEOP)))
    (\DEFINEDEVICE NIL \BASEBYTESDEVICE)))

(\MAKEBASEBYTESTREAM

  (LAMBDA (BASE OFFST LEN ACCESS OSTREAM)                    (* JonL "14-JUN-83 19:59")

                                                             (* If an error is to occur due to non-numeric arg or 

							     range restrictions, then let it happen outside the 

							     UNINTERRUPTABLY)

    (OR (AND (SMALLP OFFST)
	     (SMALLP LEN)
	     (SMALLP (add
 LEN OFFST)))
	(SHOULDNT "Currently can't support fixp-sized offsets"))
    (SELECTQ ACCESS
	     (NIL (SETQ ACCESS (QUOTE INPUT)))
	     ((INPUT OUTPUT BOTH))
	     (\ILLEGAL.ARG ACCESS))
    (OR (AND (type?
 STREAM OSTREAM)
	     (EQ (ffetch
 (STREAM DEVICE) of
 OSTREAM)
		 \BASEBYTESDEVICE))
	(SETQ OSTREAM
	  (create
 BASEBYTESTREAM
		  DEVICE ← \BASEBYTESDEVICE
		  USERCLOSEABLE ← NIL
		  USERVISIBLE ← NIL
		  EPAGE ← 0
		  BYTESIZE ← BITSPERBYTE
		  CPAGE ← 0
		  LINELENGTH ← 0
		  OUTCHARFN ←(FUNCTION (LAMBDA (STREAM CHAR)
		      (BOUT (SETQ STREAM (\DTEST STREAM (QUOTE STREAM)))
			    CHAR)
		      (add
 (ffetch
 BBSNCHARS of
 STREAM)
			   1))))))
    (UNINTERRUPTABLY
        (freplace
 CPPTR of
 OSTREAM with
 BASE)
	(freplace
 COFFSET of
 OSTREAM with
 (freplace
 BIASOFFST of
 OSTREAM with
 OFFST))
	(freplace
 CBUFSIZE of
 OSTREAM with
 (freplace
 EOFFSET of
 OSTREAM with
 LEN))
	(freplace
 BINABLE of
 OSTREAM with
 (SELECTQ ACCESS
						   ((INPUT BOTH)
						     T)
						   NIL))
	(freplace
 BOUTABLE of
 OSTREAM with
 (SELECTQ ACCESS
						    ((OUTPUT BOTH)
						      T)
						    NIL))
	(freplace
 ACCESSBITS of
 OSTREAM with
 (SELECTQ ACCESS
						      (INPUT ReadBit)
						      (OUTPUT OutputBits)
						      (BOTH BothBits)
						      NoBits))
	(freplace
 BBSNCHARS of
 OSTREAM with
 0))
    OSTREAM))

(\BASEBYTES.NAME.FROM.STREAM

  (LAMBDA (STREAM)                                           (* JonL "14-JUN-83 12:00")

    ((LAMBDA (BO)
	(LIST (fetch
 CPPTR of
 STREAM)
	      BO
	      (IDIFFERENCE (fetch
 EOFFSET of
 STREAM)
			   BO)))
      (fetch
 BIASOFFST of
 STREAM))))

(\BASEBYTES.BLOCKIO

  (LAMBDA (STREAM BASE OFFST N DIRECTION)                    (* JonL "14-JUN-83 11:57")

    (PROG ((SBASE (fetch
 CPPTR of
 STREAM))
	   (CO (fetch
 COFFSET of
 STREAM))
	   (EO (fetch
 EOFFSET of
 STREAM)))
          (if
 (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
	      then
 (if
 (EQ DIRECTION (QUOTE INPUT))
		       then
 (STREAMOP (QUOTE ENDOFSTREAMOP)
				      STREAM STREAM)
		     else
 (ERROR "Attempt to write past end of bytes block")))
          (replace
 COFFSET of
 STREAM with
 (IPLUS CO N))
          (if
 (EQ DIRECTION (QUOTE OUTPUT))
	      then
 (swap
 SBASE BASE)
		   (swap
 CO OFFST))
          (\MOVEBYTES SBASE CO BASE OFFST N))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \BASEBYTESDEVICE)
)
(\BASEBYTES.IO.INIT)



(* Pup/Net assistance)


(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \ALLOCATE.BIGPUP DMACRO 
(NIL
  ((LAMBDA (Pup)
      (replace
 (ETHERPACKET EPREQUEUE) of
 Pup with
 T)
      Pup)
    (ALLOCATE.PUP))))

(PUTPROPS HOSTNUMBERP MACRO 
((X) (FIXP X)))

(PUTPROPS PROBABLYSOCKETP MACRO 
((X)
  (TYPENAMEP X (QUOTE PUPSOCKET))))

(PUTPROPS HOST#.FROM.ADDRESS MACRO 
((X)
  (fetch
 (WORD LOBYTE) of
 X)))

(PUTPROPS NTWK#.FROM.ADDRESS MACRO 
((X)
  (fetch
 (WORD HIBYTE) of
 X)))
)
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS #PUPDATABYTES DMACRO 
((Pup)
  (IDIFFERENCE (FETCH
 PUPLENGTH OF
 Pup)
	       \PUPOVLEN)))

(PUTPROPS #PUPDATABYTES.LEFT DMACRO 
(OPENLAMBDA (Pup)
  (IDIFFERENCE \MAX.PUPLENGTH (#PUPDATABYTES Pup))))
)

(RPAQQ \PIP.SCRATCHSPTR
 NIL)

(RPAQQ \GFP.TIMER
 NIL)

(RPAQQ \READPUPSTREAM
 NIL)

(RPAQQ \WRITEPUPSTREAM
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \PIP.SCRATCHSPTR \GFP.TIMER \READPUPSTREAM \WRITEPUPSTREAM)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \PIP.SCRATCHSPTR)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (ALLOCSTRING 0)))
(PUTDEF (QUOTE \GFP.TIMER)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (SETUPTIMER 0)))
(PUTDEF (QUOTE \READPUPSTREAM)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (\MAKEBASEBYTESTREAM NIL 0 0 (QUOTE INPUT))))
(PUTDEF (QUOTE \WRITEPUPSTREAM)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (\MAKEBASEBYTESTREAM NIL 0 0 (QUOTE OUTPUT))))
)
(DEFINEQ

(READ.FROM.PUP

  (LAMBDA (PUP DATASTARTBYTE)                                (* JonL "14-JUN-83 18:26")

    (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET)))
    (GLOBALRESOURCE (\READPUPSTREAM)
		    (PROG ((PUPDATAOFFST (UNFOLD (IPLUS (FOLDLO (IDIFFERENCE \PUPOVLEN 2)
								BYTESPERWORD)
							(INDEXF (ffetch
 (ETHERPACKET EPBODY)
								   of
 PUP)))
						 BYTESPERWORD)))
		          (freplace
 CPPTR of
 \READPUPSTREAM with
 PUP)
		          (freplace
 CBUFSIZE of
 \READPUPSTREAM with
 (freplace
 EOFFSET of
 
										   \READPUPSTREAM
								       with
 (IPLUS PUPDATAOFFST
										   (#PUPDATABYTES
										     PUP))))
		          (freplace
 COFFSET of
 \READPUPSTREAM
			     with
 (freplace
 BIASOFFST of
 \READPUPSTREAM
				     with
 (IPLUS PUPDATAOFFST (OR (FIXP DATASTARTBYTE)
								  0))))
		          (RETURN (READ \READPUPSTREAM))))))

(PRINT.INTO.PUP

  (LAMBDA (FORM PUP DATASTARTBYTE PRINFN NOERRORFLG)         (* JonL "18-JUN-83 16:45")

    (SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET)))
    (PROG (WINP)
          (if
 (OR (NULL PRINFN)
		  (EQ PRINFN (QUOTE PRIN4)))
	      then
 (PROG (#LEFT #PRINTED)
		         (GLOBALRESOURCE (\PIP.SCRATCHSPTR)
					 (UNINTERRUPTABLY
                                             (SETQ #LEFT (if
 (NULL DATASTARTBYTE)
							     then
 (#PUPDATABYTES.LEFT PUP)
							   else
 (IDIFFERENCE \MAX.PUPLENGTH
									     (IPLUS \PUPOVLEN 
										    DATASTARTBYTE))))
					     (replace
 (STRINGP BASE) of
 \PIP.SCRATCHSPTR
						with
 (fetch
 PUPCONTENTS of
 PUP))
                                                             (* Make the scratch ptr look like a string pointer into 

							     the remaining data portion of the pup.)

					     (replace
 (STRINGP OFFST) of
 \PIP.SCRATCHSPTR
						with
 (OR (FIXP DATASTARTBYTE)
							 (#PUPDATABYTES PUP)))
					     (replace
 (STRINGP LENGTH) of
 \PIP.SCRATCHSPTR
						with
 #LEFT)
					     (PRIN4.INTO.STRING
 FORM #LEFT \PIP.SCRATCHSPTR)
                                                             (* Note that we don't really need the resultant string 

							     pointer -- only need to know if it all got "printed" 

							     into the pup.)

					     (SETQ #PRINTED (fetch
 (STRINGP LENGTH) of
 
										 \PIP.SCRATCHSPTR))
					     (if
 (ILESSP #PRINTED #LEFT)
						 then
 (add
 (fetch
 PUPLENGTH of
 PUP)
							   #PRINTED)
						      (SETQ WINP T)))))
	    else
 (NLSETQ (GLOBALRESOURCE (\WRITEPUPSTREAM)
					 (PROG ((PUPDATAOFFST
						  (UNFOLD (IPLUS (FOLDLO (IDIFFERENCE \PUPOVLEN 2)
									 BYTESPERWORD)
								 (INDEXF (ffetch
 (ETHERPACKET EPBODY)
									    of
 PUP)))
							  BYTESPERWORD)))
					       (freplace
 CPPTR of
 \WRITEPUPSTREAM with
 PUP)
					       (freplace
 CBUFSIZE of
 \WRITEPUPSTREAM
						  with
 (freplace
 EOFFSET of
 \WRITEPUPSTREAM
							  with
 (IPLUS \MAX.PUPLENGTH PUPDATAOFFST)))
					       (add
 PUPDATAOFFST (OR (FIXP DATASTARTBYTE)
								     (#PUPDATABYTES PUP)))
					       (freplace
 BIASOFFST of
 \WRITEPUPSTREAM with
 
										     PUPDATAOFFST)
					       (freplace
 COFFSET of
 \WRITEPUPSTREAM with
 PUPDATAOFFST)
					       (freplace
 BBSNCHARS of
 \WRITEPUPSTREAM with
 0)
					       (APPLY* (OR PRINFN (FUNCTION PRIN4))
						       FORM \WRITEPUPSTREAM)
					       (add
 (fetch
 PUPLENGTH of
 PUP)
						    (ffetch
 BBSNCHARS of
 \WRITEPUPSTREAM))
					       (SETQ WINP T)))))
          (if
 WINP
	      then
 (RETURN T)
	    elseif
 NOERRORFLG
	      then
 NIL
	    else
 (ERROR "Form too big to Print into pup" FORM)))))

(\ES.LOCALHOSTNUMBER

  (LAMBDA NIL                                                (* JonL "28-MAR-83 18:30")

    (OR \ES.LOCALHOSTNUMBER (SETQ \ES.LOCALHOSTNUMBER (create
 WORD
							      HIBYTE ←(\LOCALPUPNETNUMBER)
							      LOBYTE ←(\LOCALPUPHOSTNUMBER))))))

(\HNM.MEMBER

  (LAMBDA (HNM L)                                            (* JonL "28-MAR-83 18:36")

                                                             (* HNM is a host number; L is a list of host 

							     specifications, which could be either number, or name, 

							     or T or NIL.)

    (OR (HOSTNUMBERP HNM)
	(LISPERROR "ILLEGAL ARG" HNM))
    (for
 X in
 L do
 (AND (if
 (NULL X)
			    then
 NIL
			  elseif
 (EQ X T)
			    then
 (IEQP HNM (\ES.LOCALHOSTNUMBER
))
			  else
 (OR (HOSTNUMBERP X)
				   (SETQ X (ETHERHOSTNUMBER X)))
			       (IEQP HNM X))
			(RETURN T)))))

(\NORMALIZEHOSTNUM

  (LAMBDA (X DEFAULTADDRESS)                                 (* JonL "28-MAR-83 18:51")

    (if
 (NULL X)
	then
 DEFAULTADDRESS
      elseif
 (EQ X T)
	then
 (\ES.LOCALHOSTNUMBER
)
      elseif
 (ETHERHOSTNUMBER X)
      elseif
 DEFAULTADDRESS
      else
 (ERROR X "Not a valid Network Host identification"))))

(\BROADCASTADDRESS.ON.MYNET

  (LAMBDA NIL                                                (* JonL "28-MAR-83 18:38")

    (OR \BROADCASTADDRESS.ON.MYNET (SETQ \BROADCASTADDRESS.ON.MYNET (create
 WORD
									    HIBYTE ←(
									      \LOCALPUPNETNUMBER)
									    LOBYTE ← 0)))))

(\ES.PUP2DEADSOCKET?

  (LAMBDA (PUP)                                              (* JonL "28-MAR-83 19:04")

    (NOT (find
 SKT (SKT# ←(fetch
 PUPDESTSOCKET of
 PUP)) in
 \PUPSOCKETS suchthat
 (IEQP SKT#
										      (PUPSOCKETNUMBER
											SKT))))))

(\GETFILTEREDPUP

  (LAMBDA (SOC TYPESLST ID PUP? WAITINGTIME? TRACEINFO)      (* JonL "14-JUN-83 22:54")

                                                             (* The \PUPINQUEUE tconc list has items like 

							     (PUP . ARRIVALTIME))

    (GLOBALRESOURCE (\GFP.TIMER)
		    (PROG (PX TPUP TIMEOUT)
		          (DECLARE
 (SPECVARS PX))            (* We could check \PUPINQUEUE for being a TCONC ptr ?)

		          (if
 (AND (NEQ PUP? (QUOTE NEW))
				   (CAR \PUPINQUEUE)
				   (for
 X in
 (CAR \PUPINQUEUE) bind
 (SKT# ←(if
 (EQ SOC 
									      \EVALREQUEST.SOCKET)
									       then
 
									     \SOCKET#.EVALREQUEST
									     else
 (PUPSOCKETNUMBER
										    SOC)))
								    SKT#HI SKT#LO
				      first
 (.XUNBOX. SKT# SKT#HI SKT#LO)
				      do
                     (* Note how (EQUAL SKT# (fetch PUPDESTSOCKET of 

							     (CAR X))) is replaced by two EQ tests.)

					 (AND (EQ SKT#LO (fetch
 (PUP PUPDESTSOCKETLO)
							    of
 (CAR X)))
					      (EQ SKT#HI (fetch
 (PUP PUPDESTSOCKETHI)
							    of
 (CAR X)))
					      (TYPE\ID.OF.PUP? TYPESLST ID (CAR X))
					      (RETURN (SETQ PX X)))))
			      then
                           (* Aha, found it alreadly queued up!)

				   (if
 (EQ PUP? (QUOTE ?))
				       then
 (RETURN T)
				     else
 (\UNTCONC
 \PUPINQUEUE PX)
					  (BLOCK)
					  (if
 (EQ PUP? (QUOTE DELETE))
					      then
 (RETURN T)
					    else
 (SETQ TPUP (CAR PX))
						 (GO EXIT))))
		      SEEKPUP
		          (if
 (SETQ TPUP (GETPUP SOC))
			      then
 (replace
 (ETHERPACKET EPREQUEUE) of
 TPUP with
 T)
				   (if
 (TYPE\ID.OF.PUP? TYPESLST ID TPUP)
				       then
 (SELECTQ PUP?
						     ((? NEW)
						       (SETQ \PUPINQUEUE (TCONC \PUPINQUEUE
										(CONS TPUP
										      (CLOCK 0))))
						       (RETURN (QUOTE NEW)))
						     (DELETE (RELEASE.PUP TPUP)
							     (RETURN T))
						     (GO EXIT))
				     elseif
 (AND (EQ WAITINGTIME? T)
						 (TYPE\ID.OF.PUP? (CONSTANT (LIST \PT.ERROR))
								  ID TPUP))
				       then
 (ERROR "Error PUP received during indefinite wait" TPUP)
				     else
                    (* If we "sucked it off the wires" but don't want it 

							     now, then queue it up on \PUPINQUEUE)

					  (SETQ \PUPINQUEUE (TCONC \PUPINQUEUE (CONS TPUP
										     (CLOCK 0))))
					  (SETQ TPUP NIL)))
		          (if
 (if
 (EQ WAITINGTIME? T)
				  then
 (AWAIT.EVENT (PUPSOCKETEVENT SOC))
				       T
				elseif
 TIMEOUT
				  then
 (AWAIT.EVENT (PUPSOCKETEVENT SOC)
						    TIMEOUT T)
				       (NOT (TIMEREXPIRED? TIMEOUT))
				elseif
 (FIXP WAITINGTIME?)
				  then
 (SETQ TIMEOUT (SETUPTIMER WAITINGTIME? \GFP.TIMER))
				       T)
			      then
 (GO SEEKPUP))
		      EXIT(if
 (type?
 PUP PUP?)
			      then
 (RELEASE.PUP PUP?))
		          (if
 (AND TRACEINFO TPUP)
			      then
 (TRACEAPUP TPUP TRACEINFO))
		          (RETURN TPUP)))))

(\SENDUNFILTEREDPUP

  (LAMBDA (SOC PUP TRACEINFO)                                (* JonL " 1-APR-83 19:48")

    (SENDPUP SOC PUP)
    (TRACEAPUP PUP TRACEINFO (OR (CAR TRACEINFO)
				 (QUOTE (\SENDUNFILTEREDPUP
))))
    NIL))
)

(RPAQQ \BROADCASTADDRESS.ON.MYNET
 NIL)

(RPAQQ \ES.LOCALHOSTNUMBER
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \PUPSOCKETS \BROADCASTADDRESS.ON.MYNET \ES.LOCALHOSTNUMBER)
)

(ADDTOVAR PUPPRINTMACROS
 (4 WORDS 24 CHARS 66 ...))
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(TYPERECORD TRANSACTIONNOTE
 (STATE TIME SOCKET HOSTNAME))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS TYPE\ID.OF.PUP? MACRO 
(OPENLAMBDA (TYPESLST ID PUP)
                                                             (* JonL " 1-JUN-82 10:08")

  (AND (OR (NULL TYPESLST)
	   (FMEMB (fetch
 PUPTYPE of
 PUP)
		  TYPESLST))
       (OR (NULL ID)
	   (IEQP ID (fetch
 PUPID of
 PUP))))))

(PUTPROPS CONNECTIONIDP DMACRO 
((X) (SMALLP X)))

(PUTPROPS TRACEAPUP MACRO 
((PUP MSG FUN)
  (AND \ES.TRACE? (\ES.PRINTRACE PUP MSG FUN))))

(PUTPROPS 1BYTETOPUP DMACRO 
(OPENLAMBDA (N PUP)
  (\PUTBASEBYTE (FETCH
 PUPCONTENTS OF
 PUP)
		(IDIFFERENCE (ADD
 (FETCH
 PUPLENGTH OF
 PUP)
				  1)
			     (CONSTANT (ADD1 \PUPOVLEN)))
		N)))
)
)
(DECLARE: EVAL@COMPILE 

(RPAQQ \SOCKET#.EVALREQUEST
 668)

(RPAQQ \PT.EVALREQUEST
 200)

(RPAQQ \PT.ACKNOWLEDGE
 201)

(RPAQQ \PT.EVALRESPONSE
 202)

(RPAQQ \PT.EVALREQUEST.NORESULT
 203)

(RPAQQ \PT.EVALERROR
 204)

(RPAQQ \PT.EVALREQUEST.CERTIFY
 205)

(CONSTANTS (\SOCKET#.EVALREQUEST 668)
	   (\PT.EVALREQUEST 200)
	   (\PT.ACKNOWLEDGE 201)
	   (\PT.EVALRESPONSE 202)
	   (\PT.EVALREQUEST.NORESULT 203)
	   (\PT.EVALERROR 204)
	   (\PT.EVALREQUEST.CERTIFY 205))
)

(RPAQ? EvalServerClientHosts
 NIL)

(RPAQ? EvalServerGaggedHosts
 (QUOTE (T)))

(RPAQ? \EVALREQUEST.SOCKET
 NIL)

(RPAQ? \ES.MESSAGESTREAM
 NIL)

(RPAQ? \ES.PURGEINTERVAL.SECS
 180)

(RPAQ? \ES.PENDINGSERVICES
 NIL)

(RPAQ? \ES.COMPLETEDSERVICES
 NIL)

(RPAQ? \PUPINQUEUE
 NIL)

(RPAQ? \PUPINQUEUE.MAXLENGTH
 50)

(RPAQ? \PUPINQUEUE.MAXAGE
 (TIMES 6 60 1000))

(RPAQ? \ES.LOSTSOCKETSLST
 NIL)

(RPAQ? \ES.CurrentlyPendingService
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \PUPINQUEUE \PUPINQUEUE.MAXLENGTH \PUPINQUEUE.MAXAGE \EVALREQUEST.SOCKET 
	  \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS \ES.COMPLETEDSERVICES \ES.PENDINGSERVICES 
	  \ES.LOSTSOCKETSLST)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS \ES.CurrentlyPendingService FluidVariableForInterlospLissage)
)
(DEFINEQ

(REMOTEVAL

  (LAMBDA (FORM SERVERHOST MULTIPLE.RESPONSES?)              (* JonL "14-JUN-83 18:40")

    (if
 (NULL MULTIPLE.RESPONSES?)
	then
 (SETQ MULTIPLE.RESPONSES? 1))                   (* Check to be sure that the alleged for is EVALuable.)

    (\CHECKTYPE FORM (OR (FMEMB (NTYPX FORM)
				(CONSTANT (LIST \LISTP \LITATOM)))
			 (NUMBERP FORM)
			 (DEFEVAL (NTYPX FORM))))
    (if
 \ES.LOSTSOCKETSLST
	then
 (UNINTERRUPTABLY
                 (MAPC (PROG1 \ES.LOSTSOCKETSLST (SETQ \ES.LOSTSOCKETSLST))
		       (FUNCTION (LAMBDA (SOC)
			   (CLOSEPUPSOCKET SOC T))))))
    (PROG ((BROADP (\BROADCASTADDRESS.ON.MYNET
))
	   (OPUP (\ALLOCATE.BIGPUP))
	   (MY.TRANSCEIVER (CAR (push
 \ES.LOSTSOCKETSLST (OPENPUPSOCKET))))
	   MSG IPUP MY.REF.ID HIS.TRANSCEIVER.SOC# MULTIPLE.TRANSMITP)
          (SETQ SERVERHOST (\NORMALIZEHOSTNUM
 SERVERHOST BROADP))
          (SETQ BROADP (AND (EQUAL SERVERHOST BROADP)
			    (NCREATE (QUOTE FIXP))))         (* This will be a cell for coordinating the release of 

							     the MY.TRANSCEIVER pup socket.)

          (SETUPPUP OPUP SERVERHOST (CONSTANT \SOCKET#.EVALREQUEST)
		    (SELECTQ MULTIPLE.RESPONSES?
			     (0 \PT.EVALREQUEST.NORESULT)
			     \PT.EVALREQUEST)
		    NIL MY.TRANSCEIVER)
          (SETQ MY.REF.ID (fetch
 PUPID OPUP))
          (PRINT.INTO.PUP
 FORM OPUP)
      SENDOUTREQUEST
          (for
 I to
 \MAXETHERTRIES as
 WAITINTERVAL from
 \ETHERTIMEOUT by
 \ETHERTIMEOUT
	     do
 (SETQ MSG (if
 (EQ I 1)
			      then
 (QUOTE ("=== Client Dispatches an Eval Request:" REMOTEVAL))
			    else
 (SETQ MULTIPLE.TRANSMITP T)
				 (CONS (CONCAT "=== Client Re-Dispatches Eval Request for " I
					       (ORDINALSUFFIXSTRING
 I)
					       " time:")
				       (QUOTE (REMOTEVAL
)))))
		(\SENDUNFILTEREDPUP
 MY.TRANSCEIVER OPUP MSG) 
                                                             (* Wait around for a while, for an acknowledgement of 

							     receipt.)

		(if
 (SETQ IPUP (\GETFILTEREDPUP
 MY.TRANSCEIVER (CONSTANT (LIST \PT.ACKNOWLEDGE 
									       \PT.ERROR))
						MY.REF.ID NIL WAITINTERVAL))
		    then
 (if
 (EQ \PT.ERROR (fetch
 PUPTYPE of
 IPUP))
			     then
 (GO ERRORPUP)
			   else
 (TRACEAPUP IPUP (QUOTE (
"=== Client Receives Acknowledgement of Request: " REMOTEVAL)))
				(RETURN)))
	     finally
 (GO TIMEOUTERROR))
          (SETQ HIS.TRANSCEIVER.SOC# (fetch
 (PUP SOURCESKT) of
 IPUP))
          (SETQ SERVERHOST (fetch
 (PUP SOURCE) of
 IPUP))
          (if
 (AND BROADP (NEQ 0 MULTIPLE.RESPONSES?))
	      then
                                           (* Got to certify the worker first.)

		   (SETUPPUP OPUP SERVERHOST HIS.TRANSCEIVER.SOC# \PT.EVALREQUEST.CERTIFY MY.REF.ID 
			     MY.TRANSCEIVER)
		   (1BYTETOPUP 1 OPUP)
		   (for
 I to
 \MAXETHERTRIES as
 WAITINTERVAL from
 \ETHERTIMEOUT by
 \ETHERTIMEOUT
		      do
                                     (* Comment PPlossage)

			 (\SENDUNFILTEREDPUP
 MY.TRANSCEIVER OPUP (QUOTE (
"=== Client Certifies applicant for broadcast Request" REMOTEVAL)))
			 (if
 (SETQ IPUP (\GETFILTEREDPUP
 MY.TRANSCEIVER (CONSTANT (LIST 
									  \PT.EVALREQUEST.CERTIFY 
											\PT.ERROR))
							 MY.REF.ID IPUP WAITINTERVAL))
			     then
 (if
 (EQ (fetch
 PUPTYPE of
 IPUP)
					  \PT.ERROR)
				      then
 (GO ERRORPUP)
				    else
 (TRACEAPUP IPUP (QUOTE (
"=== Client knows that applicant knows he's selected." REMOTEVAL)))
					 (RETURN))
			   else
 (BLOCK))
		      finally
 (GO TIMEOUTERROR))
		   (OR (FIND.PROCESS (QUOTE ES.BroadcastSweeper))
		       (SETQ \ES.BroadAppSweeper (ADD.PROCESS (QUOTE (\ES.BroadAppSweeper
))
							      (QUOTE NAME)
							      (QUOTE ES.BroadcastSweeper))))
		   (TCONC \ES.BroadSweepQ
			  (CONS (QUOTE \ES.RejectApplicants)
				(create
 BROADAPNOTE
					SERVERHOST ← SERVERHOST
					REFID ← MY.REF.ID
					TRANSCEIVER ← MY.TRANSCEIVER
					UPROC ←(THIS.PROCESS)
					FINALTIME ←(SETUPTIMER (CONSTANT (ITIMES \MAXETHERTRIES 
										 \ETHERTIMEOUT)))
					EXITCOUNT ← BROADP)))
		   (NOTIFY.EVENT \ES.BroadAppEVENT T))
          (if
 (EQ MULTIPLE.RESPONSES? 0)
	      then
 (SETQ MSG MY.REF.ID)
		   (GO NORMALEXIT))
          (SETQ IPUP (\GETFILTEREDPUP
 MY.TRANSCEIVER (CONSTANT (LIST \PT.EVALRESPONSE \PT.EVALERROR))
				      MY.REF.ID IPUP T (QUOTE ("=== Client Gets Results in Hand!"
								REMOTEVAL))))
                                                             (* Now, hang around waiting for the result, which might 

							     take hours!)

          (SETUPPUP OPUP SERVERHOST HIS.TRANSCEIVER.SOC# \PT.ACKNOWLEDGE MY.REF.ID MY.TRANSCEIVER)
                                                             (* And now we acknowledge receipt of the results.)

          (\SENDUNFILTEREDPUP
 MY.TRANSCEIVER OPUP (QUOTE (
"Client Sends Acknowledgement for Services Rendered" REMOTEVAL)))
          (SETQ MSG (if
 IPUP
			then
 (SELECTC (fetch
 PUPTYPE of
 IPUP)
				      (\PT.EVALRESPONSE (READ.FROM.PUP
 IPUP))
				      (\PT.EVALERROR (PROG ((X (READ.FROM.PUP
 IPUP)))
						           (RETURN (ERROR (CONCAT
									    
					      "Returned from Remote EVALuation with Error msg %""
									    (ERRORSTRING
									      (CAR X))
									    "%"")
									  (CADR X)))))
				      NIL)
		      else
 (ERROR "Remote EVALuation failed to return." FORM)))
      NORMALEXIT
          (while
 (\GETFILTEREDPUP
 MY.TRANSCEIVER (CONSTANT (LIST \PT.ACKNOWLEDGE 
								 \PT.EVALREQUEST.CERTIFY 
								 \PT.EVALRESPONSE \PT.EVALERROR))
				  MY.REF.ID
				  (QUOTE DELETE))
	     do
 (BLOCK))                                     (* Flush any delayed communications from the server.)

          (\ES.EXITREMOTEVAL
 OPUP IPUP MY.TRANSCEIVER BROADP)
          (RETURN MSG)
      TIMEOUTERROR                                           (* If we did'nt get thru after \MAXETHERTRIES, we're 

							     probably losing badly.)

          (\ES.EXITREMOTEVAL
 OPUP IPUP MY.TRANSCEIVER BROADP)
      TIMEOUT.E
          (ERROR FORM "Remote EVAL request timed out")
          (GO TIMEOUT.E)
      ERRORPUP
          (TRACEAPUP IPUP (QUOTE ("*** Server Errors-out on Connection Request" REMOTEVAL)))
          (\ES.EXITREMOTEVAL
 OPUP IPUP MY.TRANSCEIVER BROADP)
      ERRORPUP.E
          (ERROR IPUP "Error PUP")
          (GO ERRORPUP.E))))

(\ES.EXITREMOTEVAL

  (LAMBDA (OPUP IPUP MY.TRANSCEIVER BROADP.COUNT?)           (* JonL "29-MAY-83 04:52")

    (AND OPUP (RELEASE.PUP OPUP))
    (AND IPUP (RELEASE.PUP IPUP))                            (* Note how following ILEQ test requires two exitings --

							     once from normal REMOTEVAL exit and once from 

							     \ES.REJECTBROADAP)

    (AND (OR (NULL BROADP.COUNT?)
	     (ILEQ 1 (\DTEST BROADP.COUNT? (QUOTE FIXP))))
	 (UNINTERRUPTABLY
             (SETQ \ES.LOSTSOCKETSLST (DREMOVE MY.TRANSCEIVER \ES.LOSTSOCKETSLST))
	     (CLOSEPUPSOCKET MY.TRANSCEIVER T)))
    (AND BROADP.COUNT? (\BOXIPLUS BROADP.COUNT? 1))
    T))

(REMOTEABORT

  (LAMBDA (TRANSACTION# SERVERHOST)                          (* JonL "28-MAR-83 18:45")

                                                             (* Remember, a TRANSACTION.ID is a cons of "connection" 

							     id and hostnumber)

    (PROG ((CLIENT (if
 (AND (LISTP TRANSACTION#)
			    (CONNECTIONIDP (CAR TRANSACTION#)))
		       then
 (PROG1 (ETHERHOSTNUMBER (CDR TRANSACTION#))
				   (SETQ TRANSACTION# (CAR TRANSACTION#)))
		     elseif
 (AND (CONNECTIONIDP TRANSACTION#)
				 (PROGN                      (* Foo, this really wants to be an IMODLESSP)

					(ILESSP (IMOD (IDIFFERENCE \PUPCOUNTER TRANSACTION#)
						      (CONSTANT (LLSH 1 BITSPERWORD)))
						(CONSTANT (LLSH 1 (SUB1 BITSPERWORD))))))
		       then
                                  (* Remember, \PUPCOUNTER is the means that transaction#s

							     are generated by this host.)

			    (\ES.LOCALHOSTNUMBER
)
		     else
 (LISPERROR "ILLEGAL ARG" TRANSACTION#)))
	   (BADDR (\BROADCASTADDRESS.ON.MYNET
))
	   TRANSACTION.ID)
          (SETQ TRANSACTION.ID (CONS TRANSACTION# CLIENT))
          (SETQ SERVERHOST (\NORMALIZEHOSTNUM
 SERVERHOST BADDR))
          (if
 (EQ SERVERHOST BADDR)
	      then
 (ERROR TRANSACTION.ID "Can't broadcast a REMOTEABORT."))
          (RETURN (REMOTEVAL
 (LIST (QUOTE \ES.ABORTQQ)
				   TRANSACTION.ID
				   (\ES.LOCALHOSTNUMBER
))
			     SERVERHOST)))))

(REMOTEAPPLY

  (LAMBDA (FUN ARGS HOST MULTIPLE.RESPONSES?)                (* JonL "25-JUN-82 03:54")

    (REMOTEVAL
 (CONS (QUOTE \ES.APPLYQQ)
		     (CONS FUN ARGS))
	       HOST MULTIPLE.RESPONSES?)))

(\ES.APPLYQQ

  (NLAMBDA L                                                 (* JonL "19-JUN-82 06:04")

    (APPLY (CAR L)
	   (CDR L))))

(EVALSERVER

  (LAMBDA (DURATION.MINUTES CLIENTSLST GAGGEDCLIENTSLST)     (* JonL "14-JUN-83 23:01")

    (PROG ((PROCP (THIS.PROCESS))
	   ARGSL)
          (SETQ ARGSL (LIST CLIENTSLST GAGGEDCLIENTSLST (AND (FIXP DURATION.MINUTES)
							     (TIMES 60000 DURATION.MINUTES))
			    PROCP))
          (if
 PROCP
	      then
 (DEL.PROCESS (FIND.PROCESS (QUOTE EvalServerListening)))
		   (DEL.PROCESS (FIND.PROCESS (QUOTE ES.BroadcastSweeper)))
		   (MAP.PROCESSES (FUNCTION (LAMBDA (X)
				      ((LAMBDA (PN)
					  (if
 (STRPOS "EvalService." PN NIL NIL T)
					      then
 (DEL.PROCESS X)))
					(PROCESS.NAME X)))))
                                                             (* Delete services still being performed for old 

							     servers)

		   (SETQ \ES.BroadSweepQ (LIST NIL))
		   (RETURN (LIST (SETQ EVALSERVER (ADD.PROCESS (CONS (QUOTE \ES.LISTENER)
								     ARGSL)
							       (QUOTE NAME)
							       (QUOTE EvalServerListening)))
				 (SETQ \ES.BroadAppSweeper (ADD.PROCESS (QUOTE (\ES.BroadAppSweeper
))
									(QUOTE NAME)
									(QUOTE ES.BroadcastSweeper))))
			   )
	    else
 (APPLY (QUOTE \ES.LISTENER)
			ARGSL)))))

(\ES.LISTENER

  (NLAMBDA (CLIENTSLST GAGS DURATION PROCP)                  (* JonL "13-JUN-83 18:00")

                                                             (* Args are passed in directly from EVALSERVER.

							     "Listens" for EvalRequests, and spawns off a process to 

							     do one when it arrives.)

    (PROG ((PURGEINTERVAL (TIMES \ES.PURGEINTERVAL.SECS 1000))
	   (BADDR (HOST#.FROM.ADDRESS (\BROADCASTADDRESS.ON.MYNET
)))
	   REQUESTEVENT NEXTPURGETIME PROMISCUOUS FLIRTATIOUS CLIENTADDRESS IPUP ARGL)
                                                             (* First, set up the lists of acceptable and gagged 

							     clients.)

          (if
 (NULL CLIENTSLST)
	      then
 (SETQ PROMISCUOUS (SETQ FLIRTATIOUS T))
	    elseif
 (LISTP CLIENTSLST)
	      then
 (if
 (MEMB NIL CLIENTSLST)
		       then
 (SETQ PROMISCUOUS T)
			    (SETQ CLIENTSLST (REMOVE NIL CLIENTSLST)))
		   (if
 (MEMB T CLIENTSLST)
		       then
 (SETQ FLIRTATIOUS T)
			    (SETQ CLIENTSLST (REMOVE T CLIENTSLST)))
		   (SETQ CLIENTSLST (MAPCAR CLIENTSLST (FUNCTION \NORMALIZEHOSTNUM)))
	    elseif
 (SETQ CLIENTADDRESS (ETHERHOSTNUMBER CLIENTSLST))
	      then
 (SETQ CLIENTSLST (LIST CLIENTADDRESS))
	    else
 (LISPERROR "ILLEGAL ARG" CLIENTSLST))
          (if
 (MEMB NIL GAGS)
	      then
 (SETQ GAGS (REMOVE NIL GAGS))
		   (SETQ PROMISCUOUS NIL))
          (if
 (MEMB T GAGS)
	      then
 (SETQ GAGS (REMOVE T GAGS))
		   (push
 GAGS (\ES.LOCALHOSTNUMBER
)))
          (SETQ GAGS (DREMOVE NIL (MAPCAR GAGS (FUNCTION ETHERHOSTNUMBER))))
          (OR (PROBABLYSOCKETP \EVALREQUEST.SOCKET)
	      (SETQ \EVALREQUEST.SOCKET (OPENPUPSOCKET \SOCKET#.EVALREQUEST)))
          (SETQ REQUESTEVENT (PUPSOCKETEVENT \EVALREQUEST.SOCKET))
          (while
 (\GETFILTEREDPUP
 \EVALREQUEST.SOCKET (CONSTANT (LIST \PT.EVALREQUEST))
				  NIL
				  (QUOTE DELETE)))           (* Flush any stale requests still on the input queue.)

          (SETQ NEXTPURGETIME (SETUPTIMER PURGEINTERVAL))
      LOOP(during
 (OR DURATION MAX.FIXP)
	     do
 (AWAIT.EVENT REQUESTEVENT NEXTPURGETIME T)
		(if
 (SETQ IPUP (\GETFILTEREDPUP
 \EVALREQUEST.SOCKET (CONSTANT (LIST \PT.EVALREQUEST 
									 \PT.EVALREQUEST.NORESULT))
						NIL IPUP))
		    then
 (if
 (AND (NOT (ZEROP (SETQ CLIENTADDRESS (fetch
 (PUP SOURCE) of
 IPUP))))
				  (if
 (EQ BADDR (fetch
 (PUP DESTHOST) of
 IPUP))
				      then
                   (* Ha, A Broadcast packet!)

					   (AND (OR PROMISCUOUS (FMEMB NIL EvalServerClientHosts))
						(NOT (FMEMB NIL EvalServerGaggedHosts)))
				    else
 (OR FLIRTATIOUS (MEMBER CLIENTADDRESS CLIENTSLST)
					     (\HNM.MEMBER
 CLIENTADDRESS EvalServerClientHosts)))
				  (AND (NOT (MEMBER CLIENTADDRESS GAGS))
				       (NOT (\HNM.MEMBER
 CLIENTADDRESS EvalServerGaggedHosts))))
			     then
 (SETQ ARGL (LIST IPUP))
				  (SETQ IPUP NIL)            (* Since IPUP is "eaten up" in the call to \ES.DO1THING)

				  (if
 PROCP
				      then
 (ADD.PROCESS (CONS (QUOTE \ES.DO1THING)
							      ARGL)
							(QUOTE NAME)
							(MKATOM (CONCAT "EvalService." (
									  NTWK#.FROM.ADDRESS 
										    CLIENTADDRESS)
									"#"
									(HOST#.FROM.ADDRESS 
										    CLIENTADDRESS)
									"."
									(fetch
 (PUP PUPID)
									   of
 (CAR ARGL)))))
				    else
 (RESETLST (APPLY (QUOTE \ES.DO1THING)
							  ARGL))
					 (if
 (AND (PROG1 \ES.CurrentlyPendingService 
                                                             (* Comment PPlossage)
)
						  (NOT (MEMBER \ES.CurrentlyPendingService 
							       \ES.PENDINGSERVICES))
						  (SETQ ARGL (STKPOS (QUOTE \ES.DO1THING))))
					     then
 

          (* Could it be that the call we just did was a recursive non-PROCworld call? Then maybe it was a request to ABORT 

	  the action at hand.)



						  (RETFROM ARGL NIL T)))
			   else
 (TRACEAPUP IPUP (QUOTE ("=== EvalServer Rejects Request:" 
										     \ES.LISTENER)))))
		(BLOCK)
		(if
 (TIMEREXPIRED? NEXTPURGETIME)
		    then
 (\ES.PURGEOLDTHINGS
 NIL PURGEINTERVAL)
			 (SETUPTIMER PURGEINTERVAL NEXTPURGETIME)
			 (BLOCK)))
          (if
 (NULL DURATION)
	      then
                                           (* Infinite time to be spent "in service")

		   (GO LOOP)))))

(\ES.DO1THING

  (NLAMBDA (FluidVariableForInterlospLissage)                (* JonL "14-JUN-83 18:40")

    (PROG ((ES.RESPONSE.SOCKET (OPENPUPSOCKET))
	   (OPUP (\ALLOCATE.BIGPUP))
	   (CLIENTADDRESS (fetch
 (PUP SOURCE) of
 FluidVariableForInterlospLissage))
	   (CLIENTS.RECEIVER.SOCKET# (fetch
 (PUP SOURCESKT) of
 FluidVariableForInterlospLissage))
	   (CLIENT'S.REF.ID (fetch
 (PUP PUPID) of
 FluidVariableForInterlospLissage))
	   (PROCP (THIS.PROCESS))
	   (BROADP (EQ (HOST#.FROM.ADDRESS (\BROADCASTADDRESS.ON.MYNET
))
		       (fetch
 (PUP DESTHOST) of
 FluidVariableForInterlospLissage)))
	   (FINISHOW? (QUOTE COMPLETED))
	   \ES.CurrentlyPendingService VAL PT PROCLEANUP TRANSACTION.ID DUPLICATEP)
          (SETQ \ES.CurrentlyPendingService (CONS (SETQ TRANSACTION.ID (CONS CLIENT'S.REF.ID 
									     CLIENTADDRESS))
						  (create
 TRANSACTIONNOTE
							  STATE ←(OR PROCP (QUOTE RUNNING))
							  TIME ←(CLOCK 0)
							  SOCKET ← ES.RESPONSE.SOCKET)))
          (UNINTERRUPTABLY
              (if
 (OR (SASSOC TRANSACTION.ID \ES.PENDINGSERVICES)
		      (SASSOC TRANSACTION.ID \ES.COMPLETEDSERVICES))
		  then
                                       (* Foo, some "race" condition slipped in a duplicate 

							     request during the short hop from \ES.LISTENER to here)

		       (SETQ DUPLICATEP T)
		else
 (push
 \ES.PENDINGSERVICES \ES.CurrentlyPendingService)
		     (AND (NOT (NULL EVALSERVER.STATUS.WINDOW))
			  (\ES.INVALIDATE.STATUSW
))))
          (AND (NOT PROCP)
	       (NOT DUPLICATEP)
	       (RESETSAVE (PROGN \ES.CurrentlyPendingService)
			  (QUOTE (AND RESETSTATE (\ES.ABORTPENDING
 OLDVALUE)))))
          (TRACEAPUP (PROG1 FluidVariableForInterlospLissage 
                                                             (* Comment PPLossage)
)
		     (if
 DUPLICATEP
			 then
 (QUOTE ("=== EvalServer Receives Duplicate Request:" \ES.LISTENER))
		       else
 (QUOTE ("=== EvalServer Receives Request:" \ES.LISTENER))))
          (SETUPPUP OPUP CLIENTADDRESS CLIENTS.RECEIVER.SOCKET# \PT.ACKNOWLEDGE CLIENT'S.REF.ID 
		    ES.RESPONSE.SOCKET)
          (\SENDUNFILTEREDPUP
 ES.RESPONSE.SOCKET (PROG1 OPUP 
                                                             (* Comment PPLossage)
)
			      (if
 DUPLICATEP
				  then
 (QUOTE ("=== EvalServer Re-Sends Acknowledgement of Receipt:"
						\ES.DO1THING))
				else
 (QUOTE ("=== EvalServer Sends Acknowledgement of Receipt:"
					      \ES.DO1THING))))
                                                             (* Acknowledge receipt of the request.)

          (if
 DUPLICATEP
	      then
 (CLOSEPUPSOCKET ES.RESPONSE.SOCKET)
		   (GO RELEASE&EXIT)
	    elseif
 (AND BROADP (NEQ (fetch
 PUPTYPE of
 FluidVariableForInterlospLissage)
				    \PT.EVALREQUEST.NORESULT))
	      then
 (BLOCK)                                   (* If we accepted a broadcast request, then we have to 

							     wait for Client's certification that we are indeed the 

							     selected server.)

		   (for
 I to
 \MAXETHERTRIES as
 WAITINTERVAL from
 \ETHERTIMEOUT by
 \ETHERTIMEOUT
		      bind
 CPUP
		      do
 (if
 (NOT (SETQ CPUP (\GETFILTEREDPUP
 ES.RESPONSE.SOCKET (CONSTANT
								(LIST \PT.EVALREQUEST.CERTIFY))
							      CLIENT'S.REF.ID CPUP WAITINTERVAL)))
			     then
 (\SENDUNFILTEREDPUP
 ES.RESPONSE.SOCKET OPUP (QUOTE (
"=== EvalServer Re-Sends Acknowledgement of Receipt:" \ES.DO1THING)))
			   elseif
 (AND (OR (ILESSP (fetch
 PUPLENGTH of
 CPUP)
						   (CONSTANT (ADD1 \PUPOVLEN)))
					   (ZEROP (\GETBASEBYTE (fetch
 PUPCONTENTS of
 CPUP)
								0))))
			     then
                            (* We've been turned down in our application)

				  (GO ABORT)
			   else
                              (* Ah, we are awarded the contract!)

				(replace
 (PUP PUPTYPE) of
 OPUP with
 \PT.EVALREQUEST.CERTIFY)
				(\SENDUNFILTEREDPUP
 ES.RESPONSE.SOCKET OPUP (QUOTE (
"=== EvalServer acknowledges certification re broadcast:" \ES.DO1THING)))
				(TCONC \ES.BroadSweepQ
				       (CONS (QUOTE \ES.ApplicantValid?)
					     (create
 BROADAPNOTE
						     SERVERHOST ← CLIENTADDRESS
						     TRANSCEIVER ← ES.RESPONSE.SOCKET
						     REFID ← CLIENT'S.REF.ID
						     OPUP ← OPUP
						     FINALTIME ←(SETUPTIMER (CONSTANT (ITIMES 
										   \MAXETHERTRIES 
										    \ETHERTIMEOUT)))
						     UPROC ←(THIS.PROCESS))))
				(NOTIFY.EVENT \ES.BroadAppEVENT T)
				(SETQ OPUP (\ALLOCATE.BIGPUP))
				(RETURN))
		      finally
 (PROGN                         (* Sigh, looks like some other applicant got the job for

							     the broadcast request; or maybe the client died?)

				     (GO ABORT))))
          (SETQ VAL (ERRORSET (QUOTE (EVAL (READ.FROM.PUP
 FluidVariableForInterlospLissage)))
			      (QUOTE INTERNAL)))
          (if
 (EQ (fetch
 (PUP PUPTYPE) of
 FluidVariableForInterlospLissage)
		  \PT.EVALREQUEST.NORESULT)
	      then
 (SETQ FINISHOW? (QUOTE COMPLETED.NORESULT))
		   (GO FINISHUP))
          (SETQ PT (if
 (LISTP VAL)
		       then
 (SETQ VAL (CAR VAL))
			    \PT.EVALRESPONSE
		     else
 (SETQ VAL (ERRORN))
			  \PT.EVALERROR))                    (* We're goint to re-use OPUP for output again.)

          (SETUPPUP OPUP CLIENTADDRESS CLIENTS.RECEIVER.SOCKET# PT CLIENT'S.REF.ID ES.RESPONSE.SOCKET)
          (if
 (NULL (PRINT.INTO.PUP
 VAL OPUP NIL NIL (QUOTE NOERROR)))
	      then
 (replace
 PUPLENGTH of
 OPUP with
 \PUPOVLEN)
		   (replace
 PUPTYPE of
 OPUP with
 \PT.EVALERROR)
		   (PRINT.INTO.PUP
 
			 "Result too large to fit into PUP -- first few characters of it are:   "
				   OPUP NIL (FUNCTION PRIN1))
		   (PRINT.INTO.PUP
 (SUBSTRING (MKSTRING VAL)
					      1
					      (IDIFFERENCE (#PUPDATABYTES.LEFT OPUP)
							   10))
				   OPUP NIL (FUNCTION PRIN1)))
          (for
 I to
 \MAXETHERTRIES as
 WAITINTERVAL from
 \ETHERTIMEOUT by
 \ETHERTIMEOUT
	     do
 (\SENDUNFILTEREDPUP
 ES.RESPONSE.SOCKET OPUP (QUOTE ("=== EvalServer Sends Result: "
								     \ES.DO1THING)))
		(BLOCK)
		(if
 (SETQ FluidVariableForInterlospLissage (\GETFILTEREDPUP
 ES.RESPONSE.SOCKET
									    (CONSTANT (LIST 
										  \PT.ACKNOWLEDGE 
											\PT.ERROR))
									    CLIENT'S.REF.ID 
								 FluidVariableForInterlospLissage 
									    WAITINTERVAL))
		    then
 (if
 (NEQ \PT.ERROR (fetch
 PUPTYPE of
 FluidVariableForInterlospLissage))
			     then
 (TRACEAPUP FluidVariableForInterlospLissage (QUOTE (
"Ah, Received Client's Acknowledgement of Results:" \ES.DO1THING)))
			   else
 (TRACEAPUP FluidVariableForInterlospLissage (QUOTE (
"*** Client Aborts Before Receiving Results" \ES.DO1THING)))
				(SETQ FINISHOW? (QUOTE COMPLETED.NORESULT)))
			 (GO FINISHUP))
	     finally
 (printout
 \ES.MESSAGESTREAM T 
			       "No acknowledgement for Remote Eval service performed."
			       T "    HOSTNAME:  " (ETHERHOSTNAME CLIENTADDRESS)
			       ",  TRANSACTION# = " CLIENT'S.REF.ID))
      FINISHUP
          (if
 (EQ FINISHOW? (QUOTE ABORTED))
	      then
 (while
 (\GETFILTEREDPUP
 ES.RESPONSE.SOCKET (CONSTANT (LIST \PT.ERROR))
					   CLIENT'S.REF.ID
					   (QUOTE DELETE))))
          (\ES.DELETE1PENDING
 \ES.CurrentlyPendingService FINISHOW?)
      RELEASE&EXIT
          (AND FluidVariableForInterlospLissage (RELEASE.PUP FluidVariableForInterlospLissage))
          (AND OPUP (RELEASE.PUP OPUP))
          (if
 PROCP
	      then
 (KILL.ME)
	    else
 (RETURN))
      ABORT
          (SETQ FINISHOW? (QUOTE ABORTED))
          (GO FINISHUP))))

(\ES.ABORTQQ

  (NLAMBDA L                                                 (* JonL "19-JUN-82 06:04")

    (APPLY (FUNCTION EVALSERVER.ABORT)
	   L)))

(EVALSERVER.ABORT

  (LAMBDA (TRANSACTION# GUILTYPARTY ERRORFLG)                (* edited: "10-AUG-82 00:31")

    (PROG (CLIENTHOST TRANSACTION.ID THISPENDINGSERVICE)
          (SETQ CLIENTHOST (if
 (AND (LISTP TRANSACTION#)
				    (CONNECTIONIDP (CAR TRANSACTION#)))
			       then
 (PROG1 (OR (HOSTNUMBERP (CDR TRANSACTION#))
					       (ETHERHOSTNUMBER (CDR TRANSACTION#)))
					   (SETQ TRANSACTION# (CAR TRANSACTION#)))
			     elseif
 (CONNECTIONIDP TRANSACTION#)
			       then
 (for
 P in
 (APPEND \ES.PENDINGSERVICES \ES.COMPLETEDSERVICES)
				       bind
 FOUND1 do
 (if
 (EQP TRANSACTION# (CAAR P))
							  then
 (SETQ FOUND1
								 (if
 FOUND1
								     then
 T
								   else
 (CAR P))))
				       finally
 (RETURN (AND (NOT (EQ FOUND1 T))
							    (CDR FOUND1))))))
          (SETQ TRANSACTION.ID (CONS TRANSACTION# CLIENTHOST))
          (if
 (NULL (SETQ THISPENDINGSERVICE (SASSOC TRANSACTION.ID \ES.PENDINGSERVICES)))
	      then
 (if
 (SASSOC TRANSACTION.ID \ES.COMPLETEDSERVICES)
		       then
 (RETURN (QUOTE ALREADY.COMPLETED))
		     else
 ((LAMBDA (MSG)
			      (OR (NOT ERRORFLG)
				  (ERROR TRANSACTION.ID MSG))
			      MSG)
			    "No EvalService with this transaction ID in progress."))
	    elseif
 (APPLY (QUOTE \ES.ABORTPENDING)
			  (LIST (PROG1 THISPENDINGSERVICE    (* Comment PPlossage)
)
				(if
 GUILTYPARTY
				    then
 (SUBST (if
 (LITATOM GUILTYPARTY)
						    then
 GUILTYPARTY
						  else
 (OR (ETHERHOSTNAME GUILTYPARTY)
							   GUILTYPARTY))
						(QUOTE GUILTYPARTY)
						(QUOTE (ABORTED REMOTELY BY GUILTYPARTY))))))
	      then
 (RETURN (QUOTE ABORTED))
	    else
 ((LAMBDA (MSG)
		     (OR (NOT ERRORFLG)
			 (ERROR THISPENDINGSERVICE MSG))
		     MSG)
		   "EvalService with this transaction ID seems to be wedged.")))))

(EVALSERVER.STATUS

  (LAMBDA (WHEREPENDINGFLG ID)                               (* JonL "29-MAY-83 02:44")

    (if
 (NULL WHEREPENDINGFLG)
	then
 (SETQ WHEREPENDINGFLG (QUOTE ALL)))
    (PROG (P L)
          (AND (MEMB WHEREPENDINGFLG (QUOTE (ALL T CURRENT RUNNING)))
	       (SETQ P (MAPCONC \ES.PENDINGSERVICES
				(FUNCTION (LAMBDA (X)
				    (AND (OR (NULL ID)
					     (IEQP ID (CAAR X)))
					 (LIST (LIST (\ES.MakeClientHostInfo
 X)
						     (LIST (QUOTE Process:)
							   (if
 (TYPENAMEP (SETQ X
									    (fetch
 (TRANSACTIONNOTE
										     STATE)
									       of
 (CDR X)))
									  (QUOTE PROCESS))
							       then
 (PROCESS.NAME X)
							     else
 X)))))))))
	       (push
 L (CONS (QUOTE CurrentlyRunning.Transactions:)
			     P)))
          (if
 (MEMB WHEREPENDINGFLG (QUOTE (ALL T INPUT INPUTQUEUE)))
	      then
 (OR (PROBABLYSOCKETP \EVALREQUEST.SOCKET)
		       (SETQ \EVALREQUEST.SOCKET (OPENPUPSOCKET \SOCKET#.EVALREQUEST)))
		   (while
 (EQ (QUOTE NEW)
			      (\GETFILTEREDPUP
 \EVALREQUEST.SOCKET (CONSTANT (LIST \PT.EVALREQUEST))
					       ID
					       (QUOTE NEW))))
                                                             (* Be sure nothing is left in the BCPL buffers.)

		   (SETQ P (MAPCONC (CAR \PUPINQUEUE)
				    (FUNCTION (LAMBDA (X)
					(SETQ P (CAR X))
					(AND (EQ (CONSTANT (fetch
 LONUM of
 \EVALREQUEST.SOCKET))
						 (fetch
 PUPDESTSOCKETLO of
 P))
					     (EQ (CONSTANT (fetch
 HINUM of
 \EVALREQUEST.SOCKET))
						 (fetch
 PUPDESTSOCKETHI of
 P))
					     (TYPE\ID.OF.PUP? (CONSTANT (LIST \PT.EVALREQUEST 
									 \PT.EVALREQUEST.NORESULT))
							      ID P)
					     (LIST (LIST (QUOTE ID#.ClientHost:)
							 (fetch
 (PUP PUPID) of
 P)
							 (OR (ETHERHOSTNAME (SETQ P
									      (fetch
 (PUP SOURCE)
										 of
 P)))
							     P))
						   (LIST (QUOTE #Secs.on.this.Queue:)
							 (IQUOTIENT (CLOCKDIFFERENCE (CDR X))
								    1000))))))))
		   (AND P (push
 L (CONS (QUOTE EvalServer.InputQueue:)
					P))))
          (AND (MEMB WHEREPENDINGFLG (QUOTE (ALL DONE COMPLETED FINISHED)))
	       (SETQ P (MAPCONC \ES.COMPLETEDSERVICES
				(FUNCTION (LAMBDA (X)
				    (AND (OR (NULL ID)
					     (EQP ID (CAAR X)))
					 (LIST (LIST (\ES.MakeClientHostInfo
 X)
						     (LIST (QUOTE HowStop.#Seconds:)
							   (fetch
 (TRANSACTIONNOTE STATE)
							      of
 (CDR X))
							   (if
 (FIXP (SETQ P (fetch
 (TRANSACTIONNOTE
										      TIME)
										of
 (CDR X))))
							       then
 (IQUOTIENT (CLOCKDIFFERENCE
										 P)
									       1000)
							     else
 (QUOTE ?))))))))))
	       (push
 L (CONS (QUOTE Completed.Transactions:)
			     P)))
          (RETURN L))))

(\ES.MakeClientHostInfo

  (LAMBDA (X)                                                (* JonL " 5-NOV-82 21:45")

    (LIST (QUOTE ID#.ClientHost:)
	  (CAAR X)
	  (OR (fetch
 (TRANSACTIONNOTE HOSTNAME) of
 (CDR X))
	      ((LAMBDA (HNAME)
		  (if
 HNAME
		      then
 (replace
 (TRANSACTIONNOTE HOSTNAME) of
 (CDR X) with
 HNAME)
			   HNAME))
		(ETHERHOSTNAME (CDAR X)))
	      (CDAR X)))))

(\ES.DELETE1PENDING

  (LAMBDA (THISPENDINGSERVICE FINISHOW?)                     (* JonL "27-MAY-83 15:30")

    (UNINTERRUPTABLY
        ((LAMBDA (SOCKET)
	    (replace
 (TRANSACTIONNOTE SOCKET) of
 (CDR THISPENDINGSERVICE) with
 NIL)
	    (AND (PROBABLYSOCKETP SOCKET)
		 (CLOSEPUPSOCKET SOCKET T)))
	  (fetch
 (TRANSACTIONNOTE SOCKET) of
 (CDR THISPENDINGSERVICE)))
	(replace
 (TRANSACTIONNOTE STATE) of
 (CDR THISPENDINGSERVICE) with
 FINISHOW?)
	(SETQ \ES.PENDINGSERVICES (DREMOVE THISPENDINGSERVICE \ES.PENDINGSERVICES)))
    (replace
 (TRANSACTIONNOTE TIME) of
 (CDR THISPENDINGSERVICE) with
 (CLOCK 0))
    (OR (MEMB THISPENDINGSERVICE \ES.COMPLETEDSERVICES)
	(push
 \ES.COMPLETEDSERVICES THISPENDINGSERVICE))
    (AND (NOT (NULL EVALSERVER.STATUS.WINDOW))
	 (\ES.INVALIDATE.STATUSW
))
    THISPENDINGSERVICE))

(\ES.ABORTPENDING

  (NLAMBDA (THISPENDINGSERVICE ABORTWHY)                     (* JonL "28-MAR-83 17:34")

    (PROG ((STATE (fetch
 (TRANSACTIONNOTE STATE) of
 (CDR THISPENDINGSERVICE))))
          (\ES.DELETE1PENDING
 THISPENDINGSERVICE (OR ABORTWHY (QUOTE (ABORTED LOCALLY BY ERROR/QUIT)))
			      )
          (RETURN (OR (EQ STATE (QUOTE RUNNING))
		      (if
 (TYPENAMEP STATE (QUOTE PROCESS))
			  then
 (DEL.PROCESS STATE)
			       T))))))

(\ES.PURGEOLDTHINGS

  (LAMBDA (SECONDSOLD MILLISECONDSOLD)                       (* JonL "31-MAY-83 02:46")

    (OR (AND (NULL \ES.PENDINGSERVICES)
	     (NULL \ES.COMPLETEDSERVICES)
	     (NULL (CAR \PUPINQUEUE)))
	(PROG ((#DELETIONS 0)
	       (OLDTIME (CLOCKDIFFERENCE (if
 MILLISECONDSOLD
					     then
 (AND (FIXP SECONDSOLD)
						       (NOT (EQ 0 SECONDSOLD))
						       (add
 MILLISECONDSOLD (TIMES SECONDSOLD 1000)))
						  MILLISECONDSOLD
					   else
 (TIMES 1000 (OR (FIXP SECONDSOLD)
								\ES.PURGEINTERVAL.SECS)))))
	       (OLDPUPTIME (CLOCKDIFFERENCE \PUPINQUEUE.MAXAGE))
	       COMPLETIONTIME)
	      (DECLARE
 (SPECVARS #DELETIONS))
	      (MAPC (MAPCONC \ES.PENDINGSERVICES (FUNCTION (LAMBDA (X)
				 (PROG ((PROC (fetch
 (TRANSACTIONNOTE STATE) of
 (CDR X))))
				       (AND (if
 (TYPENAMEP PROC (QUOTE PROCESS))
						then
 (RELPROCESSP PROC)
					      else
 (NOT (EQ PROC (QUOTE RUNNING))))
					    (RETURN (LIST X)))))))
		    (FUNCTION \ES.DELETE1PENDING))           (* These services are "losers" because they are still on

							     the PENDINGSERVICES list, but their underlying process 

							     is dead.)

	      (OR (NULL \ES.COMPLETEDSERVICES)
		  (if
 (OR (NULL (SETQ COMPLETIONTIME (fetch
 (TRANSACTIONNOTE TIME)
							of
 (CDR (CAR \ES.COMPLETEDSERVICES)))))
			  (TIMEREXPIRED? COMPLETIONTIME OLDTIME))
		      then
                                   (* Note the \ES.COMPLETEDSERVICES is a list wherein the 

							     more recent actions are cons'd onto the front.)

			   (AND \ES.TRACE? (add
 #DELETIONS (LENGTH \ES.COMPLETEDSERVICES)))
			   (SETQ \ES.COMPLETEDSERVICES NIL)
		    else
 (for
 L on
 \ES.COMPLETEDSERVICES bind
 X
			    do
 (if
 (AND (SETQ X (CADR L))
					(SETQ COMPLETIONTIME (fetch
 (TRANSACTIONNOTE TIME)
								of
 (CDR X)))
					(TIMEREXPIRED? COMPLETIONTIME OLDTIME))
				   then
 (AND \ES.TRACE? (add
 #DELETIONS (LENGTH (CDR L))))
					(RPLACD L NIL)
					(RETURN)))))         (* Trim down the record of already-completed services.

							     Newer entries are at the head.)

	      (UNINTERRUPTABLY
                  (PROG ((LEN (LENGTH (CAR \PUPINQUEUE))))
		        (if
 (IGREATERP LEN \PUPINQUEUE.MAXLENGTH)
			    then
 (AND \ES.TRACE? (add
 #DELETIONS (IDIFFERENCE LEN 
									    \PUPINQUEUE.MAXLENGTH)))
				 (RPLACA \PUPINQUEUE (NTH (CAR \PUPINQUEUE)
							  \PUPINQUEUE.MAXLENGTH))))
		  (OR (NULL (CDR \PUPINQUEUE))
		      (if
 (TIMEREXPIRED? (CDR (CAR (CDR \PUPINQUEUE)))
					 OLDPUPTIME)
			  then
                               (* Even the most recent entry on \PUPINQUEUE is too 

							     old.)

			       (AND \ES.TRACE? (add
 #DELETIONS (LENGTH (CAR \PUPINQUEUE))))
			       (RPLACA \PUPINQUEUE NIL)
			       (RPLACD \PUPINQUEUE NIL)
			else
 (for
 L on
 (CAR \PUPINQUEUE) as
 I from
 0
				do
 (if
 (NOT (TIMEREXPIRED? (CDR (CAR L))
							   OLDPUPTIME))
				       then
                  (* So all the pups up until here are "oldies" too.)

					    (RPLACA \PUPINQUEUE L)
					    (AND (NULL L)
						 (RPLACD \PUPINQUEUE NIL))
					    (AND \ES.TRACE? (add
 I 1))
					    (RETURN)))
			     (if
 (CAR \PUPINQUEUE)
				 then
 (if
 (NOT \ES.TRACE?)
					  then
               (* Just to reduce lossage on following add command)

					       (SETQ #DELETIONS 0))
				      (PROG ((LIVESKT#S (MAPCAR \PUPSOCKETS (FUNCTION PUPSOCKETNUMBER)
								))
					     (\List (CAR \PUPINQUEUE))
					     (\EndOfQ (CDR \PUPINQUEUE))
					     \BackL)
					    (DECLARE
 (LOCALVARS \PUPINQUEUE \Count \List \EndOfQ 
								\BackL))
					\REMTCONCloop
					    (if
 (NLISTP \List)
						then
 (RETURN)
					      elseif
 (MEMBER (fetch
 PUPDESTSOCKET
								of
 (CAR (CAR \List)))
							     LIVESKT#S)
						then
 (if
 \BackL
							 then
 (RPLACD \BackL (CDR \List))
						       else
 (RPLACA \PUPINQUEUE \List))
						     (if
 (EQ \List \EndOfQ)
							 then
 (RPLACD \PUPINQUEUE \BackL))
						     (add
 #DELETIONS 1)
					      else
 (SETQ \BackL \List))
					    (pop
 \List)
					    (GO \REMTCONCloop))))))
	      (if
 \ES.TRACE?
		  then
 (printout
 \ES.MESSAGESTREAM .TAB0 0 "Deleted " #DELETIONS 
				 " old things -- \ES.PURGEOLDTHINGS."))))))
)



(* Things related to coordination of Broadcast case of REMOTEVAL)


(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD BROADAPNOTE
 (BROADLIMIT SERVERHOST REFID OPUP TRANSCEIVER EXITCOUNT)
		    (RECORD BROADLIMIT (UPROC FINALTIME)))
]
)

(RPAQ? \ES.BroadSweepQ
 (LIST NIL))

(RPAQ? \ES.BroadAppEVENT
 (CREATE.EVENT (QUOTE \ES.BroadAppEVENT)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \ES.BroadSweepQ \ES.BroadAppEVENT \ES.BroadAppSweeper)
)
(DEFINEQ

(\ES.BroadAppSweeper

  (LAMBDA NIL                                                (* JonL "31-MAY-83 03:50")

    (PROG (NOTE FINALCALL?)
      LOOP(AWAIT.EVENT \ES.BroadAppEVENT (CONSTANT (IQUOTIENT \ETHERTIMEOUT 2)))
          (for
 SWEEPENTRY in
 (CAR \ES.BroadSweepQ)
	     do
 (SETQ NOTE (CDR SWEEPENTRY))
		(APPLY* (CAR SWEEPENTRY)
			SWEEPENTRY
			(SETQ FINALCALL? (OR (TIMEREXPIRED? (fetch
 FINALTIME of
 NOTE))
					     (RELPROCESSP (fetch
 UPROC of
 NOTE)))))
		(BLOCK)
		(if
 FINALCALL?
		    then
 ((LAMBDA (OPUP)
			     (UNINTERRUPTABLY
                                 (AND (type?
 PUP OPUP)
				      (RELEASE.PUP OPUP))
				 (replace
 OPUP of
 NOTE with
 NIL)))
			   (fetch
 OPUP of
 NOTE))
			 (\UNTCONC
 \ES.BroadSweepQ SWEEPENTRY)))
          (GO LOOP))))

(\ES.RejectApplicants

  (LAMBDA (SWEEPENTRY FINALCALL?)                            (* JonL "31-MAY-83 03:47")

    ((LAMBDA (NOTE)
	(PROG ((MY.REF.ID (fetch
 REFID of
 NOTE))
	       (MY.TRANSCEIVER (fetch
 TRANSCEIVER of
 NOTE))
	       IPUP OPUP)
	  A   (if
 (AND (SETQ IPUP (\GETFILTEREDPUP
 MY.TRANSCEIVER (CONSTANT (LIST \PT.ACKNOWLEDGE))
						   MY.REF.ID))
		       (NOT (EQP (fetch
 SERVERHOST of
 NOTE)
				 (fetch
 (PUP SOURCE) of
 IPUP))))
		  then
 (SETQ OPUP (fetch
 OPUP of
 NOTE))
		       (if
 (NOT (type?
 PUP OPUP))
			   then
 (PROG ((ADDRESS (fetch
 (PUP SOURCE) of
 IPUP))
				       (SKT# (fetch
 (PUP SOURCESKT) of
 IPUP)))
				      (RELEASE.PUP IPUP)
				      (SETQ OPUP (\ALLOCATE.BIGPUP))
				      (SETUPPUP OPUP ADDRESS SKT# \PT.EVALREQUEST.CERTIFY MY.REF.ID 
						MY.TRANSCEIVER))
				(1BYTETOPUP 0 OPUP)
				(replace
 OPUP of
 NOTE with
 OPUP)
			 else
 (RELEASE.PUP IPUP))
		       (SETQ IPUP)
		       (\SENDUNFILTEREDPUP
 MY.TRANSCEIVER OPUP (QUOTE (
"=== Losing broadcast applicant is rejected." REMOTEVAL)))
		       (if
 FINALCALL?
			   then
                              (* Just to be sure)

				(BLOCK)
				(GO A))
		elseif
 FINALCALL?
		  then
 (\ES.EXITREMOTEVAL
 NIL NIL MY.TRANSCEIVER (fetch
 EXITCOUNT of
 NOTE)))))
      (CDR SWEEPENTRY))))

(\ES.ApplicantValid?

  (LAMBDA (SWEEPENTRY FINALCALL?)                            (* JonL "31-MAY-83 03:54")

    ((LAMBDA (NOTE)
	(PROG ((TRANSCEIVER (fetch
 TRANSCEIVER of
 NOTE))
	       (CLIENT'S.REF.ID (fetch
 REFID of
 NOTE)))
	      (if
 (\GETFILTEREDPUP
 TRANSCEIVER (CONSTANT (LIST \PT.EVALREQUEST.CERTIFY))
				   CLIENT'S.REF.ID
				   (QUOTE DELETE))
		  then
                                       (* The problem is that if we keep getting 
"certifications" from the client, then maybe he didn't hear our acknowledgement)

		       (PROG ((OPUP (fetch
 OPUP of
 NOTE)))
			     (OR (type?
 PUP OPUP)
				 (SHOULDNT (QUOTE PUP)))
			     (\SENDUNFILTEREDPUP
 TRANSCEIVER OPUP (QUOTE (
"=== EvalServer acknowledges certification re broadcast:" \ES.DO1THING)))
			     (replace
 EXITCOUNT of
 NOTE with
 (SETUPTIMER \ETHERTIMEOUT
									 (fetch
 EXITCOUNT
									    of
 NOTE)))))
	      (if
 FINALCALL?
		  then
 ((LAMBDA (LASTIME)
			   (if
 (AND LASTIME (NOT (TIMEREXPIRED? LASTIME)))
			       then
                          (* Abort service if he keeps sending requests for 

							     certification)

				    (DEL.PROCESS (fetch
 UPROC of
 NOTE))))
			 (fetch
 EXITCOUNT of
 NOTE)))))
      (CDR SWEEPENTRY))))
)
(push AFTERSYSOUTFORMS (QUOTE (PROGN (RPAQQ \BROADCASTADDRESS.ON.MYNET)
				     (RPAQQ \ES.LOCALHOSTNUMBER)
				     (RPAQQ \ES.LOSTSOCKETSLST))))

(ADDTOVAR PUPPRINTMACROS
 (200 CHARS 32 ...)
			 (202 CHARS 32 ...)
			 (203 CHARS 32 ...)
			 (204 CHARS 32 ...)
			 (205 BYTES 1 ...))



(* Debugging aids)



(RPAQQ \ES.TRACE?
 NIL)

(RPAQQ EVALSERVER.STATUS.WINDOW
 NIL)

(RPAQQ \ES.LASTSTATUSLIST
 NIL)

(RPAQQ \ES.IQMENU
 NIL)

(RPAQQ \ES.RUNMENU
 NIL)

(RPAQQ \ES.DONEMENU
 NIL)
(DEFINEQ

(EVALSERVER.TRACE

  (LAMBDA (FLG REGION)                                       (* JonL "17-JUN-82 22:57")

    (if
 (NULL FLG)
	then
 (SETQ \ES.TRACE? NIL)
	     (AND (type?
 DISPLAYSTREAM \ES.MESSAGESTREAM)
		  (WINDOWP (fetch
 (DISPLAYSTREAM XWINDOWHINT) of
 \ES.MESSAGESTREAM))
		  (CLOSEW (fetch
 (DISPLAYSTREAM XWINDOWHINT) of
 \ES.MESSAGESTREAM)))
	     NIL
      else
 (if
 (OR REGION (AND (NOT (WINDOWP \ES.MESSAGESTREAM))
			       (NOT (type?
 DISPLAYSTREAM \ES.MESSAGESTREAM))))
	       then
 (SETQ \ES.MESSAGESTREAM (CREATEW REGION "Remote Eval Service Actions")))
	   (WINDOWPROP \ES.MESSAGESTREAM (QUOTE BUTTONEVENTFN)
		       (FUNCTION \ES.BUGGERTRACEWINDOW))
	   (SETQ \ES.MESSAGESTREAM (WINDOWPROP \ES.MESSAGESTREAM (QUOTE DSP)))
	   (DSPFONT (FONTCREATE (QUOTE GACHA)
				8)
		    \ES.MESSAGESTREAM)
	   (SETQ \ES.TRACE? T)
	   (DSPSCROLL T \ES.MESSAGESTREAM)
	   (PRIN1 (CHARACTER (CHARCODE SPACE))
		  \ES.MESSAGESTREAM)                         (* Just to be sure that the window is visible.)

	   \ES.MESSAGESTREAM)))

(\ES.BUGGERTRACEWINDOW

  (LAMBDA (WINDOW)                                           (* JonL "12-JUN-82 07:29")

    (AND WINDOW (NOT (ACTIVEWP WINDOW))
	 (OPENW WINDOW))
    (COND
      ((OR (NULL WINDOW)
	   (LASTMOUSESTATE LEFT))
	(printout
 WINDOW .TAB0 0 "[Traceing " (COND
		    (\ES.TRACE? (SETQ \ES.TRACE? NIL)
				"Off]")
		    (T (SETQ \ES.TRACE? T)
		       "On]"))))
      ((LASTMOUSESTATE MIDDLE)
	(DSPRESET WINDOW)))
    NIL))

(\ES.PRINTRACE

  (LAMBDA (TPUP TRACEINFO FUN)                               (* JonL "14-JUN-82 17:26")

    (if
 (AND \ES.TRACE? TRACEINFO)
	then
 (if
 (LISTP TRACEINFO)
		 then
 (TERPRI \ES.MESSAGESTREAM)
		      (PRIN1 (pop
 TRACEINFO)
			     \ES.MESSAGESTREAM))
	     (PRINTPUP TPUP (if
 (LISTP TRACEINFO)
				then
 (CAR TRACEINFO)
			      else
 (OR TRACEINFO FUN))
		       \ES.MESSAGESTREAM))))
)
(DEFINEQ

(EVALSERVER.STATUS.WINDOW

  (LAMBDA (WIN/REG)
    (DECLARE
 (GLOBALVARS WBorder WindowTitleDisplayStream))
                                                             (* JonL "28-MAY-83 22:54")

    (PROG ((BLACKPART (FOLDHI WBorder 2))
	   (WHITEPART (FOLDLO WBorder 2))
	   (WHOLEWINDOWTITLE "EvalServer Status")
	   (TBHEIGHT (IPLUS WBorder (IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))))
	   INNERBORDERSIZE CUR.YPOS LEFT BOTTOM HEIGHT WIDTH)
          (SETQ INNERBORDERSIZE (IPLUS WHITEPART BLACKPART WHITEPART))
          (if
 EVALSERVER.STATUS.WINDOW
	      then
 (DELETEMENU \ES.IQMENU)
		   (DELETEMENU \ES.RUNMENU)
		   (DELETEMENU \ES.DONEMENU)
		   (CLEARW EVALSERVER.STATUS.WINDOW))
          (SETQ \ES.LASTSTATUSLIST (EVALSERVER.STATUS
))
          (SETQ \ES.IQMENU (create
 MENU
				   TITLE ← "Input Queue"
				   ITEMS ←(\ES.STATUSW.GETITEMS
 (CDR (ASSOC (QUOTE 
									   EvalServer.InputQueue:)
									    \ES.LASTSTATUSLIST)))
				   CENTERFLG ← T
				   WHENSELECTEDFN ←(QUOTE \ES.STATUSW.SELECTEDFN)
				   WHENHELDFN ←(QUOTE \ES.STATUSW.HELDFN)
				   MENUFONT ←(FONTCREATE (QUOTE GACHA)
							 10)))
          (SETQ \ES.RUNMENU (create
 MENU
				    TITLE ← "Currently Running"
				    ITEMS ←(\ES.STATUSW.GETITEMS
 (CDR (ASSOC (QUOTE 
								   CurrentlyRunning.Transactions:)
									     \ES.LASTSTATUSLIST)))
				    CENTERFLG ← T
				    WHENSELECTEDFN ←(QUOTE \ES.STATUSW.SELECTEDFN)
				    WHENHELDFN ←(QUOTE \ES.STATUSW.HELDFN)
				    MENUFONT ←(FONTCREATE (QUOTE GACHA)
							  10)))
          (SETQ \ES.DONEMENU (create
 MENU
				     TITLE ← "Completed Services"
				     ITEMS ←(\ES.STATUSW.GETITEMS
 (CDR (ASSOC (QUOTE 
									  Completed.Transactions:)
									      \ES.LASTSTATUSLIST)))
				     CENTERFLG ← T
				     WHENSELECTEDFN ←(QUOTE \ES.STATUSW.SELECTEDFN)
				     WHENHELDFN ←(QUOTE \ES.STATUSW.HELDFN)
				     MENUFONT ←(FONTCREATE (QUOTE GACHA)
							   10)))
          (SETQ WIDTH (IPLUS (PROG1 WBorder                  (* Comment PPLossage)
)
			     (IMAX (fetch
 IMAGEWIDTH of
 \ES.IQMENU)
				   (fetch
 IMAGEWIDTH of
 \ES.RUNMENU)
				   (fetch
 IMAGEWIDTH of
 \ES.DONEMENU)
				   (STRINGWIDTH WHOLEWINDOWTITLE (DSPFONT NIL 
									 WindowTitleDisplayStream)))
			     WBorder))
          (SETQ HEIGHT (IPLUS TBHEIGHT WHITEPART (fetch
 IMAGEHEIGHT of
 \ES.IQMENU)
			      INNERBORDERSIZE
			      (fetch
 IMAGEHEIGHT of
 \ES.RUNMENU)
			      INNERBORDERSIZE
			      (fetch
 IMAGEHEIGHT of
 \ES.DONEMENU)
			      WBorder))
          (if
 EVALSERVER.STATUS.WINDOW
	      then
 ((LAMBDA (OREG)
		       (SETQ LEFT (fetch
 (REGION LEFT) of
 OREG))
		       (SETQ BOTTOM (fetch
 (REGION BOTTOM) of
 OREG)))
		     (WINDOWPROP EVALSERVER.STATUS.WINDOW (QUOTE REGION)))
	    else
                                             (* Create the window "quietly" since SHAPEW will open 

							     it.)

		 (SETQ EVALSERVER.STATUS.WINDOW
		   (CREATEW (OR WIN/REG
				(CONSTANT (create
 REGION
						  LEFT ← 0
						  BOTTOM ← 0
						  WIDTH ← 100
						  HEIGHT ← 100)))
			    WHOLEWINDOWTITLE WBorder T))
		 (PROMPTPRINT "Position the EvalServer Status Window.")
		 ((LAMBDA (POS)
		     (SETQ LEFT (fetch
 XCOORD of
 POS))
		     (SETQ BOTTOM (fetch
 YCOORD of
 POS)))
		   (GETBOXPOSITION WIDTH HEIGHT)))
          (SHAPEW EVALSERVER.STATUS.WINDOW
		  (create
 REGION
			  LEFT ← LEFT
			  BOTTOM ← BOTTOM
			  WIDTH ← WIDTH
			  HEIGHT ← HEIGHT))
          (SETQ CUR.YPOS (IDIFFERENCE (PROG1 HEIGHT          (* Comment PPLossage)
)
				      (IPLUS TBHEIGHT WHITEPART (fetch
 IMAGEHEIGHT of
 \ES.IQMENU))))
          (ADDMENU \ES.IQMENU (PROG1 EVALSERVER.STATUS.WINDOW 
                                                             (* Comment PPLossage)
)
		   (create
 POSITION
			   XCOORD ←(IDIFFERENCE (IQUOTIENT (IDIFFERENCE WIDTH (fetch
 IMAGEWIDTH
										 of
 \ES.IQMENU))
							   2)
						WBorder)
			   YCOORD ←(IDIFFERENCE CUR.YPOS WBorder)))
          (SETQ CUR.YPOS (IDIFFERENCE CUR.YPOS WBorder))
          (BITBLT NIL NIL NIL (SCREENBITMAP)
		  (IPLUS LEFT BLACKPART)
		  (IPLUS BOTTOM CUR.YPOS)
		  (IDIFFERENCE WIDTH (ITIMES 2 BLACKPART))
		  BLACKPART
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)
          (SETQ CUR.YPOS (IDIFFERENCE (IDIFFERENCE CUR.YPOS WHITEPART)
				      (fetch
 IMAGEHEIGHT of
 \ES.RUNMENU)))
          (ADDMENU \ES.RUNMENU (PROG1 EVALSERVER.STATUS.WINDOW 
                                                             (* Comment PPLossage)
)
		   (create
 POSITION
			   XCOORD ←(IDIFFERENCE (IQUOTIENT (IDIFFERENCE WIDTH (fetch
 IMAGEWIDTH
										 of
 \ES.RUNMENU))
							   2)
						WBorder)
			   YCOORD ←(IDIFFERENCE CUR.YPOS WBorder)))
          (SETQ CUR.YPOS (IDIFFERENCE CUR.YPOS WBorder))
          (BITBLT NIL NIL NIL (SCREENBITMAP)
		  (IPLUS LEFT BLACKPART)
		  (IPLUS BOTTOM CUR.YPOS)
		  (IDIFFERENCE WIDTH (ITIMES 2 BLACKPART))
		  BLACKPART
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)
          (SETQ CUR.YPOS (IDIFFERENCE (IDIFFERENCE CUR.YPOS WHITEPART)
				      (fetch
 IMAGEHEIGHT of
 \ES.DONEMENU)))
          (ADDMENU \ES.DONEMENU (PROG1 EVALSERVER.STATUS.WINDOW 
                                                             (* Comment PPLossage)
)
		   (create
 POSITION
			   XCOORD ←(IDIFFERENCE (IQUOTIENT (IDIFFERENCE WIDTH (fetch
 IMAGEWIDTH
										 of
 \ES.DONEMENU))
							   2)
						WBorder)
			   YCOORD ←(IDIFFERENCE CUR.YPOS WBorder))))))

(\ES.STATUSW.GETITEMS

  (LAMBDA (L)                                                (* JonL " 5-NOV-82 23:27")

                                                             (* Each item on L is like ((ID#.ClientHost: <nnn> 

							     <hostname>) (...)))

    (MAPCAR L (FUNCTION (LAMBDA (X)
		(SETQ X (CDAR X))
		(LIST (CONCAT (CADR X)
			      (QUOTE %.)
			      (CAR X))
		      (CONS (CAR X)
			    (CADR X))))))))

(\ES.STATUSW.SELECTEDFN

  (LAMBDA (ITEM MENU BUTTON)                                 (* JonL " 8-NOV-82 19:11")

    (SELECT MENU ((\ES.IQMENU)
	     (SELECTQ BUTTON
		      (LEFT                                  (* Someday, have it print out the waiting time)

			    )
		      (MIDDLE (while
 (\GETFILTEREDPUP
 \EVALREQUEST.SOCKET (CONSTANT (LIST 
										  \PT.EVALREQUEST 
									 \PT.EVALREQUEST.NORESULT))
						      (CAR (CADR ITEM))
						      (QUOTE DELETE))))
		      NIL))
	    ((\ES.RUNMENU)
	     (SELECTQ BUTTON
		      (LEFT                                  (* Someday have to print out more things)

			    )
		      (MIDDLE (EVALSERVER.ABORT
 (CADR ITEM)))
		      NIL))
	    ((\ES.DONEMENU)
	     (SELECTQ BUTTON
		      (LEFT                                  (* Someday have to print out more things)

			    )
		      (MIDDLE (PROG ((ID#.CLIENT (CONS (CAR (CADR ITEM))
						       (ETHERHOSTNUMBER (CDR (CADR ITEM)))))
				     LOSER)
				    (AND (SETQ LOSER (SASSOC ID#.CLIENT \ES.COMPLETEDSERVICES))
					 (SETQ \ES.COMPLETEDSERVICES (DREMOVE LOSER 
									    \ES.COMPLETEDSERVICES)))))
		      NIL))
	    (SHOULDNT))
    (AND (EQ BUTTON (QUOTE MIDDLE))
	 (SHADEITEM ITEM MENU FUZZYSHADE))))

(\ES.STATUSW.HELDFN

  (LAMBDA (ITEM MENU BUTTON)                                 (* JonL " 6-NOV-82 00:12")

    (PROMPTPRINT (SELECTQ BUTTON
			  (LEFT "Shows more detailed information about this item.")
			  (MIDDLE (SELECT MENU ((\ES.IQMENU)
					   "Removes this request from the input queue.")
					  ((\ES.RUNMENU)
					   "Aborts this service.")
					  ((\ES.DONEMENU)
					   "Deletes this item from the status lists")
					  (QUOTE ??)))
			  (QUOTE ??)))))

(\ES.INVALIDATE.STATUSW

  (LAMBDA NIL                                                (* JonL " 8-NOV-82 21:42")

    (AND (type?
 WINDOW EVALSERVER.STATUS.WINDOW)
	 (NEQ (WINDOWPROP EVALSERVER.STATUS.WINDOW (QUOTE BUTTONEVENTFN))
	      (QUOTE \ES.UPDATE.STATUSW))
	 (UNINTERRUPTABLY
             (WINDOWPROP EVALSERVER.STATUS.WINDOW (QUOTE OLDBUTTONEVENTFN)
			 (WINDOWPROP EVALSERVER.STATUS.WINDOW (QUOTE BUTTONEVENTFN)
				     (QUOTE \ES.UPDATE.STATUSW)))
	     (if
 (ACTIVEWP EVALSERVER.STATUS.WINDOW)
		 then
 (DSPFILL NIL LIGHTGRAYSHADE (QUOTE INVERT)
			       EVALSERVER.STATUS.WINDOW)
	       else
 NIL)))))

(\ES.UPDATE.STATUSW

  (LAMBDA (WINDOW)                                           (* JonL " 5-NOV-82 22:36")

    (PROG ((OLDBUTTONFN (WINDOWPROP WINDOW (QUOTE OLDBUTTONFN)
				    NIL)))
          (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
		      OLDBUTTONFN)                           (* Restore original button fn, and apply it after fixing

							     up.)

          (EVALSERVER.STATUS.WINDOW
)
          (if
 OLDBUTTONFN
	      then
 (APPLY* OLDBUTTONFN WINDOW)))))
)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \ES.TRACE? EVALSERVER.STATUS.WINDOW \ES.LASTSTATUSLIST \ES.IQMENU \ES.RUNMENU 
	  \ES.DONEMENU)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ LIGHTGRAYSHADE
 1)

(RPAQQ FUZZYSHADE
 2564)

(CONSTANTS LIGHTGRAYSHADE FUZZYSHADE)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 \ES.ABORTQQ \ES.APPLYQQ)

(ADDTOVAR NLAML
 \ES.ABORTPENDING \ES.DO1THING \ES.LISTENER)

(ADDTOVAR LAMA
 )
)
(PUTPROPS EVALSERVER COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4463 8278 (ORDINALSUFFIXSTRING 4473 . 4784) (PRIN4.INTO.STRING 4786 . 6735) (\P4S.FOOT 
6737 . 7148) (\P4S.PERCHAR 7150 . 7705) (\UNTCONC 7707 . 8276)) (10220 16686 (\BASEBYTES.IO.INIT 10230
 . 13788) (\MAKEBASEBYTESTREAM 13790 . 15641) (\BASEBYTES.NAME.FROM.STREAM 15643 . 15945) (
\BASEBYTES.BLOCKIO 15947 . 16684)) (18247 27218 (READ.FROM.PUP 18257 . 19178) (PRINT.INTO.PUP 19180 . 
22049) (\ES.LOCALHOSTNUMBER 22051 . 22328) (\HNM.MEMBER 22330 . 22973) (\NORMALIZEHOSTNUM 22975 . 
23336) (\BROADCASTADDRESS.ON.MYNET 23338 . 23633) (\ES.PUP2DEADSOCKET? 23635 . 23916) (\GETFILTEREDPUP
 23918 . 26978) (\SENDUNFILTEREDPUP 26980 . 27216)) (29621 63002 (REMOTEVAL 29631 . 36148) (
\ES.EXITREMOTEVAL 36150 . 36808) (REMOTEABORT 36810 . 38258) (REMOTEAPPLY 38260 . 38473) (\ES.APPLYQQ 
38475 . 38617) (EVALSERVER 38619 . 39806) (\ES.LISTENER 39808 . 44224) (\ES.DO1THING 44226 . 51995) (
\ES.ABORTQQ 51997 . 52153) (EVALSERVER.ABORT 52155 . 54035) (EVALSERVER.STATUS 54037 . 56845) (
\ES.MakeClientHostInfo 56847 . 57265) (\ES.DELETE1PENDING 57267 . 58131) (\ES.ABORTPENDING 58133 . 
58603) (\ES.PURGEOLDTHINGS 58605 . 63000)) (63490 67053 (\ES.BroadAppSweeper 63500 . 64332) (
\ES.RejectApplicants 64334 . 65729) (\ES.ApplicantValid? 65731 . 67051)) (67563 69542 (
EVALSERVER.TRACE 67573 . 68655) (\ES.BUGGERTRACEWINDOW 68657 . 69106) (\ES.PRINTRACE 69108 . 69540)) (
69543 78460 (EVALSERVER.STATUS.WINDOW 69553 . 75165) (\ES.STATUSW.GETITEMS 75167 . 75600) (
\ES.STATUSW.SELECTEDFN 75602 . 76851) (\ES.STATUSW.HELDFN 76853 . 77326) (\ES.INVALIDATE.STATUSW 77328
 . 77964) (\ES.UPDATE.STATUSW 77966 . 78458)))))
STOP