(FILECREATED "13-Dec-84 04:12:58" {ERIS}<LISPCORE>LIBRARY>EVALSERVER.;20 80311
changes to: (FNS \ES.DO1THING \ES.LISTENER)
previous date: " 8-Dec-84 23:28:36" {ERIS}<LISPCORE>LIBRARY>EVALSERVER.;18)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EVALSERVERCOMS)
(RPAQQ EVALSERVERCOMS ((LOCALVARS . T)
(FILES (SYSLOAD FROM LISPUSERS)
PLURAL)
(COMS (* "Generally useful utilities")
(FNS PRIN4.INTO.STRING \P4S.FOOT \P4S.PERCHAR \UNTCONC)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \FILLINSTRPTR \UNTCONC)
(RESOURCES \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER))
(INITRESOURCES \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER))
(COMS (* "Pup/Net assistance")
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \ALLOCATE.BIGPUP RECLAIM.PUP RECLAIM.OUTPUT.PUP
HOSTNUMBERP PROBABLYSOCKETP HOST#.FROM.ADDRESS
NTWK#.FROM.ADDRESS \ES.LOCALHOSTNUMBER)
(RECORDS BVM.LOSES.PUPSOCKET)
(RESOURCES \PIP.SCRATCHSPTR \GFP.TIMER \READPUPSTREAM \WRITEPUPSTREAM))
(MACROS #PUPDATABYTES #PUPDATABYTES.LEFT)
(INITRESOURCES \PIP.SCRATCHSPTR \GFP.TIMER \READPUPSTREAM \WRITEPUPSTREAM)
(FNS READ.FROM.PUP PRINT.INTO.PUP \HNM.MEMBER \NORMALIZEHOSTNUM
\BROADCASTADDRESS.ON.MYNET \GETFILTEREDPUP \SENDUNFILTEREDPUP \ES.GETSOCKET
\ES.RECLAIM.PUP \ES.RELEASE.OUTPUT.PUP)
(GLOBALVARS \PUPSOCKETS \LOCALPUPNETHOST))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TRANSACTIONNOTE)
(MACROS TYPE\ID.OF.PUP? CONNECTIONIDP TRACEAPUP 1BYTETOPUP
\BROADCASTADDRESS.ON.MYNET))
(VARS (\BROADCASTADDRESS.ON.MYNET NIL))
(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.TTYWINDOW NIL)
(\ES.TTYWINDOWSTREAM 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.TTYWINDOW \ES.TTYWINDOWSTREAM \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS
\ES.COMPLETEDSERVICES \ES.PENDINGSERVICES \ES.LOSTSOCKETSLST
\BROADCASTADDRESS.ON.MYNET)
(FNS REMOTEVAL \ES.EXITREMOTEVAL \ES.CLOSEOUTSOCKET \ES.UNCACHE REMOTEABORT REMOTEAPPLY
\ES.APPLYQQ EVALSERVER \ES.RESTART \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.AddSweeping \ES.Re-acknowledge.service
\ES.IgnoreApplicants \ES.RejectApplicants \ES.WatchSocket \ES.ApplicantValid?))
(DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY
(P (MAPC (QUOTE (LOGOUTFORMS SYSOUTFORMS MAKESYSFORMS))
(FUNCTION (LAMBDA (X)
(MAPC (QUOTE ((BEFORE (\ES.UNCACHE))
(AFTER (\ES.RESTART))))
(FUNCTION (LAMBDA
(Y)
(APPLY (QUOTE ADDTOVAR)
(CONS (PACK* (CAR Y)
X)
(CDR Y)))))))))))
(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)
)
(FILESLOAD (SYSLOAD FROM LISPUSERS)
PLURAL)
(* "Generally useful utilities")
(DEFINEQ
(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 DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \FILLINSTRPTR DMACRO (OPENLAMBDA (STRPTR STRBASE STROFFST STRLENGTH)
(replace (STRINGP BASE) of STRPTR with STRBASE)
(freplace (STRINGP OFFST) of STRPTR with STROFFST)
(freplace (STRINGP LENGTH) of STRPTR with STRLENGTH)
STRPTR))
(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 \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: EVAL@COMPILE
(PUTDEF (QUOTE \P4S.SCRATCHLIST)
(QUOTE RESOURCES)
(QUOTE (NEW (LIST NIL))))
(PUTDEF (QUOTE \P4S.STR.BYTEPOINTER)
(QUOTE RESOURCES)
(QUOTE (NEW (ALLOCSTRING 0))))
)
)
(/SETTOPVAL (QUOTE \\P4S.SCRATCHLIST.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\P4S.STR.BYTEPOINTER.GLOBALRESOURCE))
(* "Pup/Net assistance")
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \ALLOCATE.BIGPUP DMACRO (NIL
((LAMBDA (Pup)
(replace (ETHERPACKET EPREQUEUE) of Pup with T)
Pup)
(ALLOCATE.PUP))))
(PUTPROPS RECLAIM.PUP DMACRO ((PUP)
(\RELEASE.ETHERPACKET PUP)))
(PUTPROPS RECLAIM.OUTPUT.PUP DMACRO (OPENLAMBDA (PUP)
(OR (fetch EPTRANSMITTING of PUP)
(RECLAIM.PUP 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)))
(PUTPROPS \ES.LOCALHOSTNUMBER MACRO (NIL
(\LOCALPUPADDRESS)))
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD BVM.LOSES.PUPSOCKET ((NIL BYTE)
(NIL POINTER)
(PSOCKHI WORD)
(PSOCKLO WORD)))
]
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE \PIP.SCRATCHSPTR)
(QUOTE RESOURCES)
(QUOTE (NEW (ALLOCSTRING 0))))
(PUTDEF (QUOTE \GFP.TIMER)
(QUOTE RESOURCES)
(QUOTE (NEW (SETUPTIMER 0))))
(PUTDEF (QUOTE \READPUPSTREAM)
(QUOTE RESOURCES)
(QUOTE (NEW (\MAKEBASEBYTESTREAM 0 0 0 (QUOTE INPUT)))))
(PUTDEF (QUOTE \WRITEPUPSTREAM)
(QUOTE RESOURCES)
(QUOTE (NEW (\MAKEBASEBYTESTREAM 0 0 0 (QUOTE OUTPUT)))))
)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS #PUPDATABYTES DMACRO ((Pup)
(IDIFFERENCE (FETCH PUPLENGTH OF Pup)
\PUPOVLEN)))
(PUTPROPS #PUPDATABYTES.LEFT DMACRO (OPENLAMBDA (Pup)
(IDIFFERENCE \MAX.PUPLENGTH (#PUPDATABYTES Pup))))
)
(/SETTOPVAL (QUOTE \\PIP.SCRATCHSPTR.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\GFP.TIMER.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\READPUPSTREAM.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\WRITEPUPSTREAM.GLOBALRESOURCE))
(DEFINEQ
(READ.FROM.PUP
(LAMBDA (PUP DATASTARTBYTE) (* JonL "18-JUL-83 18:18")
(SETQ PUP (\DTEST PUP (QUOTE ETHERPACKET)))
(if (DEFINEDP (QUOTE \MAKEBASEBYTESTREAM))
then (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))))
else ((LAMBDA (STR NCHARS)
(DECLARE (GLOBALVARS \STRINGOFDS))
(freplace (STRINGP BASE) of STR with (fetch PUPCONTENTS of PUP))
(freplace (STRINGP LENGTH) of STR with (if (OR (NULL DATASTARTBYTE)
(ZEROP DATASTARTBYTE))
then NCHARS
else (freplace (STRINGP OFFST) of STR
with DATASTARTBYTE)
(IDIFFERENCE NCHARS DATASTARTBYTE)))
(PROG1 (READ STR)
(PUTHASH STR NIL \STRINGOFDS)))
(ALLOCSTRING 0)
(#PUPDATABYTES PUP)))))
(PRINT.INTO.PUP
(LAMBDA (FORM PUP DATASTARTBYTE PRINFN NOERRORFLG) (* JonL " 8-Dec-84 23:28")
(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)))))
elseif (NOT (DEFINEDP (QUOTE \MAKEBASEBYTESTREAM)))
then (ERROR (QUOTE \MAKEBASEBYTESTREAM))
else (GLOBALRESOURCE (\WRITEPUPSTREAM)
(PROG ((PUPDATAOFFST
(CONSTANT (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)))))
(\HNM.MEMBER
(LAMBDA (HNM L) (* JonL "27-Nov-84 14:01")
(* 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 (EQP HNM (\ES.LOCALHOSTNUMBER))
else (OR (HOSTNUMBERP X)
(SETQ X (ETHERHOSTNUMBER X)))
(EQP HNM X))
(RETURN T)))))
(\NORMALIZEHOSTNUM
(LAMBDA (X DEFAULTADDRESS) (* JonL "18-JUL-83 20:09")
(if (NULL X)
then DEFAULTADDRESS
elseif (EQ X T)
then (\ES.LOCALHOSTNUMBER)
elseif (ZEROP X)
then (\BROADCASTADDRESS.ON.MYNET)
elseif (ETHERHOSTNUMBER X)
elseif DEFAULTADDRESS
else (ERROR X "Not a valid Network Host identification"))))
(\BROADCASTADDRESS.ON.MYNET
(LAMBDA NIL (* JonL "18-JUL-83 20:18")
(SETQ \BROADCASTADDRESS.ON.MYNET (create WORD
HIBYTE ←(\LOCALPUPNETNUMBER)
LOBYTE ← 0))))
(\GETFILTEREDPUP
(LAMBDA (SOC TYPESLST ID PUP? WAITINGTIME? TRACEINFO) (* JonL "19-Nov-84 18:23")
(* 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)
(SETQ PX (find X (SKT#LO ←(fetch PSOCKLO of SOC))
(SKT#HI ←(fetch PSOCKHI of SOC))
in (CAR \PUPINQUEUE)
suchthat (AND (EQ SKT#LO (fetch PUPDESTSOCKETLO
of (CAR X)))
(EQ SKT#HI (fetch PUPDESTSOCKETHI
of (CAR X)))
(TYPE\ID.OF.PUP? TYPESLST ID
(CAR 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 (RECLAIM.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 (RECLAIM.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))
(\ES.GETSOCKET
(LAMBDA NIL (* JonL "20-JUL-83 12:47")
(PROG ((S# (\CLOCK0 (NCREATE (QUOTE FIXP)))))
(if (IGEQ S# 0)
then (* Helps insure no conflict with defaultly-allocated
socket numbers.)
(\BOXIPLUS S# (CONSTANT (MASK.1'S (SUB1 BITS.PER.FIXP)
1))))
A (RETURN (OR (OPENPUPSOCKET S# (QUOTE DONT))
(PROGN (\BOXIPLUS S# 1)
(GO A)))))))
(\ES.RECLAIM.PUP
(LAMBDA (PUP) (* JonL "19-Nov-84 18:47")
(if (\ONQUEUE PUP \FREE.PACKET.QUEUE)
then (SHOULDNT "Reclaiming a PUP already on the free queue"))
(\RELEASE.ETHERPACKET PUP)))
(\ES.RELEASE.OUTPUT.PUP
(LAMBDA (X) (* JonL "19-Nov-84 18:23")
(OR (fetch EPTRANSMITTING of X)
(RECLAIM.PUP X))
NIL))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PUPSOCKETS \LOCALPUPNETHOST)
)
(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)
(EQ 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)))
(PUTPROPS \BROADCASTADDRESS.ON.MYNET MACRO (X
(COND
(X (QUOTE IGNOREMACRO))
(T (QUOTE (OR \BROADCASTADDRESS.ON.MYNET (\BROADCASTADDRESS.ON.MYNET T)))))))
)
)
(RPAQQ \BROADCASTADDRESS.ON.MYNET NIL)
(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.TTYWINDOW NIL)
(RPAQ? \ES.TTYWINDOWSTREAM 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
(GLOBALVARS \PUPINQUEUE \PUPINQUEUE.MAXLENGTH \PUPINQUEUE.MAXAGE \EVALREQUEST.SOCKET \ES.TTYWINDOW
\ES.TTYWINDOWSTREAM \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS \ES.COMPLETEDSERVICES
\ES.PENDINGSERVICES \ES.LOSTSOCKETSLST \BROADCASTADDRESS.ON.MYNET)
)
(DEFINEQ
(REMOTEVAL
(LAMBDA (FORM SERVERHOST MULTIPLE.RESPONSES? TIMEOUT.ms) (* JonL "20-JUL-83 18:28")
(if (NULL MULTIPLE.RESPONSES?)
then (SETQ MULTIPLE.RESPONSES? 1)) (* Check to be sure that the alleged form is EVALuable.)
(\CHECKTYPE FORM (OR (FMEMB (NTYPX FORM)
(CONSTANT (LIST \LISTP \LITATOM)))
(NUMBERP FORM)
(DEFEVAL (NTYPX FORM))))
(PROG ((BROADP (\BROADCASTADDRESS.ON.MYNET))
(OPUP (\ALLOCATE.BIGPUP))
(MY.TRANSCEIVER (\ES.GETSOCKET))
MSG IPUP MY.REF.ID HIS.TRANSCEIVER.SOC# MULTIPLE.TRANSMITP REMOTEVAL.timer EXIT.REFCOUNT)
(push \ES.LOSTSOCKETSLST MY.TRANSCEIVER)
(SETQ SERVERHOST (\NORMALIZEHOSTNUM SERVERHOST BROADP))
(SETQ BROADP (if (SMALLP BROADP)
then (EQ SERVERHOST BROADP)
else (EQUAL SERVERHOST BROADP)))
(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)
(if TIMEOUT.ms
then (SETQ REMOTEVAL.timer (SETUPTIMER TIMEOUT.ms)))
(DISCARDPUPS MY.TRANSCEIVER)
SENDOUTREQUEST
(bind (WAITINTERVAL ←(PROG1 \ETHERTIMEOUT (if TIMEOUT.ms
then (SETQ REMOTEVAL.timer (SETUPTIMER
TIMEOUT.ms)))))
for I from 1 repeatuntil (if REMOTEVAL.timer
then (TIMEREXPIRED? REMOTEVAL.timer)
else (IGREATERP I \MAXETHERTRIES))
do (if (EQ I 1)
then (SETQ MSG (QUOTE ("=== Client Dispatches an Eval Request:" REMOTEVAL)))
else (SETQ MULTIPLE.TRANSMITP T)
(add WAITINTERVAL (if (IGREATERP I 4)
then (CONSTANT (ITIMES 8 \ETHERTIMEOUT))
else WAITINTERVAL))
(SETQ MSG (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))
(\BOXIPLUS (SETQ EXIT.REFCOUNT (NCREATE (QUOTE FIXP)))
1)
(if BROADP
then (if (NEQ MULTIPLE.RESPONSES? 0)
then (* Got to certify the worker first.)
(SETUPPUP OPUP SERVERHOST HIS.TRANSCEIVER.SOC# \PT.EVALREQUEST.CERTIFY
MY.REF.ID MY.TRANSCEIVER)
(1BYTETOPUP 1 OPUP)
(bind (WAITINTERVAL ←(PROG1 \ETHERTIMEOUT (if TIMEOUT.ms
then (SETQ REMOTEVAL.timer
(SETUPTIMER
TIMEOUT.ms
REMOTEVAL.timer)))))
for I from 1 repeatuntil (if REMOTEVAL.timer
then (TIMEREXPIRED? REMOTEVAL.timer)
else (IGREATERP I \MAXETHERTRIES))
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)))
(\ES.AddSweeping (if (EQ MULTIPLE.RESPONSES? 0)
then (QUOTE \ES.IgnoreApplicants)
else (QUOTE \ES.RejectApplicants))
SERVERHOST MY.TRANSCEIVER MY.REF.ID TIMEOUT.ms (\BOXIPLUS
EXIT.REFCOUNT 1)))
(if (EQ MULTIPLE.RESPONSES? 0)
then (* In the broadcast case, we have made sure that at
least one host has acknowledged our request.
Others will just spuriously send acknowledgements.)
(\ES.EXITREMOTEVAL MY.TRANSCEIVER EXIT.REFCOUNT OPUP IPUP)
(RETURN MY.REF.ID))
(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)))
(\ES.AddSweeping (QUOTE \ES.Re-acknowledge.service)
SERVERHOST MY.TRANSCEIVER MY.REF.ID TIMEOUT.ms (\BOXIPLUS EXIT.REFCOUNT 1))
(* Flush any delayed communications from the server.)
(SELECTC (PROG1 (if IPUP
then (SETQ MSG (READ.FROM.PUP IPUP))
(fetch PUPTYPE of IPUP))
(\ES.EXITREMOTEVAL MY.TRANSCEIVER EXIT.REFCOUNT OPUP IPUP))
(\PT.EVALRESPONSE (RETURN MSG))
(\PT.EVALERROR (ERROR (CONCAT "Returned from Remote EVALuation with Error msg %""
(ERRORSTRING (CAR MSG))
"%"")
(CADR MSG)))
(ERROR "Remote EVALuation failed to return." FORM))
TIMEOUTERROR (* If we did'nt get thru after \MAXETHERTRIES, we're
probably losing badly.)
(\ES.EXITREMOTEVAL MY.TRANSCEIVER EXIT.REFCOUNT OPUP IPUP)
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 MY.TRANSCEIVER EXIT.REFCOUNT OPUP IPUP)
ERRORPUP.E
(ERROR IPUP "Error PUP")
(GO ERRORPUP.E))))
(\ES.EXITREMOTEVAL
(LAMBDA (MY.TRANSCEIVER EXIT.REFCOUNT? pup1 pup2) (* JonL "27-Nov-84 14:01")
(* When EXIT.REFCOUNT? goes down to zero
(or is NULL) then we can reclaim the socket in
MY.TRANSCEIVER)
(if (OR (NULL EXIT.REFCOUNT?)
(EQ 0 (\BOXIDIFFERENCE EXIT.REFCOUNT? 1)))
then (UNINTERRUPTABLY
(if (EQ MY.TRANSCEIVER (CAR \ES.LOSTSOCKETSLST))
then (pop \ES.LOSTSOCKETSLST)
else (PROG ((BPTR (find XB on \ES.LOSTSOCKETSLST suchthat (EQ MY.TRANSCEIVER
(CADR XB)))))
(if BPTR
then (RPLACD BPTR (CDDR BPTR)))))
(\ES.CLOSEOUTSOCKET MY.TRANSCEIVER)))
(AND pup1 (RECLAIM.OUTPUT.PUP pup1))
(AND pup2 (RECLAIM.OUTPUT.PUP pup2))
T))
(\ES.CLOSEOUTSOCKET
(LAMBDA (SOC) (* JonL "20-JUL-83 16:45")
(if (PROBABLYSOCKETP SOC)
then (DISCARDPUPS SOC)
(until (NULL (\GETFILTEREDPUP SOC NIL NIL (QUOTE DELETE))))
(CLOSEPUPSOCKET SOC T))))
(\ES.UNCACHE
(LAMBDA NIL (* JonL "19-Nov-84 19:55")
(SETQ \BROADCASTADDRESS.ON.MYNET)
(SETQ \ES.LOSTSOCKETSLST)
(SETQ \ES.PENDINGSERVICES)
(SETQ \ES.COMPLETEDSERVICES)
(SETQ \ES.LASTSTATUSLIST)))
(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 "19-Nov-84 19:59")
(DEL.PROCESS (FIND.PROCESS (QUOTE EvalServerListening)))
(DEL.PROCESS (FIND.PROCESS (QUOTE \ES.BroadAppSweeper)))
(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 (SETQ EVALSERVER (ADD.PROCESS (LIST (QUOTE \ES.LISTENER)
CLIENTSLST GAGGEDCLIENTSLST (AND (FIXP DURATION.MINUTES)
(TIMES 60000
DURATION.MINUTES)))
(QUOTE NAME)
(QUOTE EvalServerListening)
(QUOTE RESTARTABLE)
T)))))
(\ES.RESTART
(LAMBDA NIL (* JonL "19-Nov-84 19:53")
(PROG NIL
(RESTART.PROCESS (OR (FIND.PROCESS (QUOTE EvalServerListening))
(RETURN))))))
(\ES.LISTENER
(NLAMBDA (CLIENTSLST GAGS DURATION) (* JonL "13-Dec-84 03:53")
(* Args are passed in directly from EVALSERVER.
"Listens" for EvalRequests, and spawns off a process to
do one when it arrives.)
(if \ES.LOSTSOCKETSLST
then (* Each time that the EVALSERVER is restarted, this
swoop over the lost sockets will be done)
(UNINTERRUPTABLY
(MAPC (PROG1 \ES.LOSTSOCKETSLST (SETQ \ES.LOSTSOCKETSLST))
(FUNCTION \ES.CLOSEOUTSOCKET))))
(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))))
(SETQ \EVALREQUEST.SOCKET (OPENPUPSOCKET \SOCKET#.EVALREQUEST T))
(SETQ REQUESTEVENT (PUPSOCKETEVENT \EVALREQUEST.SOCKET))
(DISCARDPUPS \EVALREQUEST.SOCKET) (* Flush any stale requests still on the input queue.)
(SETQ NEXTPURGETIME (SETUPTIMER PURGEINTERVAL))
(OR (AND \ES.TTYWINDOWSTREAM (DISPLAYSTREAMP \ES.TTYWINDOWSTREAM))
(SETQ \ES.TTYWINDOWSTREAM
(if (GETD (QUOTE CREATEW))
then (WINDOWPROP (SETQ \ES.TTYWINDOW
(CREATEW (CONSTANT (create REGION
LEFT ← 150
BOTTOM ← 35
WIDTH ← 500
HEIGHT ← 300))
"TTY Window for REMOTEVAL services" NIL T))
(QUOTE DSP)))))
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)
(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))))
(QUOTE RESTARTABLE)
(QUOTE NO))
else (TRACEAPUP IPUP (QUOTE ("=== EvalServer Rejects Request:"
\ES.LISTENER)))))
(BLOCK)
(if (TIMEREXPIRED? NEXTPURGETIME)
then (\ES.PURGEOLDTHINGS NIL PURGEINTERVAL)
(SETUPTIMER PURGEINTERVAL NEXTPURGETIME)
(AND (NULL DURATION)
(SETQ \ES.EXECTTYWINDOWSTREAM (PROCESSPROP (FIND.PROCESS (QUOTE EXEC))
(QUOTE WINDOW)))
(SETQ \ES.EXECTTYWINDOWSTREAM (WINDOWPROP \ES.EXECTTYWINDOWSTREAM
(QUOTE DSP))))
(* Re-validate the exec tty window, when noting else
much is happening.)
(BLOCK)))
(if (NULL DURATION)
then (* Infinite time to be spent "in service")
(GO LOOP)))))
(\ES.DO1THING
(NLAMBDA (\RequestPUP) (* JonL "13-Dec-84 04:12")
(DECLARE (SPECVARS \RequestPUP))
(AND \ES.TTYWINDOWSTREAM (TTYDISPLAYSTREAM \ES.TTYWINDOWSTREAM))
(PROG ((OPUP (\ALLOCATE.BIGPUP))
(CLIENTADDRESS (fetch (PUP SOURCE) of \RequestPUP))
(CLIENTS.RECEIVER.SOCKET# (fetch (PUP SOURCESKT) of \RequestPUP))
(CLIENT'S.REF.ID (fetch (PUP PUPID) of \RequestPUP))
(BROADP (EQ (HOST#.FROM.ADDRESS (\BROADCASTADDRESS.ON.MYNET))
(fetch (PUP DESTHOST) of \RequestPUP)))
(FINISHOW? (QUOTE COMPLETED))
(ES.RESPONSE.SOCKET (\ES.GETSOCKET))
TRANSACTION.ID THISPENDINGSERVICE VAL PT DUPLICATEP)
(SETQ TRANSACTION.ID (CONS CLIENT'S.REF.ID CLIENTADDRESS))
(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 (SETQ THISPENDINGSERVICE (CONS TRANSACTION.ID (create TRANSACTIONNOTE
STATE ←(THIS.PROCESS)
TIME ←(CLOCK 0)
SOCKET ←
ES.RESPONSE.SOCKET)))
(push \ES.PENDINGSERVICES THISPENDINGSERVICE)
(OR (NULL EVALSERVER.STATUS.WINDOW)
(\ES.INVALIDATE.STATUSW))))
(TRACEAPUP (PROG1 \RequestPUP (* 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 (\ES.CLOSEOUTSOCKET ES.RESPONSE.SOCKET)
(GO RELEASE&EXIT)
elseif (AND BROADP (NEQ (fetch PUPTYPE of \RequestPUP)
\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 (if (fetch EPTRANSMITTING of OPUP)
else (\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)))
(EQ 0 (\GETBASEBYTE (fetch PUPCONTENTS
of CPUP)
0))))
then (* We've been turned down in our application)
(GO ABORT)
else (* Ah, we are awarded the contract!)
(if (fetch EPTRANSMITTING of OPUP)
then (SHOULDNT "OPUP not ready for re-use?"))
(replace (PUP PUPTYPE) of OPUP with \PT.EVALREQUEST.CERTIFY)
(\SENDUNFILTEREDPUP ES.RESPONSE.SOCKET OPUP
(QUOTE (
"=== EvalServer acknowledges certification re broadcast:" \ES.DO1THING)))
(\ES.AddSweeping (QUOTE \ES.ApplicantValid?)
CLIENTADDRESS ES.RESPONSE.SOCKET
CLIENT'S.REF.ID)
(RETURN))
finally (PROGN (* Sigh, looks like some other applicant got the job
for the broadcast request; or maybe the client died?)
(if (fetch EPTRANSMITTING of OPUP)
then (SHOULDNT "Transmitter lock-up?"))
(GO ABORT))))
(SETQ VAL (NLSETQ (EVAL (READ.FROM.PUP \RequestPUP))))
(if (EQ (fetch (PUP PUPTYPE) of \RequestPUP)
\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))
(if (fetch EPTRANSMITTING of OPUP)
then (* We'd like to re-use OPUP for output again.)
(SETQ OPUP (\ALLOCATE.BIGPUP)))
(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 (if (fetch EPTRANSMITTING of OPUP)
else (\SENDUNFILTEREDPUP ES.RESPONSE.SOCKET OPUP (QUOTE (
"=== EvalServer Sends Result: " \ES.DO1THING))))
(BLOCK)
(if (SETQ \RequestPUP (\GETFILTEREDPUP ES.RESPONSE.SOCKET (CONSTANT (LIST
\PT.ACKNOWLEDGE
\PT.ERROR))
CLIENT'S.REF.ID \RequestPUP WAITINTERVAL))
then (if (NEQ \PT.ERROR (fetch PUPTYPE of \RequestPUP))
then (TRACEAPUP \RequestPUP (QUOTE (
"Ah, Received Client's Acknowledgement of Results:" \ES.DO1THING)))
else (TRACEAPUP \RequestPUP (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)
(if (fetch EPTRANSMITTING of OPUP)
then (SHOULDNT "Transmitter wedged?")))
FINISHUP
(\ES.DELETE1PENDING THISPENDINGSERVICE FINISHOW?)
RELEASE&EXIT
(AND \RequestPUP (RECLAIM.PUP \RequestPUP))
(AND OPUP (RECLAIM.OUTPUT.PUP OPUP))
(PROCESS.RETURN NIL)
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 "27-Nov-84 14:02")
(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)
(EQ 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 (AND (PROBABLYSOCKETP \EVALREQUEST.SOCKET)
(FMEMB \EVALREQUEST.SOCKET \PUPSOCKETS))
(SETQ \EVALREQUEST.SOCKET (OPENPUPSOCKET \SOCKET#.EVALREQUEST T)))
(while (EQ (QUOTE NEW)
(\GETFILTEREDPUP \EVALREQUEST.SOCKET (CONSTANT (LIST \PT.EVALREQUEST))
ID
(QUOTE NEW)))
do (* Be sure nothing is left in the BCPL buffers.)
(BLOCK))
(SETQ P (MAPCONC (CAR \PUPINQUEUE)
(FUNCTION (LAMBDA (X)
(SETQ P (CAR X))
(AND (EQ (CONSTANT (\LONUM \SOCKET#.EVALREQUEST))
(fetch PUPDESTSOCKETLO of P))
(EQ (CONSTANT (\HINUM \SOCKET#.EVALREQUEST))
(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 "20-JUL-83 16:47")
(UNINTERRUPTABLY
(\ES.CLOSEOUTSOCKET (fetch (TRANSACTIONNOTE SOCKET) of (CDR THISPENDINGSERVICE)))
(replace (TRANSACTIONNOTE SOCKET) of (CDR THISPENDINGSERVICE) with NIL)
(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 "18-JUL-83 19:39")
(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 ((\List (CAR \PUPINQUEUE))
(\EndOfQ (CDR \PUPINQUEUE))
\BackL)
(DECLARE (LOCALVARS \Count \List \EndOfQ \BackL))
\REMTCONCloop
(if (NLISTP \List)
then (RETURN)
elseif (NOT (find X (S#LO ←(fetch PUPDESTSOCKETLO
of (CAR (CAR \List))))
(S#HI ←(fetch PUPDESTSOCKETHI
of (CAR (CAR \List))))
in \PUPSOCKETS
suchthat (AND (EQ S#LO
(fetch PSOCKLO
of X))
(EQ S#HI
(fetch PSOCKHI
of X)))))
then (* Hmmmm somebody on \PUPINQUEUE addressed to a dead
socket)
(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
(GLOBALVARS \ES.BroadSweepQ \ES.BroadAppEVENT \ES.BroadAppSweeper)
)
(DEFINEQ
(\ES.BroadAppSweeper
(LAMBDA NIL (* JonL "22-Nov-84 18:28")
(* This is a "broom" process for broadcast applications, which "sweeps out" any old requests which either didn't get
certified, or which thought they were certified, but the remote process is acting strangely.
Actually, other non-broadcast uses are in place now.)
(until (NULL (CAR \ES.BroadSweepQ)) bind NOTE
do (for SWEEPENTRY OPUP in (for SWEEPENTRY FINALCALL? in (CAR \ES.BroadSweepQ)
eachtime (SETQ FINALCALL? (OR (TIMEREXPIRED?
(fetch FINALTIME
of (SETQ NOTE (CDR SWEEPENTRY)
)))
(RELPROCESSP (fetch UPROC
of NOTE))))
(APPLY* (CAR SWEEPENTRY)
SWEEPENTRY FINALCALL?)
(BLOCK)
when FINALCALL? collect SWEEPENTRY)
do
(* Having made one pass down the queue, running the various item, we have collected all the ones that have
"timed out" and need to be deleted)
(UNINTERRUPTABLY
(SETQ NOTE (CDR SWEEPENTRY))
(SETQ OPUP (PROG1 (fetch OPUP of NOTE) (* Just to make sure that no one else gets to look at
this PUP after it's released.)
(replace OPUP of NOTE with NIL)))
(if (type? PUP OPUP)
then (RECLAIM.OUTPUT.PUP OPUP))
(\UNTCONC \ES.BroadSweepQ SWEEPENTRY)))
(AWAIT.EVENT \ES.BroadAppEVENT \ETHERTIMEOUT))
(SETQ \ES.BroadSweepQ) (* Its been at least \ETHERTIMEOUT ms since we were
needed, so we may as well pack it in.)
(PROCESS.RETURN)))
(\ES.AddSweeping
(LAMBDA (FUN SERVERHOST TRANSCEIVER REFID TIMEOUT.ms EXITCOUNT)
(* JonL "20-JUL-83 13:24")
(OR (LISTP \ES.BroadSweepQ)
(PROGN (OR (FIND.PROCESS (QUOTE \ES.BroadAppSweeper))
(SETQ \ES.BroadAppSweeper (ADD.PROCESS (QUOTE (\ES.BroadAppSweeper))
(QUOTE RESTARTABLE)
T)))
(SETQ \ES.BroadSweepQ (LIST NIL))))
(TCONC \ES.BroadSweepQ (CONS FUN
(create BROADAPNOTE
SERVERHOST ← SERVERHOST
TRANSCEIVER ← TRANSCEIVER
REFID ← REFID
FINALTIME ←(SETUPTIMER (OR TIMEOUT.ms
(CONSTANT (ITIMES \MAXETHERTRIES
\ETHERTIMEOUT))))
UPROC ←(THIS.PROCESS)
EXITCOUNT ← EXITCOUNT)))
(NOTIFY.EVENT \ES.BroadAppEVENT T)))
(\ES.Re-acknowledge.service
(LAMBDA (SWEEPENTRY FINALCALL?) (* JonL "18-JUL-83 17:54")
(\ES.WatchSocket SWEEPENTRY FINALCALL? NIL)))
(\ES.IgnoreApplicants
(LAMBDA (SWEEPENTRY FINALCALL?) (* JonL "18-JUL-83 18:35")
(\ES.WatchSocket SWEEPENTRY FINALCALL? (QUOTE IGNORE))))
(\ES.RejectApplicants
(LAMBDA (SWEEPENTRY FINALCALL?) (* JonL "18-JUL-83 17:55")
(\ES.WatchSocket SWEEPENTRY FINALCALL? T)))
(\ES.WatchSocket
(LAMBDA (SWEEPENTRY FINALCALL? BROADRejectAP?) (* JonL "22-Nov-84 18:21")
((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 (if BROADRejectAP?
then (CONSTANT (LIST
\PT.ACKNOWLEDGE))
else (CONSTANT (LIST
\PT.EVALRESPONSE
\PT.EVALERROR)))
MY.REF.ID))
(NEQ BROADRejectAP? (QUOTE IGNORE))
(OR (NULL BROADRejectAP?)
(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)))
(* Reclaim this guy now so that he will be available to
\ALLOCATE.BIGPUP)
(RECLAIM.PUP (PROG1 IPUP (SETQ IPUP)))
(SETUPPUP (SETQ OPUP (\ALLOCATE.BIGPUP))
ADDRESS SKT# (if (NULL BROADRejectAP?)
then \PT.ACKNOWLEDGE
else \PT.EVALREQUEST.CERTIFY)
MY.REF.ID MY.TRANSCEIVER)
(if BROADRejectAP?
then (1BYTETOPUP 0 OPUP))
(replace OPUP of NOTE with OPUP)))
(\SENDUNFILTEREDPUP MY.TRANSCEIVER OPUP (if (NULL BROADRejectAP?)
then (QUOTE (
"Late acknowledgement for services rendered" REMOTEVAL))
else (QUOTE (
"=== Losing broadcast applicant is rejected." REMOTEVAL))))
(if FINALCALL?
then (* Just to be sure)
(BLOCK)
(GO A)))
(if IPUP
then (RELEASE.PUP IPUP))
(if FINALCALL?
then (* Don't reclaim the OPUP here, since the FINALCALL?
clause of \ES.BroadAppSweeper will do so)
(\ES.EXITREMOTEVAL MY.TRANSCEIVER (fetch EXITCOUNT of NOTE)))))
(CDR SWEEPENTRY))))
(\ES.ApplicantValid?
(LAMBDA (SWEEPENTRY FINALCALL?) (* JonL " 3-Aug-84 17:46")
((LAMBDA (NOTE)
(PROG ((TRANSCEIVER (fetch TRANSCEIVER of NOTE))
(CLIENT'S.REF.ID (fetch REFID of NOTE))
CERTIFICATION.TIMER)
(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)))
(\SENDUNFILTEREDPUP TRANSCEIVER (if (type? PUP OPUP)
then OPUP
else (replace OPUP of NOTE
with (\ALLOCATE.BIGPUP)))
(QUOTE (
"=== EvalServer acknowledges certification re broadcast:" \ES.DO1THING)))
(replace EXITCOUNT of NOTE
with (SETUPTIMER (CONSTANT (ITIMES 2 \ETHERTIMEOUT))
(if (\TIMER.TIMERP (SETQ CERTIFICATION.TIMER
(fetch EXITCOUNT of NOTE)))
then CERTIFICATION.TIMER)))))
(if FINALCALL?
then
(* Abort service if he keeps sending requests for certification. i.e., if we got a request for certification in
the most recent half-life before exiting here)
(AND (SETQ CERTIFICATION.TIMER (fetch EXITCOUNT of NOTE))
(NOT (TIMEREXPIRED? CERTIFICATION.TIMER))
(DEL.PROCESS (fetch UPROC of NOTE))))))
(CDR SWEEPENTRY))))
)
(DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY
(MAPC (QUOTE (LOGOUTFORMS SYSOUTFORMS MAKESYSFORMS))
(FUNCTION (LAMBDA (X)
(MAPC (QUOTE ((BEFORE (\ES.UNCACHE))
(AFTER (\ES.RESTART))))
(FUNCTION (LAMBDA (Y)
(APPLY (QUOTE ADDTOVAR)
(CONS (PACK* (CAR Y)
X)
(CDR Y)))))))))
)
(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 "26-SEP-83 21:16")
(if (NULL FLG)
then (SETQ \ES.TRACE? NIL)
(AND (DISPLAYSTREAMP \ES.MESSAGESTREAM)
(CLOSEW (WFROMDS \ES.MESSAGESTREAM)))
NIL
else (if (OR REGION (AND (NOT (WINDOWP \ES.MESSAGESTREAM))
(NOT (DISPLAYSTREAMP \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)
(TOTOPW \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
(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 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4770 8272 (PRIN4.INTO.STRING 4780 . 6729) (\P4S.FOOT 6731 . 7142) (\P4S.PERCHAR 7144 .
7699) (\UNTCONC 7701 . 8270)) (11801 22078 (READ.FROM.PUP 11811 . 13361) (PRINT.INTO.PUP 13363 . 16497
) (\HNM.MEMBER 16499 . 17180) (\NORMALIZEHOSTNUM 17182 . 17613) (\BROADCASTADDRESS.ON.MYNET 17615 .
17856) (\GETFILTEREDPUP 17858 . 20844) (\SENDUNFILTEREDPUP 20846 . 21082) (\ES.GETSOCKET 21084 . 21607
) (\ES.RECLAIM.PUP 21609 . 21879) (\ES.RELEASE.OUTPUT.PUP 21881 . 22076)) (24624 60635 (REMOTEVAL
24634 . 31572) (\ES.EXITREMOTEVAL 31574 . 32495) (\ES.CLOSEOUTSOCKET 32497 . 32780) (\ES.UNCACHE 32782
. 33074) (REMOTEABORT 33076 . 34524) (REMOTEAPPLY 34526 . 34739) (\ES.APPLYQQ 34741 . 34883) (
EVALSERVER 34885 . 35788) (\ES.RESTART 35790 . 36034) (\ES.LISTENER 36036 . 41346) (\ES.DO1THING 41348
. 48988) (\ES.ABORTQQ 48990 . 49146) (EVALSERVER.ABORT 49148 . 51028) (EVALSERVER.STATUS 51030 .
54235) (\ES.MakeClientHostInfo 54237 . 54655) (\ES.DELETE1PENDING 54657 . 55450) (\ES.ABORTPENDING
55452 . 55922) (\ES.PURGEOLDTHINGS 55924 . 60633)) (61120 68278 (\ES.BroadAppSweeper 61130 . 62978) (
\ES.AddSweeping 62980 . 63780) (\ES.Re-acknowledge.service 63782 . 63959) (\ES.IgnoreApplicants 63961
. 64143) (\ES.RejectApplicants 64145 . 64314) (\ES.WatchSocket 64316 . 66659) (\ES.ApplicantValid?
66661 . 68276)) (68986 70798 (EVALSERVER.TRACE 68996 . 69911) (\ES.BUGGERTRACEWINDOW 69913 . 70362) (
\ES.PRINTRACE 70364 . 70796)) (70799 79716 (EVALSERVER.STATUS.WINDOW 70809 . 76421) (
\ES.STATUSW.GETITEMS 76423 . 76856) (\ES.STATUSW.SELECTEDFN 76858 . 78107) (\ES.STATUSW.HELDFN 78109
. 78582) (\ES.INVALIDATE.STATUSW 78584 . 79220) (\ES.UPDATE.STATUSW 79222 . 79714)))))
STOP