XlImplTQ.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, April 19, 1988 9:11:59 am PDT
Christian Jacobi, August 13, 1993 12:18 pm PDT
DIRECTORY
Basics, ForkOps, ForkOpsFriends, Process, UnsafePropList, Xl, XlTQPrivate;
XlImplTQ: CEDAR MONITOR LOCKS tq USING tq: TQ
--the tq lock might be called inside the connection lock
IMPORTS Basics, ForkOps, ForkOpsFriends, Process
EXPORTS Xl, XlTQPrivate =
BEGIN OPEN Xl, XlTQPrivate;
<<Xl.>>TQRep: PUBLIC TYPE = XlTQPrivate.TQRec;
<<Xl.>>TQ: TYPE = REF XlTQPrivate.TQRec;
Wedged: PUBLIC ERROR = CODE;
EvBool: TYPE = PACKED ARRAY [0..127] OF BOOL ¬ ALL[FALSE];
vanilla1: REF EvBool ¬ NEW[EvBool];
vanilla2: REF EvBool ¬ NEW[EvBool];
vanilla3: REF EvBool ¬ NEW[EvBool];
desperate1: REF EvBool ¬ NEW[EvBool];
desperate2: REF EvBool ¬ NEW[EvBool ¬ ALL[TRUE]];
ForgetQueuedElements: INTERNAL PROC [tq: TQ] = {
--prevents using up all storage for a blocked thread
Pass: INTERNAL PROC [vanilla: REF EvBool] = {
lag: Job ¬ NIL;
p: Job ¬ tq.next;
IF p=NIL THEN RETURN;
WHILE p#tq.tail DO
IF p.event#NIL AND vanilla[Basics.BITAND[p.event.originalCodeByte, 127]]
THEN {
--remove
removed ¬ removed + 1;
tq.eventCount ¬ tq.eventCount - 1;
IF lag=NIL
THEN tq.next ¬ p.next
ELSE lag.next ¬ p.next;
IF removed>10 THEN RETURN;
}
ELSE {
--keep
lag ¬ p;
};
p ¬ p.next
ENDLOOP;
};
removed: CARD ¬ 0;
--first try to get rid of vanilla stuff
Pass[vanilla1]; IF removed>10 THEN RETURN;
Pass[vanilla2]; IF removed>10 THEN RETURN;
Pass[vanilla3]; IF removed>10 THEN RETURN;
Pass[desperate1]; IF removed>10 THEN RETURN;
Pass[desperate2];
};
RemoveErrorEvents: PUBLIC ENTRY PROC [tq: TQ] = {
ENABLE UNWIND => NULL;
--removes all leading error events
WHILE tq.next#NIL DO
WITH tq.next.event SELECT FROM
error: ErrorNotifyEvent => {
tq.eventCount ¬ tq.eventCount-1;
tq.next ¬ tq.next.next;
IF tq.next=NIL THEN tq.tail ¬ NIL
};
ENDCASE => RETURN;
ENDLOOP;
};
globalLockTq: TQ ¬ NEW[TQRep]; --need the lock
sHigh, sLow: INT ¬ 0;
CreateTQ: PUBLIC PROC [createData: REF ¬ NIL, order: INT ¬ 0, reverse: BOOL ¬ FALSE] RETURNS [tq: TQ] = {
Protected: ENTRY PROC [tq: TQ--lock!--, realTq: TQ] = INLINE {
IF sLow=LAST[INT]
THEN {sLow ¬ 0; sHigh ¬ sHigh+1}--sHigh doesn't overflow for 100 years
ELSE {sLow ¬ sLow+1};
realTq.seq1 ¬ sHigh; realTq.seq2 ¬ sLow;
};
tq ¬ NEW[TQRep ¬ [createData: createData, order: order]];
TRUSTED {Process.InitializeCondition[@tq.newEvent, Process.MsecToTicks[100]]};
Protected[globalLockTq, tq];
IF reverse THEN {
tq.seq1 ¬ - tq.seq1;
tq.seq2 ¬ - tq.seq2;
}
};
InternalNewJob: INTERNAL PROC [tq: TQ] RETURNS [job: Job] = INLINE {
job ¬ tq.free;
IF job#NIL
THEN {tq.free ¬ job.next; job.next ¬ NIL; tq.freeCnt ¬ tq.freeCnt-1}
ELSE job ¬ NEW[JobRec];
};
InternalFreeJob: INTERNAL PROC [tq: TQ, job: Job] = INLINE {
job.data ¬ NIL; --garbage collect now and not only when reused
IF tq.freeCnt<25 THEN {
job.next ¬ tq.free;
tq.free ¬ job;
tq.freeCnt ¬ tq.freeCnt + 1
};
};
EntryEnqueue: ENTRY PROC [tq: TQ, proc: EventProcType, data: REF, event: Event] RETURNS [mustFork: BOOL ¬ FALSE] = INLINE {
job: Job ~ InternalNewJob[tq];
IF tq.dead THEN RETURN;
job.data ¬ data;
job.proc ¬ proc;
job.event ¬ event;
IF tq.next=NIL
THEN {
tq.eventCount ¬ 1;
tq.next ¬ tq.tail ¬ job;
IF ~tq.selfRunning THEN {
tq.selfRunning ¬ TRUE;
mustFork ¬ TRUE;
}
}
ELSE {
tq.eventCount ¬ tq.eventCount + 1;
tq.tail.next ¬ job;
tq.tail ¬ job;
IF tq.eventCount>tq.upperLimit THEN ForgetQueuedElements[tq];
};
};
Enqueue: PUBLIC PROC [tq: TQ, proc: EventProcType, data: REF, event: Event] = {
p: EventProcType ~ proc; --checks against local procedures
IF EntryEnqueue[tq, p, data, event].mustFork THEN
ForkOps.Fork[DispatcherProcess, tq, tq.priority];
};
SignalFor2Phase: ENTRY PROC [tq: TQ] = INLINE {
IF tq.lockWaiterCount>0 AND tq.lockProcess=NIL THEN
BROADCAST tq.lockWaiterCond
};
DispatcherProcess: PROC [t: REF] = {
tq: TQ ~ NARROW[t];
--old optimization
-- outer loop allows inner loop without catch phrase for ENABLE ABORTED
-- if it doesn't crash the outer loop is executed just once
--new optimization
-- Use ForkOpsFriends to be told about aborts without any enabling...
EntryNext: ENTRY PROC [tq: TQ, oldJob: Job] RETURNS [job: Job] = INLINE {
IF oldJob#NIL THEN InternalFreeJob[tq, oldJob];
job ¬ tq.next;
IF job=NIL THEN {
tq.selfRunning ¬ FALSE;
tq.tail ¬ NIL;
tq.selfProcess ¬ NIL;
IF tq.lockWaiterCount>0 AND tq.lockProcess=NIL THEN BROADCAST tq.lockWaiterCond;
RETURN
};
tq.eventCount ¬ tq.eventCount-1;
tq.next ¬ job.next;
--check 2 phase locking
WHILE tq.lockProcess#NIL DO
tq.lockWaiterCount ¬ tq.lockWaiterCount+1;
WAIT tq.lockWaiterCond;
tq.lockWaiterCount ¬ tq.lockWaiterCount-1;
ENDLOOP;
tq.this ¬ job;
};
job: Job;
tq.selfProcess ¬ CurrentProcess[];
--DO
ENABLE ABORTED => {
--protect from abort in the clients proc (it won't crash anywhere else)
tq.this ¬ NIL;
SignalFor2Phase[tq];
Process.Yield[];
};
DO
IF tq.lockWaiterCount>0 AND tq.lockProcess=NIL THEN {
SignalFor2Phase[tq];
Process.Yield[];
};
job ¬ EntryNext[tq, job];
IF job=NIL THEN RETURN;
job.proc[tq: tq, event: job.event, clientData: job.data <<! ABORTED...>>];
tq.this ¬ NIL;
ENDLOOP;
--ENDLOOP;
};
AbortNotification: PROC [t: REF] = {
tq: TQ ~ NARROW[t];
tq.this ¬ NIL;
SignalFor2Phase[tq];
Process.Yield[];
};
IsTQ: PUBLIC PROC [x: REF ANY] RETURNS [b: BOOL] = {
b ¬ x#NIL AND ISTYPE[x, TQ]
};
NarrowTQ: PUBLIC PROC [x: REF ANY] RETURNS [t: TQ] = {
t ¬ NARROW[x, TQ]
};
CurrentProcess: PROC RETURNS [PROCESS] = TRUSTED INLINE {
RETURN [LOOPHOLE[Process.GetCurrent[]]];
};
OwnsLock: PUBLIC PROC [tq: TQ] RETURNS [BOOL] = {
self: PROCESS = CurrentProcess[];
RETURN [ self=tq.selfProcess OR self=tq.lockProcess ]
};
GetLockOrderNum: PUBLIC PROC [tq: TQ] RETURNS [INT] = {
RETURN [ tq.order ]
};
GetLockOrder: PUBLIC PROC [first, second: TQ] RETURNS [l: LockOrder] = {
l ¬ SELECT TRUE FROM
first.dead OR second.dead => dead,
first.order<second.order => ok,
first.order>second.order => reversed,
first.seq1<second.seq1 => ok,
first.seq1>second.seq1 => reversed,
first.seq2<second.seq2 => ok,
first.seq2>second.seq2 => reversed,
first=second => ok,
ENDCASE => ERROR;
};
CallWithLocks: PUBLIC PROC [proc: PROC, tq1, tq2: TQ] = {
self: PROCESS = CurrentProcess[];
IF tq1=NIL OR self=tq1.selfProcess OR self=tq1.lockProcess THEN {
CallWithLock[tq2, proc]; RETURN
};
IF tq2=NIL OR self=tq2.selfProcess OR self=tq2.lockProcess OR tq1=tq2 THEN {
CallWithLock[tq1, proc]; RETURN
};
SELECT GetLockOrder[tq1, tq2] FROM
ok => {};
reversed => {t: TQ ¬ tq1; tq1 ¬ tq2; tq2 ¬ t};
ENDCASE => ERROR Wedged;
DO
IF TryAquireLock[tq1, self]
THEN {
IF TryAquireLock[tq2, self]
THEN {
proc[! UNWIND => {
ReleaseLock[tq2];
ReleaseLock[tq1];
}];
ReleaseLock[tq2];
ReleaseLock[tq1];
RETURN
}
ELSE {
ReleaseLock[tq1];
WaitForFreeOnce[tq2, self]
}
}
ELSE {
WaitForFreeOnce[tq1, self]
};
ENDLOOP;
};
WaitForFreeOnce: ENTRY PROC [tq: TQ, self: PROCESS] = {
--But no gurantee that it is free afterwards
IF tq.this#NIL OR (tq.lockProcess#NIL AND tq.lockProcess#self) THEN {
tq.lockWaiterCount ¬ tq.lockWaiterCount +1;
WAIT tq.lockWaiterCond;
tq.lockWaiterCount ¬ tq.lockWaiterCount -1;
};
};
TryAquireLock: ENTRY PROC [tq: TQ, self: PROCESS] RETURNS [BOOL ¬ FALSE] = {
--Returns TRUE on success
IF tq.this#NIL THEN RETURN [FALSE];
IF tq.lockProcess=NIL THEN {tq.lockCount ¬ 1; tq.lockProcess ¬ self; RETURN [TRUE]};
IF tq.lockProcess=self THEN {tq.lockCount ¬ tq.lockCount+1; RETURN [TRUE]};
};
ReleaseLock: ENTRY PROC [tq: TQ] = {
tq.lockCount ¬ tq.lockCount-1;
IF tq.lockCount=0 THEN {
tq.lockProcess ¬ NIL;
IF tq.lockWaiterCount>0 THEN BROADCAST tq.lockWaiterCond
};
};
CallWithLock: PUBLIC PROC [tq: TQ, proc: PROC] = {
self: PROCESS = CurrentProcess[];
IF tq=NIL OR self=tq.selfProcess OR self=tq.lockProcess THEN {proc[]; RETURN};
IF tq.dead THEN ERROR Wedged;
DO
IF TryAquireLock[tq, self] THEN {
proc[! UNWIND => ReleaseLock[tq]];
ReleaseLock[tq];
RETURN;
};
WaitForFreeOnce[tq, self]
ENDLOOP;
};
SetTQPriority: PUBLIC PROC [tq: TQ, priority: Process.Priority] = {
tq.priority ¬ priority;
};
SetTQReadiness: PUBLIC PROC [tq: TQ, ms: INT] = TRUSTED {
Process.SetTimeout[@tq.newEvent, Process.MsecToTicks[ms]]
};
vanilla1[ORD[EventCode[motionNotify]]] ¬ TRUE;
--
vanilla2[ORD[EventCode[motionNotify]]] ¬ TRUE;
vanilla2[ORD[EventCode[graphicsExposure]]] ¬ TRUE;
vanilla2[ORD[EventCode[noExposure]]] ¬ TRUE;
vanilla2[ORD[EventCode[visibilityNotify]]] ¬ TRUE;
vanilla3[ORD[EventCode[expose]]] ¬ TRUE;
--
vanilla3­ ¬ vanilla2­;
vanilla3[ORD[EventCode[enterNotify]]] ¬ TRUE;
vanilla3[ORD[EventCode[leaveNotify]]] ¬ TRUE;
--
desperate1­ ¬ vanilla3­;
desperate1[ORD[EventCode[focusOut]]] ¬ TRUE;
desperate1[ORD[EventCode[focusIn]]] ¬ TRUE;
desperate1[ORD[EventCode[keyPress]]] ¬ TRUE;
desperate1[ORD[EventCode[keyRelease]]] ¬ TRUE;
desperate1[ORD[EventCode[buttonPress]]] ¬ TRUE;
desperate1[ORD[EventCode[buttonRelease]]] ¬ TRUE;
--
desperate2[ORD[EventCode[local]]] ¬ FALSE;
--
ForkOpsFriends.RegisterAbortNotifier[DispatcherProcess, AbortNotification];
END.