DIRECTORY
CedarProcess USING [SetPriority],
Process USING [Detach],
ViewerClasses USING [Column, Viewer],
ViewerForkers USING [CallBack],
ViewerGroupLocks USING [CallRootAndLinksUnderWriteLock, CallRootUnderWriteLock],
ViewerOps USING [PaintHint, PaintViewer];

ViewerForkersImpl: CEDAR MONITOR
IMPORTS CedarProcess, --CodeTimer,-- Process, ViewerGroupLocks, ViewerOps
EXPORTS ViewerForkers
= BEGIN

Column: TYPE = ViewerClasses.Column;
PaintHint: TYPE = ViewerOps.PaintHint;
Viewer: TYPE = ViewerClasses.Viewer;


queueHead: Queue м NIL;
queueTail: Queue м NIL;
queueFree: Queue м NIL;
maxForkers: NAT м 3; -- is 10 in PrincOps (Bier, December 13, 1988)
currentForkers: NAT м 0;
marginForkers: NAT м 4;
idleForkers: NAT м 0;
queueChange: CONDITION;
shortCuts: INT м 0;
useShortCuts: BOOL м TRUE;
callWithLinks: BOOL м TRUE;


Queue: TYPE = LIST OF QueueEntry;

QueueEntry: TYPE = RECORD [
viewer: Viewer,
proc: ViewerForkers.CallBack м NIL,
hint: PaintHint м all,
clearClient: BOOL м TRUE,
data: REF ANY м NIL,
state: EntryState м waiting];

EntryState: TYPE = {waiting, started, busy, done};

ForkPaint: PUBLIC ENTRY PROC [viewer: Viewer, hint: PaintHint, clearClient: BOOL м TRUE, whatChanged: REF ANY м NIL, tryShortCuts: BOOL м FALSE] = {
new: Queue м queueFree;
IF viewer = NIL OR viewer.destroyed THEN RETURN;
IF useShortCuts AND tryShortCuts THEN {
last: Queue м NIL;
IF viewer.iconic AND NOT (hint=all OR hint=caption OR viewer.icon=private) THEN RETURN;
FOR each: Queue м queueHead, each.rest WHILE each # NIL DO
IF each.first.viewer = viewer THEN
last м each;
ENDLOOP;
IF last # NIL AND last.first.state = waiting AND last.first.proc = NIL THEN {
lastHint: PaintHint м last.first.hint;
lastData: REF м last.first.data;
IF lastHint = all AND (lastData = whatChanged OR whatChanged = NIL) THEN
GO TO shortCut;
IF hint = all AND (lastData = whatChanged OR whatChanged = NIL) THEN {
last.first.data м whatChanged;
last.first.hint м all;
GO TO shortCut;
};
IF hint = lastHint AND lastData = whatChanged THEN
GO TO shortCut;
EXITS
shortCut => {
IF NOT last.first.clearClient AND clearClient THEN
last.first.clearClient м clearClient;
shortCuts м shortCuts + 1;
RETURN;
};
};
};
IF new = NIL
THEN {
new м LIST[[viewer, NIL, hint, clearClient, whatChanged, waiting]];
}
ELSE {
new.first м [viewer, NIL, hint, clearClient, whatChanged, waiting];
queueFree м new.rest;
new.rest м NIL;
};
IF queueTail = NIL THEN queueHead м new ELSE queueTail.rest м new;
queueTail м new;
NOTIFY queueChange;
};

ForkCall: PUBLIC ENTRY PROC [viewer: ViewerClasses.Viewer м NIL, proc: ViewerForkers.CallBack, data: REF м NIL] = {
new: Queue м queueFree;
IF new = NIL
THEN {
new м LIST[[viewer, proc, all, FALSE, data, waiting]];
}
ELSE {
new.first м [viewer, proc, all, FALSE, data, waiting];
queueFree м new.rest;
new.rest м NIL;
};
IF queueTail = NIL THEN queueHead м new ELSE queueTail.rest м new;
queueTail м new;
NOTIFY queueChange;
};

