<> <> <> <<>> 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; <> queueHead: Queue _ NIL; <> queueTail: Queue _ NIL; <> queueFree: Queue _ NIL; <> maxForkers: NAT _ 10; <> 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; 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 { <> lastState: EntryState _ last.first.state; 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 = { CedarProcess.SetPriority[normal]; DO q: Queue _ GetNextEntry[]; v: Viewer _ q.first.viewer; SELECT TRUE FROM q.first.proc # NIL => { <> 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]; <> 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.