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
DIRECTORY
CedarProcess USING [SetPriority],
CodeTimer,
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;
Global variables
queueHead: Queue ¬
NIL;
The head of the inUse queue
queueTail: Queue ¬
NIL;
The tail of the inUse queue
queueFree: Queue ¬
NIL;
The free list of entries
maxForkers:
NAT ¬ 3;
-- is 10 in PrincOps (Bier, December 13, 1988)
max # of processes to fork in here
currentForkers:
NAT ¬ 0;
current # of forked processes here
marginForkers:
NAT ¬ 4;
idleForkers <= marginForkers => only can paint from columns without started forkers
idleForkers:
NAT ¬ 0;
# of forkers NOT in possession of a queued entry
queueChange: CONDITION;
shortCuts: INT ¬ 0;
useShortCuts: BOOL ¬ TRUE;
callWithLinks: BOOL ¬ TRUE;
Private types
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] = {
... 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
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.proc = NIL THEN { -- changed by PolleZ to ...
IF last #
NIL
AND last.first.state = waiting
AND last.first.proc =
NIL
THEN {
The last request was a paint request that may cover (or be made to cover) this one.
lastHint: PaintHint ¬ last.first.hint;
lastData: REF ¬ last.first.data;
At this point the last request is not busy, so we are allowed to alter it.
IF lastHint = all
AND (lastData = whatChanged
OR whatChanged =
NIL)
THEN
The last request covers this one
GO TO shortCut;
IF hint = all
AND (lastData = whatChanged
OR whatChanged =
NIL)
THEN {
This request covers the last one, so modify the old one
last.first.data ¬ whatChanged;
last.first.hint ¬ all;
GO TO shortCut;
};
IF hint = lastHint
AND lastData = whatChanged
THEN
The last request and the current request are identical (except for clearClient)
GO TO shortCut;
EXITS
shortCut => {
IF
NOT last.first.clearClient
AND clearClient
THEN
clearing the client dominates not clearing
last.first.clearClient ¬ clearClient;
shortCuts ¬ shortCuts + 1;
RETURN;
};
};
};
At this point we must add a new entry, so CONS it up or get it from the free list
IF new =
NIL
THEN {
We need a new one
new ¬ LIST[[viewer, NIL, hint, clearClient, whatChanged, waiting]];
}
ELSE {
We can get it from our free list
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] = {
... 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).
new: Queue ¬ queueFree;
IF new =
NIL
THEN {
We need a new one
new ¬ LIST[[viewer, proc, all, FALSE, data, waiting]];
}
ELSE {
We can get it from our free list
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] = {
... removes the given entry from the queue, and notifies queueChange.
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 {
We have found the queue entry in the list, so we can remove it
next ¬ q.rest;
lag.rest ¬ next;
IF queueTail = q
THEN
We are removing the last thing in the queue
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] = {
... 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.
DO
FOR each: Queue ¬ queueHead, each.rest
WHILE each #
NIL
DO
viewer: Viewer ¬ each.first.viewer;
IF each.first.state = waiting
THEN {
This entry is not busy, but its viewer may be busy
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 => {};
For NIL viewers there is no column
idleForkers <= marginForkers => {
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.
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] = {
... is an entry procedure to ensure lockout with the examinations and modifications performed by ForkPaint.
q.first.state ¬ state;
};
ViewerForkerBase:
PROC = {
rememberedQueue: Queue;
CedarProcess.SetPriority[normal];
DO
--ChJ artificial outer loop to retry if ABORTED caught
BEGIN
ENABLE
ABORTED => {
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
RemEntry[rememberedQueue];
GOTO retry
};
DO
q: Queue ¬ rememberedQueue ¬ GetNextEntry[];
v: Viewer ¬ q.first.viewer;
SELECT
TRUE
FROM
q.first.proc #
NIL => {
A call back proc, not a paint proc
SetState[q, busy];
q.first.proc[q.first.data
<<! ABORTED => CONTINUE>>
];
};
v #
NIL
AND
NOT v.destroyed
AND
NOT v.paintingWedged => {
inner:
PROC = {
SetState[q, busy];
At this point we become busy. If we had become busy before, then we would look busy while waiting for the viewers lock.
ViewerOps.PaintViewer[v, q.first.hint, q.first.clearClient, q.first.data];
};
CodeTimer.StartInt[$ViewerForkerBase, $PViewers];
IF callWithLinks
THEN
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[inner, v
<<! ABORTED => CONTINUE>>
]
ELSE
ViewerGroupLocks.CallRootUnderWriteLock[inner, v
<<! ABORTED => CONTINUE>>
];
CodeTimer.StopInt[$ViewerForkerBase, $PViewers];
};
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.