

DIRECTORY 
Basics, ForkOps, ForkOpsFriends, Process, UnsafePropList, Xl, XlTQPrivate;

XlImplTQ: CEDAR MONITOR LOCKS tq USING tq: TQ
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] = {
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 {
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 {
lag м p;
};
p м p.next
ENDLOOP;
};
removed: CARD м 0;
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;
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]];
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];
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;
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
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;
};

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] = {
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] = {
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 {
}; 

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.


  &  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
--the tq lock might be called inside the connection lock
--prevents using up all storage for a blocked thread
--remove
--keep
--first try to get rid of vanilla stuff
--removes all leading error events
TRUSTED {Process.InitializeCondition[@tq.newEvent, Process.MsecToTicks[100]]};
--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...
--check 2 phase locking
--DO 
ENABLE ABORTED => {
--protect from abort in the clients proc (it won't crash anywhere else)
tq.this м NIL;
SignalFor2Phase[tq];
Process.Yield[];
};
--ENDLOOP;


--But no gurantee that it is free afterwards
--Returns TRUE on success
Process.SetTimeout[@tq.newEvent, Process.MsecToTicks[ms]]
--
--
--
--
--
Э╩  Ц(cedarcode) styleХNewlineDelimiter
Ш codeЩKЪЬ
╧eЬOЩZKЪЬ/Щ/KЩ.ЧKШ Ъ╧k	ЬШ
KШJKШ ЧЪ╧nЬЮЬЮЬЮЬЮЬЮШ-KЪЬ8Щ8KЪЮЬ)Ш0KЪЮЬШЧЪЮЬЮЬШKШ ЧKЪЬЮЬЮЬШ.KЪЬЮЬЮЬЮЬШ(KШ KЪЯЬЮЬЮЬЮЬШKШ KЪЬЮЬЮЬЮЬ
ЮЬЮЬЮЬЮЬШ:KШ KЪЬ
ЮЬ
ЮЬ	Ш#KЪЬ
ЮЬ
ЮЬ	Ш#KЪЬ
ЮЬ
ЮЬ	Ш#KЪЬЮЬ
ЮЬЮЬШ%KЪ	ЬЮЬ
ЮЬ
ЮЬЮЬШ1KШ ЪЯЬЮЬЮЬЮЬШ0KЪ╧c4Щ4ЪЯЬЮЬЮЬЮЬШ-KЪЬЮЬШKШKЪЮЬЮЬЮЬЮЬШЪЮЬЮШЪЮЬ	ЮЬЮЬЮЬ!ШIЪЮЬШKЪаЩKЪЬШKЪЬ"Ш"ЪЮЬЮЬШKЪЮЬШKЪЮЬШЧKЪЮЬЮЬЮЬШKШЧЪЮЬШKЪаЩKЪЬШKЪЬШЧЧKЪЬ
Ш
KЪЮЬШЧKШЧKЪЬ	ЮЬШKЪа'Щ'KЪЬЮЬЮЬЮЬШ*KЪЬЮЬЮЬЮЬШ*KЪЬЮЬЮЬЮЬШ*KЪЬЮЬЮЬЮЬШ,KШKШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ1KЪЮЬЮЬЮЬШKЪЬ"Щ"ЪЮЬ	ЮЬЮШЪЮЬЮЬЮШЪЬШKЪЬ Ш KЪЬШKЪЮЬ	ЮЬЮЬЮШ!KЪЬШЧKЪЮЬЮЬШЧKЪЮЬШЧKЪЬШЧKШ KЪЬЮЬЮЬ	аШ.KЪЬЮЬШKШ ЪЯЬЮЬЮЬЮЬЮЬ	ЮЬЮЬЮЬЮЬЮЬШiЪЯ	ЬЮЬЮЬЮа	Ь
ЮЬЮЬШ>ЪЮЬЮЬЮЬШKЪЮЬа&ШFKЪЮЬШЧKЪЬ(Ш(KЪЬШЧKЪЬЮЬ1Ш9KЪЮЬGЩNKШЪЮЬ	ЮЬШKЪЬШKЪЬШKШЧKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШDKШЪЮЬЮЬШKЪЮЬ!ЮЬШDKЪЮЬЮЬ	ШЧKШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ<KЪЬЮЬа.Ш>ЪЮЬЮЬШKШKШKШKШЧKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ{KШKЪЮЬ	ЮЬЮЬШKШKШKШЪЮЬ	ЮЬШЪЮЬШKЪЬШKШЪЮЬЮЬШKЪЬЮЬШKЪЬЮЬШKШЧKШЧЪЮЬШKЪЬ"Ш"KШKШKЪЮЬЮЬШ=KШЧЧKШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШOKЪЬа!Ш;ЪЮЬ+ЮЬШ2KШ1ЧKШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ/ЪЮЬЮЬЮШ3KЪЮ	ЬШЧKШKШ ЧЪЯЬЮЬЮЬШ$KЪЬЮЬЮЬШKЪаЩKЪаGЩGKЪа;Щ;KЪаЩKЩEЪЯ	ЬЮЬЮЬЮЬЮЬЮЬШIKЪЮЬЮЬЮЬШ/KШЪЮЬЮЬЮЬШKЪЬЮЬШKЪЬ
ЮЬШKЪЬЮЬШKЪЮЬЮЬЮЬЮ	ЬШQKЪЮШKШЧKШ KШKЩЪЮЬЮЬЮШKШ*KЪЮЬШKШ*KЪЮЬШЧKШKШЧKШ	KЪЬ"Ш"ЩЪЮЬЮЬЩKЪа$ЬаЩGKЪЬ
ЮЬЩKЩKЩKЩЧЪЮШЪЮЬЮЬЮЬЮЬШ5KШKШKШЧKШKЪЮЬЮЬЮЬЮЬШKШJKЪЬ
ЮЬШKЪЮЬШЧKЩ
ЧKШЧKШ ЪЯЬЮЬЮЬШ$KЪЬЮЬЮЬШKЪЬ
ЮЬШKШKШKШЧKШ ЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШ4KЪ	ЬЮЬЮЬЮЬЮЬШKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШ6KЪЬЮЬЮЬШKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ9KЪЮЬЮЬШ(KШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ1KЪЬЮЬШ!KЪЮЬЮЬШ5KЪЬШKЩ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ7KЪЮЬШKЪЬШKЩ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШHЪЬЮЬЮЬЮШKЪЬЮЬШ"KЪЬШKЪЬ%Ш%KЪЬШKЪЬ#Ш#KЪЬШKЪЬ#Ш#KЪЬШKЪЮЬЮЬШЧKЪЬШKЩ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШ9KЪЬЮЬШ!Ъ
ЮЬЮЬЮЬЮЬЮЬШAKЪЬЮШKШЧЪЮЬЮЬЮЬЮЬЮЬ	ЮЬШLKЪЬЮШKШЧЪЮЬЮШ"KЪЬ	Ш	KЪЬЮЬШ.KЪЮЬЮЬШЧЦ"cedar" styleЪЮШЦ"cedar" styleЪЮЬШЦ"cedar" styleЪЮЬШЪЮЬШЪЮЬШЪЬЮЬШJШJШJШЧJШJШJЪЮШJШЧЪЮЬШJШJШJШЧЧJШЧЪЮЬШJШJШЧЧKЦ"cedar" styleЪЮЬШЧKШЧШ KШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШ7JЩ,ЪЮЬ	ЮЬЮЬЮЬЮЬЮЬШEJШ+KЪЮЬШJШ+JШЧKШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШLJЩKЦ"cedar" styleЪ
ЮЬ	ЮЬЮЬЮЬЮЬШ#KЦ"cedar" styleЪ
ЮЬЮЬЮЬ+ЮЬЮЬШUKЦ"cedar" styleЪЮЬЮЬ!ЮЬЮЬШLKШKШ ЧЪЯЬЮЬЮЬЮЬШ$KЦ"cedar" styleШ Ц"cedar" styleЪЮЬЮЬШKЦ"cedar" styleЪЬЮЬШKЦ"cedar" styleЪЮЬЮЬЮ	ЬШ8KЦ"cedar" styleШЧKШKШ ЧЦ"cedar" styleЪ
ЯЬЮЬЮЬЮЬЮЬШ2KЪЬЮЬШ!KЪЮЬЮЬЮЬЮЬЮЬ
ЮЬШNKЪЮЬ	ЮЬЮЬШЦ"cedar" styleЪЮШЦ"cedar" styleЪЮЬЮЬШ!JЪЬЮЬШ"KЦ"cedar" styleШKЦ"cedar" styleЪЮЬШKЦ"cedar" styleШЧJШKЦ"cedar" styleЪЮЬШЧKЦ"cedar" styleШЧKШ ЪЯЬЮЬЮЬЮЬ!ШCKЪЬШKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ9KЪЬ9Щ9KЪЬШKШ ЧKЪЬ	ЮЬЮЬШ.KЩKЪЬ	ЮЬЮЬШ.KЪЬ	ЮЬ!ЮЬШ2KЪЬ	ЮЬЮЬШ,KЪЬ	ЮЬ!ЮЬШ2KЪЬ	ЮЬЮЬШ(KЩKШKЪЬ	ЮЬЮЬШ-KЪЬ	ЮЬЮЬШ-KЩKШKЪЬЮЬЮЬШ,KЪЬЮЬЮЬШ+KЪЬЮЬЮЬШ,KЪЬЮЬЮЬШ.KЪЬЮЬЮЬШ/KЪЬЮЬЮЬШ1KЩKЪЬЮЬЮЬШ*KЩKШKKЪЮЬШKШ KШ Ч ЕЧ    <  2q  