<<>> <> <> <> <> <> <> <> <> <<>> 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; < 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; <> 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.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] = { <<... 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 { <> 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] = { <<... 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 { <> 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] = { <<... 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 { <> 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] = { <<... 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 => { <> <<--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 => { <> SetState[q, busy]; q.first.proc[q.first.data <<< CONTINUE>>>> ]; }; 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 <<< CONTINUE>>>> ] ELSE ViewerGroupLocks.CallRootUnderWriteLock[inner, v <<< CONTINUE>>>> ]; <> }; 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.