DIRECTORY
ImagerFont USING [XChar],
ImagerManhattan USING [Map, Polygon],
ImagerMaskCache USING [CharMask, CharMaskRep, Parameters, ParametersRep, Run, SmallCache, smallCacheSize],
ImagerSample USING [BoxesFromBitmap, Clear, Clip, Fill, FillBoxes, GetBox, NewSampleMap, ObtainUnsafeDescriptor, ReleaseDescriptor, SampleMap, BasicTransfer],
ImagerSys USING [GoodModulus, RawHash],
Real USING [Ceiling],
RefTab USING [Create, Fetch, Pairs, Ref, Store],
SF USING [Add, Box, BoxAction, maxBox, Size, SizeF, SizeS, Vec, zeroVec];
ImagerMaskCacheImpl:
CEDAR
MONITOR
LOCKS x
USING x: MaskCache
IMPORTS ImagerManhattan, ImagerSample, ImagerSys, Real, RefTab, SF
EXPORTS ImagerMaskCache
~ BEGIN
CharMask: TYPE ~ ImagerMaskCache.CharMask;
CharMaskRep: TYPE ~ ImagerMaskCache.CharMaskRep;
Parameters: TYPE ~ ImagerMaskCache.Parameters;
ParametersRep: TYPE ~ ImagerMaskCache.ParametersRep;
SampleMap: TYPE ~ ImagerSample.SampleMap;
SmallCache: TYPE ~ ImagerMaskCache.SmallCache;
XChar: TYPE ~ ImagerFont.XChar;
bitsPerWord: NAT ~ BITS[WORD];
smallCacheSize: NAT ~ ImagerMaskCache.smallCacheSize;
RasterBits:
PROC [raster:
REF CharMaskRep.raster]
RETURNS [
LONG
POINTER] =
INLINE {
RETURN [LOOPHOLE[raster, LONG POINTER]+SIZE[CharMaskRep.raster[0]]]
};
BitmapFromCharMask:
PUBLIC
PROC [charMask: CharMask]
RETURNS [ImagerSample.SampleMap] ~ {
size: SF.Vec ~ SF.Size[charMask.box];
WITH charMask
SELECT
FROM
raster:
REF CharMaskRep.raster =>
TRUSTED {
wordsPerLine: CARDINAL ~ (size.f+(bitsPerWord-1))/bitsPerWord;
bitmap: ImagerSample.SampleMap ~ ImagerSample.ObtainUnsafeDescriptor[
size: size,
bitsPerSample: 1,
bitsPerLine: wordsPerLine*bitsPerWord,
base: [word: RasterBits[raster], bit: 0],
ref: raster,
words: wordsPerLine*size.s,
delta: charMask.box.min
];
RETURN [bitmap]
};
ENDCASE => {
bitmap: ImagerSample.SampleMap ~ ImagerSample.NewSampleMap[box: charMask.box, bitsPerSample: 1];
boxGenerator:
-- SF.BoxGenerator --
PROC [boxAction:
SF.BoxAction] ~ {
BoxesFromCharMask[charMask, boxAction, SF.zeroVec, SF.maxBox];
};
ImagerSample.Clear[bitmap];
ImagerSample.FillBoxes[map: bitmap, boxes: boxGenerator, value: 1];
RETURN [bitmap]
};
};
BoxesFromCharMask:
PUBLIC
PROC [charMask: CharMask, boxAction:
SF.BoxAction, delta:
SF.Vec, clip:
SF.Box] ~ {
WITH charMask
SELECT
FROM
raster:
REF CharMaskRep.raster =>
TRUSTED {
size: SF.Vec ~ SF.Size[charMask.box];
wordsPerLine: CARDINAL ~ (size.f+(bitsPerWord-1))/bitsPerWord;
bitmap: ImagerSample.SampleMap ~ ImagerSample.ObtainUnsafeDescriptor[
size: size,
bitsPerSample: 1,
bitsPerLine: wordsPerLine*bitsPerWord,
base: [word: RasterBits[raster], bit: 0],
ref: raster,
words: wordsPerLine*size.s,
delta: SF.Add[charMask.box.min, delta]
];
clipped: ImagerSample.SampleMap ~ ImagerSample.Clip[bitmap, clip];
ImagerSample.BoxesFromBitmap[clipped, boxAction];
ImagerSample.ReleaseDescriptor[bitmap];
ImagerSample.ReleaseDescriptor[clipped];
};
runGroup:
REF CharMaskRep.runs => {
s0: INTEGER ~ INT[delta.s]+charMask.box.min.s;
f0: INTEGER ~ INT[delta.f]+charMask.box.min.f;
s: INTEGER ¬ s0;
FOR i:
NAT
IN [0..runGroup.nRuns)
WHILE s < clip.max.s
DO
r: ImagerMaskCache.Run ~ runGroup[i];
IF s >= clip.min.s
THEN {
fMin: INTEGER ~ MAX[NAT[r.fMin]+f0, clip.min.f];
fMax: INTEGER ~ MIN[NAT[r.fMin+r.fSize]+f0, clip.max.f];
IF fMax > fMin THEN boxAction[[min: [s, fMin], max: [s+1, fMax]]];
};
IF r.lastRun THEN s ¬ s + 1;
ENDLOOP;
};
ENDCASE => NULL;
};
RasterCharMaskFromManhattan:
PUBLIC
PROC [p: ImagerManhattan.Polygon, bb:
SF.Box]
RETURNS [
REF CharMaskRep.raster] ~ {
rast: CARD ~ CARDINAL[SF.SizeF[bb]+(bitsPerWord-1)]/bitsPerWord;
bitmapWords: INT ~ SF.SizeS[bb]*rast;
IF bitmapWords > 32000
THEN RETURN [NIL]
ELSE
TRUSTED {
mask: REF CharMaskRep.raster ¬ NEW[CharMaskRep.raster[NAT[bitmapWords]]];
bits: SampleMap ~ ImagerSample.ObtainUnsafeDescriptor[size: SF.Size[bb],
bitsPerSample: 1, bitsPerLine: rast*bitsPerWord,
base: [word: RasterBits[mask], bit: 0], ref: mask, words: bitmapWords, delta: bb.min];
mask.box ¬ bb;
WHILE p #
NIL
DO
ImagerSample.Fill[bits, p.first, 1];
p ¬ p.rest;
ENDLOOP;
ImagerSample.ReleaseDescriptor[bits];
RETURN [mask];
};
};
RasterCharMaskFromSampleMap:
PUBLIC
PROC [map: ImagerSample.SampleMap]
RETURNS [
REF CharMaskRep.raster] ~ {
bb: SF.Box ~ ImagerSample.GetBox[map];
rast: CARD ~ CARDINAL[SF.SizeF[bb]+(bitsPerWord-1)]/bitsPerWord;
bitmapWords: INT ~ SF.SizeS[bb]*CARD[rast];
IF bitmapWords > 32000
THEN RETURN [NIL]
ELSE
TRUSTED {
mask: REF CharMaskRep.raster ¬ NEW[CharMaskRep.raster[NAT[bitmapWords]]];
bits: SampleMap ~ ImagerSample.ObtainUnsafeDescriptor[size: SF.Size[bb],
bitsPerSample: 1, bitsPerLine: rast*bitsPerWord,
base: [word: RasterBits[mask], bit: 0], ref: mask, words: bitmapWords, delta: bb.min];
mask.box ¬ bb;
FOR s: INTEGER IN [bb.min.s..bb.max.s) DO
ImagerSample.BasicTransfer[dst: bits, src: map, dstMin: [s, bb.min.f], srcMin: [s, bb.min.f], size: [1, bb.max.f-bb.min.f]];
ENDLOOP;
ImagerSample.BasicTransfer[dst: bits, src: map, dstMin: bb.min, srcMin: bb.min, size: SF.Size[bb]];
ImagerSample.ReleaseDescriptor[bits];
RETURN [mask];
};
};
RunsCharMaskFromManhattan:
PUBLIC
PROC [p: ImagerManhattan.Polygon, bb:
SF.Box, nRuns:
INT]
RETURNS [mask:
REF CharMaskRep.runs] ~ {
i: NAT ¬ 0;
s: NAT ¬ 0;
AppendRun:
PROC [box:
SF.Box] ~ {
check: [1..1] ~ SF.SizeS[box];
smin: NAT ~ box.min.s-bb.min.s;
fmin: NAT ~ box.min.f-bb.min.f;
IF smin # s
THEN {
mask[i-1].lastRun ¬ TRUE;
s ¬ s + 1;
WHILE smin > s
DO
mask[i] ¬ [fMin: 0, lastRun: TRUE, fSize: 0];
i ¬ i + 1;
s ¬ s + 1;
ENDLOOP;
};
mask[i] ¬ [fMin: fmin, lastRun: FALSE, fSize: SF.SizeF[box]];
i ¬ i + 1;
};
IF nRuns = 0 OR nRuns > 4000 THEN RETURN [NIL];
mask ¬ NEW[CharMaskRep.runs[nRuns]];
mask.box ¬ bb;
ImagerManhattan.Map[polygon: p, boxAction: AppendRun, runs: TRUE];
IF i#nRuns THEN ERROR;
IF CARDINAL[s]+1 # SF.SizeS[mask.box] THEN ERROR;
mask[i-1].lastRun ¬ TRUE;
};
CountRuns:
PUBLIC
PROC [p: ImagerManhattan.Polygon]
RETURNS [runs:
INT ¬ 0] ~ {
This version includes zero-length runs needed to get the PD run representation to work.
s: INTEGER ¬ IF p # NIL THEN p.first.min.s ELSE 0;
WHILE p #
NIL
DO
sMin: INTEGER ~ p.first.min.s;
sSize: NAT ~ SF.SizeS[p.first];
IF sMin > s THEN {runs ¬ runs + (sMin - s)};
s ¬ sMin + sSize;
runs ¬ runs + sSize;
p ¬ p.rest;
ENDLOOP;
};
MaskCache: TYPE ~ REF MaskCacheRep;
MaskCacheRep:
PUBLIC
TYPE ~
MONITORED
RECORD [
parameters: Parameters,
smallCache: SmallCache,
smallCacheInUse: BOOL,
smallCacheFail: CARDINAL,
gen: ARRAY [0..1] OF Generation
];
Generation: TYPE ~ REF GenerationRep;
GenerationRep:
TYPE ~
RECORD [
size: NAT,
seq: SEQUENCE maxSize: CARDINAL OF CharMask
];
nullCharMask: CharMask ~ RasterCharMaskFromManhattan[p:
NIL, bb: [[0,0], [0,0]]];
Used to overwrite slots in the old generation.
emptyGeneration: Generation ~ NewGeneration[0];
Will actually have one slot, but we will not use it, as this is only a placeholder for the old generation.
NewGeneration:
PROC [sizeLimit:
CARDINAL]
RETURNS [g: Generation] = {
g ¬ NEW[GenerationRep[ImagerSys.GoodModulus[sizeLimit]]];
g.size ¬ 0;
};
Create:
PUBLIC
PROC [param: ParametersRep]
RETURNS [new: MaskCache] ~ {
maxSize: CARDINAL ¬ 1;
lgMaxSize: NAT ¬ 0;
parameters: Parameters ¬ NEW[ParametersRep ¬ param];
new ¬ NEW[MaskCacheRep];
new.smallCache ¬ NEW[ARRAY [0..smallCacheSize) OF REF CharMaskRep.raster ¬ ALL[NIL]];
new.smallCacheInUse ¬ FALSE;
new.smallCacheFail ¬ 0;
new.parameters ¬ parameters;
new.gen[0] ¬ NewGeneration[parameters.sizeLimit];
new.gen[1] ¬ emptyGeneration;
};
Occupancy:
ENTRY
PROC [x: MaskCache]
RETURNS [lst:
LIST
OF
REF
TEXT ¬
NIL] ~ {
This is for verifying that the hash functions are well-behaved.
Call from the debugger.
FOR i:
NAT
DECREASING
IN [0..2)
DO
gen: Generation ~ x.gen[i];
text: REF TEXT ~ NEW[TEXT[gen.maxSize]];
FOR i:
NAT
IN [0..gen.maxSize)
DO
text[i] ¬
SELECT gen[i]
FROM
nullCharMask => 'X,
NIL => '-,
ENDCASE => '#;
ENDLOOP;
text.length ¬ gen.maxSize;
lst ¬ CONS[text, lst];
ENDLOOP;
};
Size:
PUBLIC
ENTRY
PROC [x: MaskCache]
RETURNS [
NAT] ~ {
RETURN [x.gen[0].size+x.gen[1].size]
};
Fetch:
PUBLIC
ENTRY
PROC [x: MaskCache, font:
REF, char: XChar]
RETURNS [CharMask] ~
TRUSTED {
c: CharMask ¬ FetchInternal[gen: x.gen[0], font: font, char: char, remove: FALSE];
IF c =
NIL
THEN {
c ¬ FetchInternal[gen: x.gen[1], font: font, char: char, remove: TRUE];
IF c #
NIL
THEN {
IF
NOT StoreInternal[gen: x.gen[0], charMask: c]
THEN {
Dillon[x]; -- time for a new generation
[] ¬ StoreInternal[gen: x.gen[0], charMask: c]; -- Should succeed
};
};
};
RETURN [c];
};
CharAndFont:
TYPE ~
MACHINE
DEPENDENT
RECORD [char: XChar, font:
REF];
HashCharAndFont:
PROC [char: XChar, font:
REF, mod:
CARDINAL]
RETURNS [
CARDINAL] ~ {
cf: CharAndFont ¬ [char: char, font: font];
TRUSTED { RETURN[ImagerSys.RawHash[[base: LOOPHOLE[@cf], startIndex: 0, count: SIZE[CharAndFont]*BYTES[UNIT]], mod]] };
};
FetchInternal:
INTERNAL
PROC [gen: Generation, font:
REF, char: XChar, remove:
BOOL ¬
FALSE]
RETURNS [CharMask] ~
TRUSTED {
hash: CARDINAL ¬ HashCharAndFont[char, font, gen.maxSize];
last: CARDINAL ¬ gen.maxSize-1;
c: CharMask ¬ NIL;
UNTIL (c ¬ gen[hash])=
NIL
OR (c.font=font
AND c.char=char)
DO
IF hash#0
THEN hash ¬ hash-1
ELSE {
IF last = CARDINAL.LAST THEN RETURN [NIL]; -- rare because of load factor limit
hash ¬ last;
last ¬ CARDINAL.LAST; -- stopper
};
ENDLOOP;
IF remove
AND c #
NIL
THEN {
gen[hash] ¬ nullCharMask;
gen.size ¬ gen.size - 1;
};
RETURN [c];
};
GetParameters:
PUBLIC
PROC [x: MaskCache]
RETURNS [Parameters] ~ {
RETURN [x.parameters]
};
UpdateParameters:
PUBLIC
ENTRY
PROC [x: MaskCache, action:
PROC [Parameters]] ~ {
ENABLE UNWIND => NULL;
action[x.parameters];
};
Store:
PUBLIC
ENTRY
PROC [x: MaskCache, charMask: CharMask] ~
TRUSTED {
IF
NOT StoreInternal[gen: x.gen[0], charMask: charMask]
THEN {
Dillon[x]; -- time for a new generation
[] ¬ StoreInternal[gen: x.gen[0], charMask: charMask]; -- Should succeed
};
};
StoreInternal:
INTERNAL
PROC [gen: Generation, charMask: CharMask]
RETURNS [
BOOL] ~
TRUSTED {
hash: CARDINAL ¬ HashCharAndFont[charMask.char, charMask.font, gen.maxSize];
last: CARDINAL ¬ gen.maxSize-1;
c: CharMask ¬ NIL;
IF gen.size > gen.maxSize - (gen.maxSize)/4 THEN RETURN [FALSE]; -- 75% load factor
UNTIL (c ¬ gen[hash]) =
NIL
OR (c.font=charMask.font
AND c.char=charMask.char)
DO
IF hash#0
THEN hash ¬ hash-1
ELSE {
IF last = CARDINAL.LAST THEN RETURN [FALSE]; -- rare because of load factor limit
hash ¬ last;
last ¬ CARDINAL.LAST; -- stopper
};
ENDLOOP;
IF c = NIL THEN { gen.size ¬ gen.size + 1 };
gen[hash] ¬ charMask;
RETURN [TRUE]
};
discardRate: REAL ¬ 0.10; -- When fewer than this fraction of the entries get discarded,
growthFactor:
REAL ¬ 1.2;
-- grow the table by this much.
Dillon:
INTERNAL
PROC [x: MaskCache] ~ {
newSize: CARDINAL ~ IF x.gen[1].size < (x.gen[1].maxSize * discardRate) THEN CARDINAL[Real.Ceiling[x.gen[0].maxSize * growthFactor]] ELSE x.parameters.sizeLimit;
EraseInternal[x.gen[1]];
x.gen[1] ¬ x.gen[0];
x.gen[0] ¬ NewGeneration[newSize];
};
EraseInternal:
INTERNAL
PROC [gen: Generation] ~ {
FOR i: INT IN [0..gen.maxSize) DO gen[i] ¬ NIL ENDLOOP;
gen.size ¬ 0;
};
Launder:
PUBLIC
PROC [x: MaskCache, keep:
PROC [CharMask]
RETURNS [
BOOL]] ~ {
list: LIST OF CharMask ¬ GetList[x];
Flush[x];
WHILE list #
NIL
DO
this: CharMask ¬ list.first;
next: LIST OF CharMask ¬ list.rest;
list.first ¬ NIL;
list.rest ¬ NIL;
list ¬ next;
IF keep[this] THEN Store[x, this];
ENDLOOP;
};
Flush:
PUBLIC
ENTRY
PROC [x: MaskCache] ~ {
IF x.smallCache #
NIL
AND NOT x.smallCacheInUse
THEN { x.smallCache ¬ ALL[NIL] }
ELSE {
The small cache is busy! Drop it and make a new one.
x.smallCacheInUse ¬ FALSE;
x.smallCache ¬ NEW[ARRAY [0..smallCacheSize) OF REF CharMaskRep.raster ¬ ALL[NIL]];
x.smallCacheFail ¬ 0;
};
EraseInternal[x.gen[0]];
EraseInternal[x.gen[1]];
x.gen[1] ¬ emptyGeneration;
IF
NOT x.parameters.sizeLimit
IN (x.gen[0].maxSize/2 .. x.gen[0].maxSize]
THEN {
x.gen[0] ¬ NewGeneration[x.parameters.sizeLimit];
};
};
GetList:
PUBLIC
ENTRY
PROC [x: MaskCache]
RETURNS [list:
LIST
OF CharMask ¬
NIL] ~ {
FOR g: [0..1]
IN [0..1]
DO
gen: Generation ~ x.gen[g];
FOR i:
INT
IN [0..gen.maxSize)
DO
c: CharMask ¬ gen[i];
IF c # NIL AND c # nullCharMask THEN list ¬ CONS[c, list];
ENDLOOP;
ENDLOOP;
};
GetNamedCache:
PUBLIC
PROC [atom:
ATOM]
RETURNS [r: MaskCache] ~ {
r ¬ NARROW[RefTab.Fetch[cacheTab, atom].val];
IF r =
NIL
THEN {
r ¬ Create[[]];
[] ¬ RefTab.Store[cacheTab, atom, r];
};
};
SetNamedCacheParameters:
PUBLIC
PROC [atom:
ATOM, p: ParametersRep] ~ {
r: MaskCache ¬ NARROW[RefTab.Fetch[cacheTab, atom].val];
IF r =
NIL
THEN {
r ¬ Create[p];
[] ¬ RefTab.Store[cacheTab, atom, r];
}
ELSE {
Inner: ENTRY PROC [x: MaskCache] = INLINE { x.parameters ¬ p };
IF r.parameters # NIL THEN Inner[r];
};
};
cacheTab: RefTab.Ref ~ RefTab.Create[];
FlushAll:
PUBLIC
PROC [] ~ {
epa: PROC [key, val: REF] RETURNS [quit: BOOL ¬ FALSE] ~ {Flush[NARROW[val]]};
[] ¬ RefTab.Pairs[cacheTab, epa];
};
smallCacheFailLimit: CARDINAL ¬ 500;
smallCacheFailureRecoveries: CARD ¬ 0; -- statistics.
ObtainSmallCache:
PUBLIC
ENTRY
PROC [x: MaskCache]
RETURNS [SmallCache] = {
We retain the smallCache pointer so that we check that the same one comes back.
IF x.smallCacheInUse
THEN
{
x.smallCacheFail ¬ x.smallCacheFail + 1;
IF x.smallCacheFail > smallCacheFailLimit
THEN {
The small cache has had many consecutive failures, which probably means a client died while it was checked out. Allocate a new one.
x.smallCache ¬ NEW[ARRAY [0..smallCacheSize) OF REF CharMaskRep.raster ¬ ALL[NIL]];
x.smallCacheInUse ¬ FALSE;
smallCacheFailureRecoveries ¬ smallCacheFailureRecoveries + 1;
};
};
IF x.smallCacheInUse THEN RETURN [NIL];
x.smallCacheInUse ¬ TRUE;
x.smallCacheFail ¬ 0;
RETURN [x.smallCache];
};
ReleaseSmallCache:
PUBLIC
ENTRY
PROC [x: MaskCache, s: SmallCache] = {
IF x.smallCacheInUse
AND x.smallCache = s
THEN { x.smallCacheInUse ¬ FALSE }
ELSE { IF s # NIL THEN s ¬ ALL[NIL] };
};
END.