-- Bitmap cache for Chipmonk
-- last modified by McCreight, March 29, 1983 11:47 AM
-- written by McCreight, January 11, 1983 2:22 PM
-- temporarily set up for color only
DIRECTORY
BitBltDefs,
ChipOrient,
InlineDefs,
MiscDefs,
multiGraphicsDefs,
ppddefs,
ppdefs,
ppCache,
ProcessDefs,
ZoneAllocDefs;
ppCacheImpl: MONITOR
IMPORTS BitBltDefs, ChipOrient, InlineDefs, MiscDefs, multiGraphicsDefs,
ppddefs, ppdefs, ProcessDefs, ZoneAllocDefs
EXPORTS ppdefs, ppCache =
BEGIN OPEN ppdefs, ppddefs, ChipOrient;
-- T y p e s
Cache: PUBLIC TYPE = CacheHead;
CacheHeadPtr: TYPE = LONG POINTER TO CacheHead ← NIL;
CacheHead: TYPE = RECORD [
locks: CARDINAL ← 1,
biggestSave: locNum ← 0,
bsFinished: BOOLEAN ← FALSE,
firstPaint: CacheMapPtr
];
CacheMapPtr: TYPE = LONG POINTER TO CacheMap ← NIL;
CacheMap: TYPE = RECORD
[
locked: BOOLEAN ← TRUE,
ob: ppdefs.obPtr ← NIL,
descr: CacheDescr,
nextThisOb, nextLRU, prevLRU: CacheMapPtr ← NIL,
raster: RasterDesc,
bits: SEQUENCE size: CARDINAL OF CARDINAL
];
CacheDescr: TYPE = RECORD[
isColor: BOOLEAN ← FALSE,
scale: INTEGER ← 0,
orient: ppdefs.orientationIndex ← 0,
posMod: Point ← [0, 0] -- .x and .y IN [0..grayPeriod*ScaleD)
];
colBitsPerPixel: CARDINAL = 4;
logColBitsPerPixel: CARDINAL = 2;
GrayOffsetValue: TYPE = [0..15] ← 0; -- repeat period of stipples
GrayOffset: TYPE = RECORD[x, y: GrayOffsetValue];
GrayTablePtr: TYPE = LONG POINTER TO GrayTable ← NIL;
GrayTable: TYPE = ARRAY level OF multiGraphicsDefs.GrayPattern;
-- E X T E R N A L (to module monitor) P r o c e d u r e s
CachingIsEnabled: PUBLIC PROC RETURNS [BOOLEAN] =
{RETURN[enableCache]};
DisableCache: PUBLIC PROC =
BEGIN
IF enableCache THEN
BEGIN
enableCache ← FALSE;
WHILE cacheHead.nextLRU#cacheHead DO
FlushObjectCache[cacheHead.nextLRU.ob];
ENDLOOP;
-- at this point, nobody has a pointer to any cache
cacheZone ← ZoneAllocDefs.DestroyAnXMZone[cacheZone];
END;
END;
EnableCache: PUBLIC PROC =
BEGIN
IF NOT enableCache THEN
BEGIN
cacheZone ← ZoneAllocDefs.GetAnXMZone[];
cacheHead ← cacheZone.NEW[CacheMap[0]];
cacheHead.nextLRU ← cacheHead.prevLRU ← cacheHead;
colCacheGrayTables ← cacheZone.NEW[ARRAY [0..4) OF GrayTable];
enableCache ← TRUE;
END;
END;
FlushEntireCache: PUBLIC PROC =
{IF enableCache THEN {DisableCache[]; EnableCache[]}};
DrawWithCaching: PUBLIC PROC [ob: obPtr, orient: orientationIndex, x, y: locNum,
pr: POINTER TO drRecord, dest: Raster] =
BEGIN
OrWithCaching[ob: ob, orient: orient, x: x, y: y, pr: pr, dest: dest];
SaveWithCaching[ob: ob, orient: orient, x: x, y: y, pr: pr, dest: dest];
END;
overflowMentioned: BOOLEAN ← FALSE;
OrWithCaching: PROC [ob: obPtr, orient: orientationIndex, x, y: locNum,
pr: POINTER TO drRecord, dest: Raster, inhibitRoot: BOOLEAN ← FALSE] =
BEGIN OPEN multiGraphicsDefs;
CachedColorOr: PROC [ob: obPtr, orient: orientationIndex, x, y: locNum,
pr: POINTER TO drRecord] RETURNS [drawn: BOOLEAN] =
BEGIN -- assumes already clipped
OrColorGray: PROC [x1, y1, x2, y2: locNum, l: level, pr: POINTER TO Rect] =
BEGIN OPEN InlineDefs;
BitBltGrayPtr: TYPE = LONG POINTER TO ARRAY [0..4) OF CARDINAL;
IF NOT showColorLevel[l] THEN RETURN;
BLT.blk.sourcetype ← gray;
BLT.blk.dlbca ← c.raster.map;
BLT.blk.dbmr ← c.raster.scanLineWords;
BLT.blk.dlx ← BITSHIFT[
cscaleDelta[start: c.descr.posMod.x, delta: x1], logColBitsPerPixel];
BLT.blk.dty ← cscaleDelta[start: c.descr.posMod.y, delta: y1];
BLT.blk.dw ← MAX[colBitsPerPixel, BITSHIFT[
cscaleDelta[start: c.descr.posMod.x, delta: x2], logColBitsPerPixel]-
BLT.blk.dlx];
BLT.blk.dh ← MAX[1, cscaleDelta[start: c.descr.posMod.y, delta: y2]-BLT.blk.dty];
LOOPHOLE[LONG[@BLT.blk.gray0], BitBltGrayPtr]↑ ← LOOPHOLE[@grayTable[l]
[InlineDefs.BITAND[c.descr.posMod.y/cScaleD+BLT.blk.dty, 3]], BitBltGrayPtr]↑;
IF compileChecks THEN
BEGIN
IF BLT.blk.dlx+BLT.blk.dw>CARDINAL[c.raster.nPixels.x] THEN
BEGIN
IF NOT overflowMentioned THEN
BEGIN
overflowMentioned ← TRUE;
MiscDefs.CallDebugger["Raster bounds fault, OK to proceed"];
END;
BLT.blk.dw ← MAX[0, c.raster.nPixels.x-INTEGER[BLT.blk.dlx]];
END;
IF BLT.blk.dty+BLT.blk.dh>CARDINAL[c.raster.nPixels.y] THEN
BEGIN
IF NOT overflowMentioned THEN
BEGIN
overflowMentioned ← TRUE;
MiscDefs.CallDebugger["Raster bounds fault, OK to proceed"];
END;
BLT.blk.dh ← MAX[0, c.raster.nPixels.y-INTEGER[BLT.blk.dty]];
END;
END;
BitBltDefs.BITBLT[@BLT.blk];
END; -- of OrColorGray
c: CacheMapPtr;
grayTable: GrayTablePtr;
h: CacheHeadPtr;
size: Point = Size[size: [ob.size[0]+2*wellSurround, ob.size[1]+2*wellSurround],
orient: orient];
sx: LONG INTEGER = cscale[size.x];
sy: LONG INTEGER = cscale[size.y];
descr: CacheDescr;
IF MAX[sx, sy] > 2*MAX[colHeight, colWidth] OR
sx*sy > maxColPixelsPerCacheMap OR
(inhibitRoot AND ob=rootOb) THEN RETURN[FALSE];
h ← SetupCacheHead[ob]; -- locks h
descr ← [
isColor: TRUE,
scale: cScale,
orient: orient,
posMod: [x: Mod[cxoff+x, colGrayOffset.x*cScaleD],
y: Mod[cyoff+y, colGrayOffset.y*cScaleD]]];
FOR c ← h.firstPaint, c.nextThisOb WHILE c#NIL DO
IF c.descr=descr THEN {MostRecentlyUsed[c]; EXIT};
REPEAT
FINISHED =>
BEGIN -- make up a bitmap for this object
size: Point = Size[size: [ob.size[0]+2*wellSurround, ob.size[1]+2*wellSurround],
orient: orient];
rasterSize: PixelPoint = IF descr.isColor
THEN [x: colBitsPerPixel*(cscaleDelta[start: descr.posMod.x, delta: size.x]+1),
y: cscaleDelta[start: descr.posMod.y, delta: size.y]+1]
ELSE [x: cscaleDelta[start: descr.posMod.x, delta: size.x]+1,
y: cscaleDelta[start: descr.posMod.y, delta: size.y]+1];
IF (c ← NewCacheMap[rasterSize])#NIL THEN
BEGIN
drR: drRecord ← pr↑;
grayTable ← @colCacheGrayTables[c.descr.posMod.x/cScaleD];
drR.r ← drR.bigr ← [x1: 0, y1: 0, x2: size.x, y2: size.y];
c.ob ← ob;
c.descr ← descr;
NewMapUsed[c];
drR.orArea ← OrColorGray;
OrWithCaching[ob: c.ob, orient: c.descr.orient, x: wellSurround,
y: wellSurround, pr: @drR, dest: @c.raster, inhibitRoot: TRUE
! UNWIND => UnlockCacheMap[c]];
END
ELSE {UnlockCacheHead[h]; RETURN[FALSE]};
END;
ENDLOOP;
OrCachedBitmap[dest: dest, source: @c.raster,
offset: [x: colBitsPerPixel*cscale[x-wellSurround], y: cscale[y-wellSurround]]];
-- paint the source raster c at location x y in the raster dest
UnlockCacheMap[c];
RETURN[TRUE];
END; -- of CachedColorOr
rootOb: obPtr = ob;
dr: drRecord ← [
r: pr.r, bigr: pr.bigr,
orArea: pr.orArea, saveArea: NullSave, outl: NullOutl, dtxt: NullText,
minSize: pr.minSize,
quickDraw: (SELECT TRUE FROM
NOT enableCache, permittedCacheK<=0 => NIL,
pr.orArea=orColArea AND cScale<=9 => CachedColorOr,
ENDCASE => NIL)];
ob.p.drawme[orient][ob: rootOb, x: x, y: y, pr: @dr];
END; -- of OrWithCaching
SaveWithCaching: PROC [ob: obPtr, orient: orientationIndex, x, y: locNum,
pr: POINTER TO drRecord, dest: Raster, inhibitRoot: BOOLEAN ← FALSE] =
BEGIN
CachedColorSave: PROC [ob: obPtr, orient: orientationIndex, x, y: locNum,
pr: POINTER TO drRecord] RETURNS [drawn: BOOLEAN] =
BEGIN -- assumes already clipped
h: CacheHeadPtr = ob.cache;
RETURN[drawn: h#NIL AND h.bsFinished AND cscale[h.biggestSave]<2];
END; -- of CachedColorSave
rootOb: obPtr = ob;
dr: drRecord ← [
r: pr.r, bigr: pr.bigr,
orArea: NullOr, saveArea: pr.saveArea, outl: NullOutl, dtxt: NullText,
minSize: pr.minSize,
quickDraw: (SELECT TRUE FROM
NOT enableCache, permittedCacheK<=0 => NIL,
pr.orArea=orColArea AND cScale<=9 => CachedColorSave,
ENDCASE => NIL)];
ob.p.drawme[orient][ob: ob, x: x, y: y, pr: @dr];
END;
SetupCacheGrayTables: PUBLIC PROC [] = -- called when color map changes
BEGIN OPEN multiGraphicsDefs;
IF enableCache THEN
BEGIN
xOffset, yOffset: GrayOffsetValue;
colGrayOffset ← [1, 1]; -- find the shortest repeat pattern of all colors in use
FOR l: level IN level DO
colGray: GrayPattern = GetColorGray[orLtab[l]];
FOR xOffset IN [1..4] DO
FOR i: GrayPatternIndex IN GrayPatternIndex DO
IF colGray[i] # Cycle[colGray[i], xOffset] THEN EXIT;
REPEAT
FINISHED => EXIT;
ENDLOOP;
ENDLOOP;
colGrayOffset.x ← LCM[colGrayOffset.x, xOffset];
FOR yOffset IN [1..4] DO
FOR i: GrayPatternIndex IN GrayPatternIndex DO
IF colGray[i] # colGray[(i+yOffset) MOD 4] THEN EXIT;
REPEAT
FINISHED => EXIT;
ENDLOOP;
ENDLOOP;
colGrayOffset.y ← LCM[colGrayOffset.y, yOffset];
ENDLOOP;
FOR l: level IN level DO
colGray: GrayPattern = GetColorGray[orLtab[l]];
FOR xOffset IN [0..colGrayOffset.x) DO
FOR i: GrayPatternIndex IN GrayPatternIndex DO
colCacheGrayTables[xOffset][l][i] ←
Cycle[colGray[i], xOffset*colBitsPerPixel];
ENDLOOP;
ENDLOOP;
ENDLOOP;
END;
END;
OrCachedBitmap: PROC [source, dest: Raster, offset: PixelPoint] =
BEGIN
sourceR: PixelRect =
[x1: offset.x, y1: offset.y,
x2: offset.x+source.nPixels.x-1, y2: offset.y+source.nPixels.y-1];
destR: PixelRect = [x1: 0, y1: 0, x2: dest.nPixels.x-1, y2: dest.nPixels.y-1];
resultR: PixelRect = ClipRect[sourceR, destR];
IF Empty[resultR] THEN RETURN;
BLT.blk.sourcetype ← block;
BLT.blk.dlbca ← dest.map;
BLT.blk.dbmr ← dest.scanLineWords;
BLT.blk.slbca ← source.map;
BLT.blk.sbmr ← source.scanLineWords;
BLT.blk.dw ← resultR.x2-resultR.x1+1;
BLT.blk.dh ← resultR.y2-resultR.y1+1;
BLT.blk.dlx ← resultR.x1;
BLT.blk.dty ← resultR.y1;
BLT.blk.slx ← resultR.x1-offset.x;
BLT.blk.sty ← resultR.y1-offset.y;
BitBltDefs.BITBLT[@BLT.blk];
END;
SetupCacheHead: PROC [rootOb: obPtr] RETURNS [hRoot: CacheHeadPtr] =
BEGIN
IF MakeCacheHead[rootOb].new THEN
BEGIN
QuickSaveProc: PROC [ob: obPtr, orient: orientationIndex,
x, y: locNum, pr: POINTER TO drRecord] RETURNS [drawn: BOOLEAN] =
BEGIN
h: CacheHeadPtr;
IF ob = rootOb THEN RETURN[FALSE]
ELSE
BEGIN
h ← SetupCacheHead[ob];
hRoot.biggestSave ← MAX[hRoot.biggestSave, h.biggestSave];
h.locks ← h.locks-1;
RETURN[TRUE];
END;
END;
SaveRectProc: PROC [x1, y1, x2, y2: locNum, l: level, pr: POINTER TO Rect] =
{hRoot.biggestSave ← MAX[hRoot.biggestSave, x2-x1, y2-y1]};
dr: drRecord ← [
r: univ, bigr: univ,
orArea: NullOr, saveArea: SaveRectProc, outl: NullOutl, dtxt: NullText,
minSize: 1, quickDraw: QuickSaveProc];
hRoot ← rootOb.cache;
hRoot.biggestSave ← 0;
rootOb.p.drawme[0][ob: rootOb, x: 0, y: 0, pr: @dr];
hRoot.bsFinished ← TRUE;
END
ELSE hRoot ← rootOb.cache;
END; -- of SetupCacheHead
NullOr, NullSave: PROC [x1, x2, y1, y2: locNum, l: level, pr: POINTER TO Rect] =
{NULL};
NullOutl: PROC [x1, x2, y1, y2: locNum, c: color, pr: POINTER TO Rect] = {NULL};
NullText: PROC [x1, x2, y1, y2: locNum, s: STRING, pr: POINTER TO Rect] = {NULL};
cscaleDelta: PROC [start, delta: locNum] RETURNS [Pixel] = INLINE
{RETURN[cscale[start+delta]-cscale[start]]};
cscale: PROC [x: locNum] RETURNS [Pixel] = INLINE
{RETURN[NarrowToInteger[LONG[cScaleN]*x]/cScaleD]};
Cycle: PROC [value: UNSPECIFIED, count: INTEGER] RETURNS [UNSPECIFIED] = INLINE
BEGIN OPEN InlineDefs;
count ← Mod[count, 16]; -- mask to 4 bits
RETURN[BITSHIFT[value, count]+BITSHIFT[value, count-16]];
END;
NarrowToInteger: PROC [x: LONG INTEGER] RETURNS [INTEGER] = INLINE
{IF x<FIRST[INTEGER] OR x>LAST[INTEGER] THEN ERROR OutOfRange
ELSE RETURN[InlineDefs.LowHalf[x]]};
GCD: PROC [m,n: INTEGER] RETURNS [INTEGER] =
BEGIN -- greatest common divisor
r: INTEGER;
WHILE (r ← m MOD n) > 0 DO
m ← n;
n ← r;
ENDLOOP;
RETURN[n];
END;
LCM: PROC [m,n: INTEGER] RETURNS [INTEGER] =
-- least common multiple
{RETURN[m*(n/GCD[m, n])]};
-- E N T R Y P r o c e d u r e s
FlushObjectCache: PUBLIC ENTRY PROC [ob: obPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
WHILE ob.cache#NIL DO
h: CacheHeadPtr = ob.cache;
IF h.firstPaint#NIL THEN FreeCacheMap[h.firstPaint]
ELSE
BEGIN
waitingProcesses ← waitingProcesses+1;
WHILE h.locks>0 DO WAIT UnlockedCache ENDLOOP;
waitingProcesses ← waitingProcesses-1;
IF ob.cache#NIL THEN
BEGIN
cacheZone.FREE[@ob.cache];
ob.cache ← NIL;
END; -- ELSE somebody else freed it while we were waiting
END;
ENDLOOP;
END;
MostRecentlyUsed: ENTRY PROC [c: CacheMapPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
ExtractLRU[c];
InsertLRU[c];
END;
NewMapUsed: ENTRY PROC [c: CacheMapPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
h: CacheHeadPtr ← c.ob.cache;
c.nextThisOb ← h.firstPaint;
h.firstPaint ← c;
h.locks ← h.locks+1;
InsertLRU[c];
END;
MakeCacheHead: ENTRY PROC [ob: obPtr] RETURNS [new: BOOLEAN] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
h: CacheHeadPtr = ob.cache;
IF h = NIL THEN
BEGIN
ob.cache ← cacheZone.NEW[CacheHead ← []];
RETURN[TRUE];
END
ELSE {h.locks ← h.locks+1; RETURN[FALSE]};
END;
NewCacheMap: ENTRY PROC [rasterSize: PixelPoint] RETURNS [c: CacheMapPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
scanWidthInWords: INTEGER = (rasterSize.x+15)/16;
bitMapSize: INTEGER = NarrowToInteger[
LONG[scanWidthInWords]*LONG[rasterSize.y]];
IF bitMapSize<=0 THEN ERROR;
IF NOT FlushLRUVictims[SIZE[CacheMap[bitMapSize]]].sufficientSpace THEN
RETURN[NIL];
c ← cacheZone.NEW[CacheMap[bitMapSize] ←
[locked: TRUE,
raster: [nPixels: rasterSize,
scanLineWords: scanWidthInWords, map: NULL],
bits: NULL]];
c.raster.map ← LOOPHOLE[@c.bits[0]];
c.bits[0] ← 0; -- turn it to background color of 0
IF bitMapSize>1 THEN
InlineDefs.LongCOPY[from: @c.bits[0], to: @c.bits[1], nwords: bitMapSize-1];
END;
UnlockCacheMap: ENTRY PROC [c: CacheMapPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
h: CacheHeadPtr = c.ob.cache;
c.locked ← FALSE;
h.locks ← h.locks-1; -- also unlocks head
IF waitingProcesses>0 THEN BROADCAST UnlockedCache;
END;
UnlockCacheHead: ENTRY PROC [h: CacheHeadPtr] =
BEGIN ENABLE ANY => MiscDefs.CallDebugger["Signalling out of monitor"];
h.locks ← h.locks-1;
IF h.locks=0 AND waitingProcesses>0 THEN BROADCAST UnlockedCache;
END;
-- I N T E R N A L P r o c e d u r e s
FlushLRUVictims: INTERNAL PROC [wordsNeeded: LONG INTEGER] RETURNS
[sufficientSpace: BOOLEAN] =
BEGIN
rover: CacheMapPtr ← cacheHead.prevLRU;
WHILE ZoneAllocDefs.XMZoneWordsInUse[cacheZone]+wordsNeeded >
LONG[permittedCacheK]*1000 AND rover#cacheHead DO
c: CacheMapPtr = rover;
rover ← rover.prevLRU;
IF NOT rover.locked THEN FreeCacheMap[c];
ENDLOOP;
RETURN[ZoneAllocDefs.XMZoneWordsInUse[cacheZone]+wordsNeeded <=
LONG[permittedCacheK]*1000];
END;
FreeCacheMap: INTERNAL PROC [c: CacheMapPtr] =
BEGIN
ob: obPtr;
h: CacheHeadPtr;
waitingProcesses ← waitingProcesses+1;
WHILE c.locked DO WAIT UnlockedCache ENDLOOP;
waitingProcesses ← waitingProcesses-1;
ob ← c.ob;
h ← ob.cache;
IF h.firstPaint=c THEN h.firstPaint ← c.nextThisOb
ELSE
FOR pc: CacheMapPtr ← h.firstPaint, pc.nextThisOb WHILE pc.nextThisOb#c DO
REPEAT
FINISHED => pc.nextThisOb ← c.nextThisOb;
ENDLOOP;
ExtractLRU[c];
cacheZone.FREE[@c];
h.locks ← h.locks-1;
END;
ExtractLRU: INTERNAL PROC [c: CacheMapPtr] = INLINE
BEGIN
c.nextLRU.prevLRU ← c.prevLRU;
c.prevLRU.nextLRU ← c.nextLRU;
END;
InsertLRU: INTERNAL PROC [c: CacheMapPtr] = INLINE
BEGIN
c.nextLRU ← cacheHead.nextLRU;
c.prevLRU ← cacheHead;
cacheHead.nextLRU.prevLRU ← c;
cacheHead.nextLRU ← c;
c.locked ← TRUE;
END;
-- S i g n a l s & C o n d i t i o n s
OutOfRange: ERROR = CODE;
UnlockedCache: CONDITION;
-- M o d u l e I n i t i a l i z a t i o n
enableCache: BOOLEAN ← FALSE;
cacheZone: UNCOUNTED ZONE ← NIL;
cacheHead: CacheMapPtr ← NIL;
waitingProcesses: CARDINAL ← 0;
colCacheGrayTables: LONG POINTER TO ARRAY [0..4) OF GrayTable ← NIL;
BLT: multiGraphicsDefs.BLTBlockPtr ← multiGraphicsDefs.AllocateBLT[];
colGrayOffset: GrayOffset ← [x: 1, y: 1];
permittedCacheK: PUBLIC INTEGER ← 100;
maxColPixelsPerCacheMap: PUBLIC LONG INTEGER ← 20000;
maxBWPixelsPerCacheMap: PUBLIC LONG INTEGER ← 40000;
BLT.blk.destalt ← FALSE;
BLT.blk.sty ← 0; --DORADO looks here
BLT.blk.function ← paint;
ProcessDefs.InitializeCondition[@UnlockedCache, ProcessDefs.MsecToTicks[2000]];
EnableCache[];
END.