RemEntry: ENTRY PROC [q: Queue] = {
lag: Queue м queueHead;
IF lag = NIL OR q = NIL THEN ERROR;
NOTIFY queueChange;
q.first.state м done;
IF q = lag THEN {
queueHead м q.rest;
IF queueTail = q THEN queueTail м queueHead;
GO TO unlink;
};
DO
next: Queue м lag.rest;
IF next = q THEN {
next м q.rest;
lag.rest м next;
IF queueTail = q THEN
queueTail м lag;
GO TO unlink
};
IF (lag м next) = NIL THEN ERROR;
ENDLOOP;
EXITS unlink => {
idleForkers м idleForkers + 1;
q.rest м queueFree;
queueFree м q;
};
};

GetNextEntry: ENTRY PROC RETURNS [q: Queue] = {
DO
FOR each: Queue м queueHead, each.rest WHILE each # NIL DO
viewer: Viewer м each.first.viewer;
IF each.first.state = waiting THEN {
FOR prev: Queue м queueHead, prev.rest WHILE prev # each DO
IF prev.first.viewer = viewer THEN GO TO alreadyBusy;
ENDLOOP;
SELECT TRUE FROM
viewer = NIL => {};
idleForkers <= marginForkers => {
col: Column м IF viewer.iconic THEN static ELSE viewer.column;
IF idleForkers = 0 THEN EXIT;
FOR prev: Queue м queueHead, prev.rest WHILE prev # each DO
pv: Viewer м prev.first.viewer;
IF pv # NIL THEN {
pc: Column м IF pv.iconic THEN static ELSE pv.column;
IF pc = col THEN GO TO alreadyBusy;
};
ENDLOOP;
};
ENDCASE;
each.first.state м started;
idleForkers м idleForkers - 1;
RETURN [each];
EXITS alreadyBusy => {};
};
ENDLOOP;
WAIT queueChange;
ENDLOOP;
};

SetState: ENTRY PROC [q: Queue, state: EntryState] = {
q.first.state м state;
};

ViewerForkerBase: PROC = {
rememberedQueue: Queue;
CedarProcess.SetPriority[normal];
DO --ChJ artificial outer loop to retry if ABORTED caught
BEGIN
ENABLE ABORTED => { 
RemEntry[rememberedQueue];
GOTO retry
};
DO
q: Queue м rememberedQueue м GetNextEntry[];
v: Viewer м q.first.viewer;
SELECT TRUE FROM
q.first.proc # NIL => {
SetState[q, busy];
q.first.proc[q.first.data
];
};
v # NIL AND NOT v.destroyed AND NOT v.paintingWedged => {
inner: PROC = {
SetState[q, busy];
ViewerOps.PaintViewer[v, q.first.hint, q.first.clearClient, q.first.data];
};
IF callWithLinks
THEN
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[inner, v
]
ELSE
ViewerGroupLocks.CallRootUnderWriteLock[inner, v
];
};
ENDCASE;
RemEntry[q];
ENDLOOP;
EXITS retry => {}
END;
ENDLOOP;
};

StartForkers: ENTRY PROC = TRUSTED {
WHILE currentForkers < maxForkers DO
currentForkers м currentForkers + 1;
idleForkers м idleForkers + 1;
Process.Detach[FORK ViewerForkerBase[]];
ENDLOOP;
BROADCAST queueChange;
};

StartForkers[];

END.

     
ViewerForkersImpl.mesa
Copyright ╙ 1985, 1986, 1987, 1991 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) July 1, 1985 8:03:41 pm PDT
Doug Wyatt (for Polle Zellweger), July 16, 1987 11:14:11 am PDT
Doug Wyatt, July 16, 1987 11:14:32 am PDT
Michael Plass, December 3, 1987 11:47:12 am PST
Bier, February 18, 1989 9:30:39 pm PST
Christian Jacobi, October 25, 1991 2:29 pm PDT

