(FILECREATED "26-SEP-83 21:21:21" {PHYLUM}<LISPUSERS>EVALSERVER.;103 81288
changes to: (VARS EVALSERVERCOMS)
(FNS ORDINALSUFFIXSTRING.ES EVALSERVER.TRACE \ES.LISTENER \ES.DO1THING)
previous date: "13-SEP-83 09:22:52" {PHYLUM}<LISPUSERS>EVALSERVER.;102)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT EVALSERVERCOMS)
(RPAQQ EVALSERVERCOMS ((LOCALVARS . T)
(COMS (* This ought to be in the system!)
(FNS ORDINALSUFFIXSTRING.ES)
(P (MOVD? (QUOTE ORDINALSUFFIXSTRING.ES)
(QUOTE ORDINALSUFFIXSTRING))
(PUTD (QUOTE ORDINALSUFFIXSTRING.ES))))
(COMS (* Generally useful utilities)
(FNS PRIN4.INTO.STRING \P4S.FOOT \P4S.PERCHAR \UNTCONC)
(DECLARE: DONTCOPY (MACROS \FILLINSTRPTR \UNTCONC))
(GLOBALRESOURCES \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER))
(COMS (* Pup/Net assistance)
(DECLARE: DONTCOPY (MACROS \ALLOCATE.BIGPUP HOSTNUMBERP PROBABLYSOCKETP
HOST#.FROM.ADDRESS NTWK#.FROM.ADDRESS
\BROADCASTADDRESS.ON.MYNET \ES.LOCALHOSTNUMBER)
(RECORDS BVM.LOSES.PUPSOCKET))
(MACROS #PUPDATABYTES #PUPDATABYTES.LEFT)
(GLOBALRESOURCES \PIP.SCRATCHSPTR \GFP.TIMER \READPUPSTREAM \WRITEPUPSTREAM)
(FNS READ.FROM.PUP PRINT.INTO.PUP \ES.LOCALHOSTNUMBER \HNM.MEMBER \NORMALIZEHOSTNUM
\BROADCASTADDRESS.ON.MYNET \GETFILTEREDPUP \SENDUNFILTEREDPUP \ES.GETSOCKET)
(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.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.TTYWINDOWSTREAM \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS
\ES.COMPLETEDSERVICES \ES.PENDINGSERVICES \ES.LOSTSOCKETSLST)
(SPECVARS \ES.CurrentlyPendingService FluidVariableForInterlospLissage)
(FNS REMOTEVAL \ES.EXITREMOTEVAL \ES.CLOSEOUTSOCKET 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.AddSweeping \ES.Re-acknowledge.service
\ES.IgnoreApplicants \ES.RejectApplicants \ES.WatchSocket \ES.ApplicantValid?))
(ADDVARS (AFTERSYSOUTFORMS (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)
)
(* This ought to be in the system!)
(DEFINEQ
(ORDINALSUFFIXSTRING.ES
(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"))))
)
(MOVD? (QUOTE ORDINALSUFFIXSTRING.ES)
(QUOTE ORDINALSUFFIXSTRING))
(PUTD (QUOTE ORDINALSUFFIXSTRING.ES))
(* 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: 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 \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))))
)
)
(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)))
)
(* 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)))
(PUTPROPS \BROADCASTADDRESS.ON.MYNET MACRO (X
(COND
(X (QUOTE IGNOREMACRO))
(T (QUOTE (OR \BROADCASTADDRESS.ON.MYNET (\BROADCASTADDRESS.ON.MYNET T)))))))
(PUTPROPS \ES.LOCALHOSTNUMBER MACRO (X
(COND
(X (QUOTE IGNOREMACRO))
(T (QUOTE (OR \ES.LOCALHOSTNUMBER (\ES.LOCALHOSTNUMBER T)))))))
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD BVM.LOSES.PUPSOCKET ((NIL BYTE)
(NIL POINTER)
(PSOCKHI WORD)
(PSOCKLO WORD)))
]
)
(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 "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 "18-JUL-83 18:06")
(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 (NLSETQ (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)))))
(\ES.LOCALHOSTNUMBER
(LAMBDA NIL (* JonL "18-JUL-83 20:18")
(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 "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 "18-JUL-83 19:35")
(* 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 (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))
(\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)))))))
)
(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.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
(ADDTOVAR GLOBALVARS \PUPINQUEUE \PUPINQUEUE.MAXLENGTH \PUPINQUEUE.MAXAGE \EVALREQUEST.SOCKET
\ES.TTYWINDOWSTREAM \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? 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 "20-JUL-83 16:39")
(* When EXIT.REFCOUNT? goes down to zero
(or is NULL) then we can reclaim the socket in
MY.TRANSCEIVER)
(if (OR (NULL EXIT.REFCOUNT?)
(IEQP 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 (RELEASE.PUP pup1))
(AND pup2 (RELEASE.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))))
(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 "20-JUL-83 12:42")
(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.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)
(RETURN (LIST (SETQ EVALSERVER (ADD.PROCESS (CONS (QUOTE \ES.LISTENER)
ARGSL)
(QUOTE NAME)
(QUOTE EvalServerListening)
(QUOTE RESTARTABLE)
T))))
else (APPLY (QUOTE \ES.LISTENER)
ARGSL)))))
(\ES.LISTENER
(NLAMBDA (CLIENTSLST GAGS DURATION PROCP) (* JonL "26-SEP-83 21:20")
(* 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 (DISPLAYSTREAMP \ES.TTYWINDOWSTREAM)
(SETQ \ES.TTYWINDOWSTREAM
(WINDOWPROP (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)
(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))))
(QUOTE RESTARTABLE)
(QUOTE NO))
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)
(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 (FluidVariableForInterlospLissage) (* JonL "26-SEP-83 21:20")
(TTYDISPLAYSTREAM \ES.TTYWINDOWSTREAM)
(PROG ((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.RESPONSE.SOCKET (\ES.GETSOCKET))
TRANSACTION.ID \ES.CurrentlyPendingService VAL PT PROCLEANUP 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 \ES.CurrentlyPendingService (CONS TRANSACTION.ID
(create TRANSACTIONNOTE
STATE ←(OR PROCP (QUOTE RUNNING))
TIME ←(CLOCK 0)
SOCKET ← ES.RESPONSE.SOCKET)))
(push \ES.PENDINGSERVICES \ES.CurrentlyPendingService)
(OR (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 (\ES.CLOSEOUTSOCKET 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)))
(\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?)
(GO ABORT))))
(SETQ VAL (NLSETQ (EVAL (READ.FROM.PUP FluidVariableForInterlospLissage))))
(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
(\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 "20-JUL-83 13:34")
(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 (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 (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 "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
(ADDTOVAR GLOBALVARS \ES.BroadSweepQ \ES.BroadAppEVENT \ES.BroadAppSweeper)
)
(DEFINEQ
(\ES.BroadAppSweeper
(LAMBDA NIL (* JonL "20-JUL-83 13:48")
(PROG (NOTE FINALCALL?)
LOOP(AWAIT.EVENT \ES.BroadAppEVENT \ETHERTIMEOUT)
(if (NULL (CAR \ES.BroadSweepQ))
then (* Its been at least \ETHERTIMEOUT ms since we were
needed, so we may as well pack it in.)
(SETQ \ES.BroadSweepQ)
(KILL.ME))
(for SWEEPENTRY FINALS 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))
(push FINALS SWEEPENTRY))
finally (for ENTRY in FINALS do (\UNTCONC \ES.BroadSweepQ ENTRY)))
(GO LOOP))))
(\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 "20-JUL-83 14:31")
((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)))
(RELEASE.PUP IPUP)
(SETQ IPUP)
(SETQ OPUP (\ALLOCATE.BIGPUP))
(SETUPPUP OPUP 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 (\ES.EXITREMOTEVAL MY.TRANSCEIVER (fetch EXITCOUNT of NOTE)
OPUP))))
(CDR SWEEPENTRY))))
(\ES.ApplicantValid?
(LAMBDA (SWEEPENTRY FINALCALL?) (* JonL "18-JUL-83 19:05")
((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 (CONSTANT (ITIMES 2
\ETHERTIMEOUT))
(OR (fetch EXITCOUNT
of NOTE)
(NCREATE (QUOTE FIXP)))))
))
(if FINALCALL?
then ((LAMBDA (TIMER)
(* 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 TIMER (NOT (TIMEREXPIRED? TIMER))
(DEL.PROCESS (fetch UPROC of NOTE))))
(fetch EXITCOUNT of NOTE)))))
(CDR SWEEPENTRY))))
)
(ADDTOVAR AFTERSYSOUTFORMS (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 "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
(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 )
)
(PRETTYCOMPRINT EVALSERVERCOMS)
(RPAQQ EVALSERVERCOMS ((LOCALVARS . T)
(COMS (* This ought to be in the system!)
(FNS ORDINALSUFFIXSTRING.ES)
(P (MOVD? (QUOTE ORDINALSUFFIXSTRING.ES)
(QUOTE ORDINALSUFFIXSTRING))
(PUTD (QUOTE ORDINALSUFFIXSTRING.ES))))
(COMS (* Generally useful utilities)
(FNS PRIN4.INTO.STRING \P4S.FOOT \P4S.PERCHAR \UNTCONC)
(DECLARE: DONTCOPY (MACROS \FILLINSTRPTR \UNTCONC))
(GLOBALRESOURCES \P4S.SCRATCHLIST \P4S.STR.BYTEPOINTER))
(COMS (* Pup/Net assistance)
(DECLARE: DONTCOPY (MACROS \ALLOCATE.BIGPUP HOSTNUMBERP PROBABLYSOCKETP
HOST#.FROM.ADDRESS NTWK#.FROM.ADDRESS
\BROADCASTADDRESS.ON.MYNET \ES.LOCALHOSTNUMBER)
(RECORDS BVM.LOSES.PUPSOCKET))
(MACROS #PUPDATABYTES #PUPDATABYTES.LEFT)
(GLOBALRESOURCES \PIP.SCRATCHSPTR \GFP.TIMER \READPUPSTREAM \WRITEPUPSTREAM)
(FNS READ.FROM.PUP PRINT.INTO.PUP \ES.LOCALHOSTNUMBER \HNM.MEMBER \NORMALIZEHOSTNUM
\BROADCASTADDRESS.ON.MYNET \GETFILTEREDPUP \SENDUNFILTEREDPUP \ES.GETSOCKET)
(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.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.TTYWINDOWSTREAM \ES.MESSAGESTREAM \ES.PURGEINTERVAL.SECS
\ES.COMPLETEDSERVICES \ES.PENDINGSERVICES \ES.LOSTSOCKETSLST)
(SPECVARS \ES.CurrentlyPendingService FluidVariableForInterlospLissage)
(FNS REMOTEVAL \ES.EXITREMOTEVAL \ES.CLOSEOUTSOCKET 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.AddSweeping \ES.Re-acknowledge.service
\ES.IgnoreApplicants \ES.RejectApplicants \ES.WatchSocket \ES.ApplicantValid?))
(ADDVARS (AFTERSYSOUTFORMS (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.DO1THING
\ES.LISTENER
\ES.ABORTPENDING)
(LAMA)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA \ES.ABORTQQ \ES.APPLYQQ)
(ADDTOVAR NLAML \ES.DO1THING \ES.LISTENER \ES.ABORTPENDING)
(ADDTOVAR LAMA )
)
(PUTPROPS EVALSERVER COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4512 4838 (ORDINALSUFFIXSTRING.ES 4522 . 4836)) (4990 8492 (PRIN4.INTO.STRING 5000 .
6949) (\P4S.FOOT 6951 . 7362) (\P4S.PERCHAR 7364 . 7919) (\UNTCONC 7921 . 8490)) (11693 21357 (
READ.FROM.PUP 11703 . 13253) (PRINT.INTO.PUP 13255 . 16267) (\ES.LOCALHOSTNUMBER 16269 . 16515) (
\HNM.MEMBER 16517 . 17160) (\NORMALIZEHOSTNUM 17162 . 17593) (\BROADCASTADDRESS.ON.MYNET 17595 . 17836
) (\GETFILTEREDPUP 17838 . 20592) (\SENDUNFILTEREDPUP 20594 . 20830) (\ES.GETSOCKET 20832 . 21355)) (
23817 58815 (REMOTEVAL 23827 . 30765) (\ES.EXITREMOTEVAL 30767 . 31624) (\ES.CLOSEOUTSOCKET 31626 .
31909) (REMOTEABORT 31911 . 33359) (REMOTEAPPLY 33361 . 33574) (\ES.APPLYQQ 33576 . 33718) (EVALSERVER
33720 . 34800) (\ES.LISTENER 34802 . 40180) (\ES.DO1THING 40182 . 47508) (\ES.ABORTQQ 47510 . 47666)
(EVALSERVER.ABORT 47668 . 49548) (EVALSERVER.STATUS 49550 . 52415) (\ES.MakeClientHostInfo 52417 .
52835) (\ES.DELETE1PENDING 52837 . 53630) (\ES.ABORTPENDING 53632 . 54102) (\ES.PURGEOLDTHINGS 54104
. 58813)) (59303 65180 (\ES.BroadAppSweeper 59313 . 60467) (\ES.AddSweeping 60469 . 61269) (
\ES.Re-acknowledge.service 61271 . 61448) (\ES.IgnoreApplicants 61450 . 61632) (\ES.RejectApplicants
61634 . 61803) (\ES.WatchSocket 61805 . 63740) (\ES.ApplicantValid? 63742 . 65178)) (65685 67497 (
EVALSERVER.TRACE 65695 . 66610) (\ES.BUGGERTRACEWINDOW 66612 . 67061) (\ES.PRINTRACE 67063 . 67495)) (
67498 76415 (EVALSERVER.STATUS.WINDOW 67508 . 73120) (\ES.STATUSW.GETITEMS 73122 . 73555) (
\ES.STATUSW.SELECTEDFN 73557 . 74806) (\ES.STATUSW.HELDFN 74808 . 75281) (\ES.INVALIDATE.STATUSW 75283
. 75919) (\ES.UPDATE.STATUSW 75921 . 76413)))))
STOP