XTkFastAccessPrivateImpl.mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 8, 1991 5:15:35 pm PDT
Christian Jacobi, June 15, 1992 10:04 pm PDT
Crazy internal module which is used to enable synchronization of stopping the paint processes.
DIRECTORY
BasicTime USING [GetClockPulses, MicrosecondsToPulses, Pulses],
Process USING [Pause, Yield],
Xl USING [TQ],
XlTQPrivate USING [TQRec, Job],
XTkFastAccessPrivate;
XTkFastAccessPrivateImpl: CEDAR MONITOR
IMPORTS BasicTime, Process
EXPORTS Xl<<for TQImpl>>, XTkFastAccessPrivate ~
BEGIN OPEN XTkFastAccessPrivate;
TQRep: PUBLIC TYPE = XlTQPrivate.TQRec;
TQ: TYPE = REF TQRep;
pieceSize: INT = 8;
TQSet: TYPE = REF TQSetRep;
TQSetRep: PUBLIC TYPE = RECORD [
pieces: ARRAY [0..pieceSize) OF Xl.TQ ¬ ALL[NIL], --members of set
state: ARRAY [0..pieceSize) OF XlTQPrivate.Job ¬ ALL[NIL], --previous state
clientAccessible: BOOL ¬ FALSE,
nextSet: TQSet ¬ NIL --rarely used as sets are typically quite small
];
freeList: TQSet ¬ NIL; --MONITORED
New: ENTRY PROC [link: TQSet ¬ NIL] RETURNS [s: TQSet] = {
s ¬ freeList;
IF s#NIL
THEN freeList ¬ s.nextSet
ELSE s ¬ NEW[TQSetRep];
s.clientAccessible ¬ TRUE;
s.nextSet ¬ link
};
Free: ENTRY PROC [s: TQSet] = {
s.pieces ¬ ALL[NIL];
s.state ¬ ALL[NIL];
s.nextSet ¬ freeList;
freeList ¬ s
};
Include: PUBLIC PROC [set: TQSet, tq: Xl.TQ] RETURNS [s: TQSet] = {
Sort of linear search for duplicates, that is ok as sets are small
IF set=NIL THEN set ¬ New[];
s ¬ set;
IF ~s.clientAccessible THEN ERROR; --protects further refs to freed sets
DO
FOR idx: [0..pieceSize) IN [0..pieceSize) DO
IF s.pieces[idx]=tq THEN RETURN;
IF s.pieces[idx]=NIL THEN {s.pieces[idx] ¬ tq; RETURN};
ENDLOOP;
s ¬ New[s];
ENDLOOP
};
limit: BasicTime.Pulses ¬ BasicTime.MicrosecondsToPulses[5000000];
Synchronize: PUBLIC PROC [set: TQSet] = {
Init: PROC [set: TQSet] = {
Initializes the state information and nil's out tq's not necesarry to wait for.
WHILE set#NIL DO
set.clientAccessible ¬ FALSE;
FOR i: [0..pieceSize) IN [0..pieceSize) DO
t: TQ ¬ set.pieces[i];
IF t#NIL THEN {
IF t.this=NIL AND t.lockCount=0 <<unprotected! but that is ok as all lock is free once is all we want>>
THEN set.pieces[i] ¬ NIL
ELSE set.state[i] ¬ t.this;
};
ENDLOOP;
set ¬ set.nextSet;
ENDLOOP;
};
Check: PROC [set: TQSet] RETURNS [mustWait: BOOL ¬ FALSE] = {
Returns whether we must wait for a tq; might nil out more...
WHILE set#NIL DO
FOR i: [0..pieceSize) IN [0..pieceSize) DO
t: TQ ¬ set.pieces[i];
IF t#NIL THEN {
IF t.this=NIL AND t.lockCount=0 <<unprotected! but that is ok as lock free once is all we want>>
THEN set.pieces[i] ¬ NIL
ELSE {
IF set.state[i] # t.this
THEN set.pieces[i] ¬ NIL
ELSE {mustWait ¬ TRUE; RETURN}
};
};
ENDLOOP;
set ¬ set.nextSet;
ENDLOOP;
};
IF set#NIL THEN {
pulses: BasicTime.Pulses;
Init[set];
Process.Yield[];
IF Check[set].mustWait THEN {
start: BasicTime.Pulses ¬ BasicTime.GetClockPulses[];
DO
Process.Pause[5];
Process.Pause[5];
IF ~Check[set].mustWait THEN RETURN;  
pulses ¬ BasicTime.GetClockPulses[];
IF (pulses-start <<modular arithmetic>>) > limit THEN EXIT; <<timeout>>
ENDLOOP
};
Free[set]; --return only the first piece; thats ok since sets are normally small
};
};
END.