CodeTimer,
Global variables
The head of the inUse queue
The tail of the inUse queue
The free list of entries
max # of processes to fork in here
current # of forked processes here
idleForkers <= marginForkers => only can paint from columns without started forkers
# of forkers NOT in possession of a queued entry
Private types
... forks a call on ViewerOps.PaintViewer unless:
1.  There is a previous queued non-busy entry for this viewer, and
2.  The previous call either covers this one or can be altered to cover it
IF last # NIL AND last.first.proc = NIL THEN { -- changed by PolleZ to ...
The last request was a paint request that may cover (or be made to cover) this one.
At this point the last request is not busy, so we are allowed to alter it.
The last request covers this one
This request covers the last one, so modify the old one
The last request and the current request are identical (except for clearClient)
clearing the client dominates not clearing
At this point we must add a new entry, so CONS it up or get it from the free list
We need a new one
We can get it from our free list
... forks a call on the user-provided procedure.  If a viewer is specified, then this call will be serialized with the calls for this viewer through this interface (including the painting calls).
We need a new one
We can get it from our free list
... removes the given entry from the queue, and notifies queueChange.
We have found the queue entry in the list, so we can remove it
We are removing the last thing in the queue
... gets the first entry with state = waiting in the queue such that no other entries with that viewer precede it, marks it as started, and returns it.  If no such viewer exists, wait for a change, then check again until such a viewer exists.
This entry is not busy, but its viewer may be busy
For NIL viewers there is no column
At this point we are running out of processes to handle things.  We do NOT hand out any further processes to columns that already have working processes.  This prevents a single locked column from absorbing all of the processes. 
... is an entry procedure to ensure lockout with the examinations and modifications performed by ForkPaint.
ChJ October 25, 1991 remove enable from inner loop
--Note that GetNextEntry, RemEntry and SetState won't abort but only those procedures which originally did have a catch for ABORTED
A call back proc, not a paint proc
<<! ABORTED => CONTINUE>>
At this point we become busy.  If we had become busy before, then we would look busy while waiting for the viewers lock.
CodeTimer.StartInt[$ViewerForkerBase, $PViewers];
<<! ABORTED => CONTINUE>>
<<! ABORTED => CONTINUE>>
CodeTimer.StopInt[$ViewerForkerBase, $PViewers];
Э╩
Ч  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪ╧cЩKЪЬ
╧eЬCЩNKЩ/KЩ?KЩ)KЩ/KЩ&KЩ.KЩ ЧЪ╧k	Ш	KЪЬЯЬШ!KЩ
KЪЬЯЬ
ШKЪЬЯЬШ%KЪЬЯЬШKЪЬЯЬ:ШPKЪЬ
ЯЬШ)ЧKШ Ъ╧nЬЯЬЯШ KЪЯЬBШIKЪЯЬШKЪЬЯШKШ KЪЬЯЬШ$KЪЬЯЬШ&KЪЬЯЬШ$ЧKШ ЪЬЩKШ ЪЬЯЬШKЪЬЩЧЪЬЯЬШKЪЬЩЧЪЬЯЬШKЪЬЩЧЪЬЯЬЭ.ШCKЪЬ"Щ"ЧЪЬЯЬШKЪЬ"Щ"ЧЪЬЯЬШKЪЬSЩSЧЪЬЯЬШKЪЬЯЬ Щ0ЧKЪЬЯ	ЬШKЪЬЯЬШKЪЬЯЬЯЬШKЪЬЯЬЯЬШЧKШ ЪЬЩKШ ЪЬЯЬЯЬЯЬШ!KШ ЧЪЬЯЬЯЬШKЪЬШKЪЬЯЬШ#KЪЬШKЪЬЯЬЯЬШKЪЬЯЬЯЬЯЬШKЪЬШKШ ЧKЪЬЯЬ"Ш2KШ ЧЪа	ЬЯЬЯЬЯЬ0ЯЬЯЬЯЬЯЬЯЬЯЬЯЬШФЪЬ1Щ1KЩBKЩJЧKЪЬШKЪ
ЯЬ
ЯЬЯЬЯЬЯЬШ0ЪЯЬЯЬЯЬШ'KЪЬЯЬШKЪЯЬЯЬЯЬЯЬЯЬЯЬЯЬШWЪЯЬ$ЯЬЯЬЯШ:ЪЯЬЯШ"KЪЬШЧKЪЯЬШЧJЪ
ЯЬЯЬЯЬЯЬЯЬЩJЪЯЬЯЬЯЬЯЬЯЬЯЬШMKЪЬSЩSKЪЬ&Ш&KЪЬ
ЯЬШ KЪЬJЩJЪ	ЯЬЯЬЯЬЯЬЯШHKЪЬ Щ KЪЯЬЯЬ
ШЧЪ
ЯЬЯЬЯЬЯЬЯЬШFKЪЬ7Щ7KЪЬШKШKЪЯЬЯЬ
ШKШЧЪЯЬЯЬЯШ2KЪЬOЩOKЪЯЬЯЬ
ШЧЪЯШЪЬШЪЯЬЯЬЯЬЯШ2KЪЬ*Щ*KЪЬ%Ш%ЧKЪЬШKЪЯЬШKЪЬШЧЧKШЧKШЧKЪЬ*ЯЬ#ЩQЪЯЬЯШЪЯЬШKЪЬЩKЪЬЯЬ
ЯЬ,ШCKШЧЪЯЬШKЪЬ Щ KЪЬЯЬ+ШCKЪЬШKЪЬЯЬШKШЧЧKЪЯЬЯЬЯЬЯЬШBKЪЬШKЪЯЬШKШKШ ЧЪаЬЯЬЯЬЯЬ!ЯЬ&ЯЬЯЬШsKЪЬ├Щ├KЪЬШЪЯЬЯШЪЯЬШKЪЬЩKЪЬЯЬЯЬШ6KШЧЪЯЬШKЪЬ Щ KЪЬ ЯЬШ6KЪЬШKЪЬЯЬШKШЧЧKЪЯЬЯЬЯЬЯЬШBKЪЬШKЪЯЬШKШЧKШ ЪаЬЯЬЯЬШ#KЪЬEЩEKЪЬШ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ЪЬ2Щ2ЪЯЬ$ЯЬЯШ;KЪЯЬЯЬЯЬЯЬШ5KЪЯЬШЧЪЯЬЯЬЯШЪЬ	ЯЬШKЪЬЯЬЩ"ЧЪЬ!Ш!KЪЬGЯЬЫЩхKЪЬЯЬЯЬЯЬШ>KЪЯЬЯЬЯЬШЪЯЬ$ЯЬЯШ;KЪЬШЪЯЬЯЬЯЬШKЪЬЯЬЯЬЯЬШ5KЪЯЬ
ЯЬЯЬЯЬШ#KШЧKЪЯЬШЧKШЧKЪЯЬШЧKЪЬШKШKЪЯЬШKЪЯЬШKЪЬШЧKЪЯЬШЧKЪЯЬШKЪЯЬШЧKШKШ ЧЪаЬЯЬЯЬ"Ш6KЪЬkЩkKЪЬШKШKШ ЧЪаЬЯЬШKЪЬШKЪЬ!Ш!ЪЯЬЭ6Ш9ЪЯШЪЯЬЯЬШKЪЬ2Щ2KЪЬГЩГKЪЬШKЪЯЬШ
KШЧЪЯШKЪЬ,Ш,KЪЬШЪЯЬЯЬЯШЪЬЯЬШKЪЬ"Щ"KЪЬШЪЬШKЪЬЩKЪЬШЧKШЧЪЬЯЬЯЬЯЬЯЬЯЬШ9ЪЬЯЬШЪЬШKЪЬxЩxЧKЪЬJШJKШЧKЪЬ1Щ1ЪЯЬШЪЯШЪЬ8Ш8KЪЬЯЬЯЬЩKЪЬШЧЧЪЯШЪЬ0Ш0KЪЬЯЬЯЬЩKЪЬШЧЧЧKЪЬ0Щ0KШЧKЪЯЬШЧKЪЬШKЪЯЬШЧKЪЯЬШKЪЯЬШЧKЪЯЬШЧKШKШ ЧЪаЬЯЬЯЬЯЬШ$ЪЯЬЯШ$KЪЬ$Ш$KЪЬШKЪЬЯЬШ(KЪЯЬШЧKЪЯ	ЬШKШKШ ЧKЪЬШKШ KЪЯЬШKШ Ч ЕЧ    ц  +Ы  