XlBWFriendsImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, September 22, 1992
Christian Jacobi, October 20, 1993 5:46 pm PDT
DIRECTORY
ForkOps,
IO,
XlBWFriends,
Process,
PropList,
SF,
SFInline,
Xl,
XlBitmap,
XlSpeedHacks;
XlBWFriendsImpl: CEDAR MONITOR
LOCKS s USING s: SRef
IMPORTS ForkOps, IO, Process, PropList, SFInline, Xl, XlBitmap, XlSpeedHacks
EXPORTS XlBWFriends =
BEGIN OPEN XlBWFriends;
Tweek these constants to optimize this package
hysteresisByCaller: BOOL = FALSE; --(start) hysteresis is either in caller (producer) or in ServiceProcess
alwaysYield: BOOL = FALSE; --extra yield in ServiceProcess for benefit of painter
batchSize: INT = 10; --we are batching "PutImages" of the same window
packageKey: REF ~ NEW[INT];
NewSRef: PUBLIC PROC [] RETURNS [s: SRef ¬ NEW[SRec]] = {
msecs: INT ~ IF hysteresisByCaller THEN 50 ELSE 200;
TRUSTED {Process.SetTimeout[@s.sleepingConsumer, Process.MsecToTicks[msecs]]};
};
ServiceInitialize: PropList.InitializeProcType = {
RETURN [NewSRef[]];
};
GetSeviceRef: PROC [c: Xl.Connection] RETURNS [SRef] = {
pl: PropList.List ~ Xl.ServiceProperties[c];
val: REF ~ PropList.GetPropOrInit[list: pl, key: packageKey, init: ServiceInitialize, data: c].val;
RETURN [NARROW[val]];
};
BufferFull: INTERNAL PROC [w: WRef] RETURNS [BOOL] = INLINE {
RETURN [(w.ix+1) MOD bufferSize = w.ox ]
};
BufferEmpty: INTERNAL PROC [w: WRef] RETURNS [BOOL] = INLINE {
RETURN [ w.ix=w.ox ]
};
DiscardRect: INTERNAL PROC [s: SRef, w: WRef, i: Index] = INLINE {
--Removes entry i from buffer and compact buffer.
--Precondition: i is valid index designating filled buffer entry
--Discard area in backwards order, it will look nicer
lix: Index ~ (w.ix+(bufferSize-1)) MOD bufferSize;
IF lix#i THEN {
w.rects[i] ¬ w.rects[lix];
w.costs[i] ¬ w.costs[lix];
};
w.ix ¬ lix;
};
IConsumeRect: INTERNAL PROC [s: SRef, w: WRef] RETURNS [r: SF.Box] = INLINE {
--Removes and returns entry from buffer.
--Precondition: buffer not empty
--Postcondition: buffer not full
ox: Index ~ w.ox;
r ¬ w.rects[ox];
w.ox ¬ (ox+1) MOD bufferSize;
};
Union: PROC [box1, box2: SF.Box] RETURNS [SF.Box] = INLINE {
RETURN[[
min: SFInline.Min[box1.min, box2.min],
max: SFInline.Max[box1.max, box2.max]
]];
};
Cost: PROC [r: SF.Box] RETURNS [INT] = INLINE {
--Approximates cost of blitting a rectangular area
--Precondition: r legal, non empty rectangle (e.g.: no overflow)
--Slightly favors black and white, remote displays
-- On shared memory: could make too large unifications: but that is ok.
-- On remote color too much unification: Remote color is discouraged anyway)
bpu: INT = 4; --correct would be 4 or 32; I prefer shift instruction to accuracy
--For shared memory slightly bugus because phase ought to be screen relative. It doesn't matter there because we accept too large unifications anyway.
RETURN [(r.max.s-r.min.s) * ((r.max.f + (bpu - 1)) / bpu - r.min.f / bpu)]
};
IncludeRect: PUBLIC ENTRY PROC [s: SRef, w: WRef, r: SF.Box, delayOk: BOOL] = {
DidSimplify: INTERNAL PROC [w: WRef] RETURNS [BOOL] = INLINE {
--Uses intermediate level variables: r, cost
--Inline to prevent laying intermediates into memory (even if procedure is not used)
count: Index ~ (w.ix+bufferSize-w.ox) MOD bufferSize;
FOR i: Index IN [0..count) DO
this: Index ~ (w.ix+(bufferSize-1)-i) MOD bufferSize;
uRect: SF.Box ~ Union[r, w.rects[this]];
uCost: INT ~ Cost[uRect];
IF uCost<=cost+w.costs[this]+w.overheadCost THEN {
r ¬ uRect;
cost ¬ uCost;
DiscardRect[s, w, this];
RETURN [TRUE];
};
ENDLOOP;
RETURN [FALSE];
};
cost: INT;
r ¬ SFInline.Intersect[r, w.clip];
IF SFInline.Empty[r] THEN RETURN;
IF BufferFull[w] THEN {
w.slowedProducersCnt ¬ w.slowedProducersCnt+1;
WAIT w.slowedProducers; --I arbitrarily think it is better policy to slow down the producer instead of combinining more areas when the buffer fills up. Consider that we are not very clever in handling overflowing buffers. Lets hope that after the wait the buffer isn't full anymore. However, this may timeout, and, we have to simplify anyway.
w.slowedProducersCnt ¬ w.slowedProducersCnt-1;
IF BufferFull[w] THEN {
r ¬ Union[r, IConsumeRect[s, w]];
};
};
--Assert: buffer not full
cost ¬ Cost[r];
WHILE DidSimplify[w] DO ENDLOOP;
--Assert: buffer still not full
BEGIN
i: Index ~ w.ix;
w.rects[i] ¬ r;
w.costs[i] ¬ cost;
w.ix ¬ (i+1) MOD bufferSize;
END;
s.changed ¬ TRUE;
IF s.consumerSleeps THEN {
IF hysteresisByCaller
THEN {
startHysteresis: INT = IF delayOk THEN 8 ELSE 2;
IF (bufferSize+w.ix-w.ox) MOD bufferSize > startHysteresis THEN
NOTIFY s.sleepingConsumer;
}
ELSE {
startHysteresis: INT = 4;
--note that in most frequent use, delayOk is FALSE and we are doing the notify
IF ~delayOk OR ((bufferSize+w.ix-w.ox) MOD bufferSize > startHysteresis) THEN {
NOTIFY s.sleepingConsumer;
}
}
};
};
CancelRects: PUBLIC ENTRY PROC [s: SRef, w: WRef] = {
IF ~BufferEmpty[w] THEN {
w.ox ¬ w.ix;
w.emptyCount ¬ w.emptyCount+1;
IF w.emptySleepersCnt>0 THEN BROADCAST w.emptySleepers;
};
};
WaitLocal: PUBLIC ENTRY PROC [s: SRef, w: WRef] RETURNS [timedOut: BOOL ¬ FALSE] = {
IF ~BufferEmpty[w] THEN {
cnt: CARD ~ w.emptyCount;
w.emptySleepersCnt ¬ w.emptySleepersCnt+1;
WAIT w.emptySleepers;
w.emptySleepersCnt ¬ w.emptySleepersCnt-1;
timedOut ¬ w.emptyCount=cnt AND ~BufferEmpty[w];
};
};
ConsumeRect: ENTRY PROC [s: SRef, w: WRef] RETURNS [b: SF.Box] = {
--returns empty rect if buffer is empty
hysteresis: INT ~ 5; --non-empty hysteresis
IF BufferEmpty[w]
THEN {
IF w.emptySleepersCnt>0 THEN {
w.emptyCount ¬ w.emptyCount+1;
BROADCAST w.emptySleepers;
};
b ¬ empty;
}
ELSE {
b ¬ IConsumeRect[s, w];
};
IF w.slowedProducersCnt>0 AND (bufferSize+w.ix-w.ox) MOD bufferSize > hysteresis THEN NOTIFY w.slowedProducers;
};
StopWRef: PUBLIC PROC [w: WRef] = {
EntryRemH: ENTRY PROC [s: SRef, w: WRef] = {
w.ox ¬ w.ix;
IF s.allHandles.first=w
THEN s.allHandles ¬ s.allHandles.rest
ELSE {
FOR l: LIST OF WRef ¬ s.allHandles, l.rest WHILE l#NIL AND l.rest#NIL DO
IF l.rest.first=w THEN l.rest ¬ l.rest.rest;
ENDLOOP;
};
s.changed ¬ TRUE;
IF s.next#NIL AND s.next.first=w THEN s.next ¬ s.next.rest;
IF s.consumerSleeps THEN NOTIFY s.sleepingConsumer; --prevent eternal sleep
IF w.emptySleepersCnt>0 THEN BROADCAST w.emptySleepers;
IF w.slowedProducersCnt>0 THEN BROADCAST w.slowedProducers;
};
IF w#NIL THEN {
s: SRef ~ w.s;
IF s#NIL THEN EntryRemH[s, w];
XlBitmap.RemoveInterceptionProcs[w.bm, w];
};
};
InterceptedRefresh: XlBitmap.BoxDataProc = {
w: WRef ~ NARROW[data];
--If buffer has certain fullness, put directed yield in here
IncludeRect[w.s, w, box, delayOk];
};
StartWRef: PUBLIC PROC [w: WRef] = {
EntryAddH: ENTRY PROC [s: SRef, w: WRef] RETURNS [mustStart: BOOL ¬ FALSE] = {
FOR l: LIST OF WRef ¬ s.allHandles, l.rest WHILE l#NIL DO
IF l.first=w THEN RETURN [FALSE]; --this is actually an error
ENDLOOP;
s.allHandles ¬ CONS[w, s.allHandles];
IF ~s.processExists THEN {s.processExists ¬ mustStart ¬ TRUE};
s.changed ¬ TRUE;
};
s: SRef ¬ w.s;
IF s=NIL THEN s ¬ w.s ¬ GetSeviceRef[w.c];
TRUSTED {
Process.SetTimeout[@w.emptySleepers, Process.MsecToTicks[200]];
Process.SetTimeout[@w.slowedProducers, Process.MsecToTicks[80]];
};
IF s#NIL THEN {
mustStart: BOOL ¬ EntryAddH[s, w];
XlBitmap.RegisterInterceptionProcs[w.bm, InterceptedRefresh, NIL, w];
IF mustStart THEN ForkOps.ForkDelayed[0, ServiceProcess, s];
};
};
ResetConsumers: ENTRY PROC [s: SRef] RETURNS [mustExit: BOOL] = {
next: LIST OF WRef ¬ s.next ¬ s.allHandles;
IF mustExit ¬ (next=NIL)
THEN s.processExists ¬ FALSE
ELSE s.changed ¬ FALSE;
};
NextConsumer: ENTRY PROC [s: SRef] RETURNS [w: WRef ¬ NIL] = INLINE {
next: LIST OF WRef ~ s.next;
IF next#NIL THEN {
w ¬ next.first; --never NIL
s.next ¬ next.rest
};
};
SleepIfNoChange: ENTRY PROC [s: SRef] = INLINE {
--For consumer
WHILE ~s.changed DO
s.consumerSleeps ¬ TRUE;
WAIT s.sleepingConsumer;
s.consumerSleeps ¬ FALSE;
ENDLOOP;
};
ServiceProcess: PROC [x: REF] = {
ENABLE Xl.XError, IO.Error, IO.EndOfStream => {
--Probably a connection died (normal, not an error condition)
GOTO oops;
};
s: SRef ~ NARROW[x];
Process.SetPriority[Process.priorityForeground];
DO
dontSleep: BOOL ¬ FALSE;
IF ResetConsumers[s].mustExit THEN RETURN;
DO
w: WRef ~ NextConsumer[s];
IF w=NIL THEN EXIT;
dontSleep ¬ Visit[s, w] OR dontSleep;
ENDLOOP;
IF ~dontSleep THEN {
IF ~s.changed THEN SleepIfNoChange[s];
IF ~alwaysYield AND ~hysteresisByCaller THEN Process.Yield[]; --give producer a chance to produce more input for hysteresis. Use yield-second-best when available, preferredly even directed-yield.
};
IF alwaysYield THEN Process.Yield[];
ENDLOOP;
EXITS oops => {
--Give other connections of this service a try.
--Small delay to not monopolize cpu until bad connection is gone.
ForkOps.ForkDelayed[100, ServiceProcess, x];
};
};
Visit: PROC [s: SRef, w: WRef] RETURNS [<<dontSleep:>>BOOL] = {
flushWhenDone: BOOL ¬ w.extraRefForImpl#NIL;
THROUGH [0..batchSize) DO
r: SF.Box ~ ConsumeRect[s, w];
IF r.max.f<=r.min.f <<empty>> THEN {
IF flushWhenDone THEN {
--IMPROVE EVENTUALLY: flush on per connection basis only
w.extraRefForImpl ¬ NIL;
Xl.Flush[w.c];
};
RETURN [FALSE];
};
--PAINT THE DAMM THING...
FOR rl: LIST OF ReportRec ¬ w.report, rl.rest WHILE rl#NIL DO
rl.first.proc[r, rl.first.data]
ENDLOOP;
--Count requests waiting on server. Avoid having the server buffering too many requests. We don't care about memory of buffer, but, once a request is in the server queue it can't be optimized away anymore.
--It is ok to wait for a particular connection; if it can't keep up, the server probably can't keep up the other connections of this service anyway.
w.serverQueueCnt ¬ w.serverQueueCnt+1;
IF w.serverQueueCnt>w.serverQueueLimit THEN {
newSNo: Xl.SequenceNo ¬ XlSpeedHacks.InitiateRoundTrip[w.c];
w.serverQueueCnt ¬ 0;
IF w.sNo#0 THEN XlSpeedHacks.WaitInitiatedRange[w.c, w.sNo];
w.sNo ¬ newSNo;
};
flushWhenDone ¬ TRUE;
ENDLOOP;
w.extraRefForImpl ¬ $flushProposed;
RETURN [TRUE];
};
END.