ViewerForkersImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) July 1, 1985 8:03:41 pm PDT
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, 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 ← 10;
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;
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 {
The last request was a paint request that may cover (or be made to cover) this one.
lastState: EntryState ← last.first.state;
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 = {
CedarProcess.SetPriority[normal];
DO
q: Queue ← 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];
};
IF callWithLinks
THEN
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[inner, v
! ABORTED => CONTINUE
]
ELSE
ViewerGroupLocks.CallRootUnderWriteLock[inner, v
! ABORTED => CONTINUE
];
};
ENDCASE;
RemEntry[q];
ENDLOOP;
};
StartForkers:
ENTRY
PROC =
TRUSTED {
WHILE currentForkers < maxForkers
DO
currentForkers ← currentForkers + 1;
idleForkers ← idleForkers + 1;
Process.Detach[FORK ViewerForkerBase[]];
ENDLOOP;
BROADCAST queueChange;
};
StartForkers[];
END.