~
BEGIN
bitsPerWord: NAT ~ Basics.bitsPerWord;
Buffer: TYPE ~ SampleMapOps.Buffer;
BufferRep: TYPE ~ SampleMapOps.BufferRep;
maxCount: NAT ~ SampleMapOps.maxCount;
CVEC: TYPE ~ SampleMapOps.CVEC;
Function: TYPE ~ SampleMapOps.Function;
nullFunction: Function ~ SampleMapOps.nullFunction;
lastCVEC: CVEC ~ SampleMapOps.lastCVEC;
logBitsPerWord: NAT ~ Basics.logBitsPerWord;
SampleMap: TYPE ~ SampleMapOps.SampleMap;
SampleMapRep: TYPE ~ SampleMapOps.SampleMapRep;
SubMap:
TYPE ~ SampleMapOps.SubMap;
MultipleReleaseOfScratch:
PUBLIC
ERROR ~
CODE;
BITAND:
PROC [a, b:
CARDINAL]
RETURNS [
CARDINAL]
~ INLINE {RETURN[Basics.BITAND[a, b]]};
Shift:
PROC [a:
CARDINAL, b:
INTEGER]
RETURNS [
CARDINAL]
~ INLINE {RETURN[Basics.BITSHIFT[a, b]]};
Check:
PROC[x:
CARDINAL, max:
NAT]
RETURNS [
NAT] ~
TRUSTED MACHINE CODE { PrincOps.zINC; PrincOps.zBNDCK };
IF x IN[0..max] THEN RETURN[x] ELSE ERROR RuntimeError.BoundsFault
IsPowerOfTwo:
PROC [c:
CARDINAL]
RETURNS [
BOOLEAN] ~
INLINE {
RETURN [BITAND[c, c-1] = 0]
};
WordCountFromBit:
PROC [bitCount:
LONG
CARDINAL]
RETURNS [
LONG
CARDINAL] ~ {
RETURN [Basics.DoubleShiftRight[[lc[bitCount+(bitsPerWord-1)]], logBitsPerWord].lc]
};
Lg:
PROC [a:
NAT]
RETURNS [lg:
NAT ← 0] ~ {
b: CARDINAL ← 1;
UNTIL b >= a
DO
lg ← lg + 1;
b ← b*2;
ENDLOOP;
};
RoundUp:
PROC [a:
NAT]
RETURNS [
NAT] ~
INLINE {
Round a bit size up to a whole number of words.
RETURN [BITAND[a+(bitsPerWord-1), CARDINAL.LAST-(bitsPerWord-1)]]
};
ComputeWords:
PUBLIC
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..bitsPerWord]]
RETURNS [
LONG
CARDINAL] ~ {
bitsPerLine: NAT ~ RoundUp[Basics.LongMult[fSize, bitsPerSample]];
RETURN [Basics.LongMult[sSize, bitsPerLine/bitsPerWord]]
};
nullBitBltTable: PrincOps.BitBltTable ~ [
dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: []
];
disjointBitBltTable: PrincOps.BitBltTable ~ [
dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: [disjoint: TRUE, disjointItems: TRUE]
];
grayBitBltTable: PrincOps.BitBltTable ~ [
dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: [disjoint: TRUE, disjointItems: TRUE, gray: TRUE]
];
UnsafeCreate:
PUBLIC
UNSAFE
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..Basics.bitsPerWord], bitsPerLine:
NAT, base: PrincOps.BitAddress, nWords:
LONG
CARDINAL, ref:
REF, scratchDescriptor: SampleMap ←
NIL]
RETURNS [SampleMap] ~ {
dataBitsPerLine: LONG CARDINAL ~ Basics.LongMult[fSize, bitsPerSample];
fillBits: NAT ~ bitsPerLine-dataBitsPerLine;
totalBits: LONG CARDINAL ~ Basics.LongMult[sSize, bitsPerLine]-fillBits+base.bit;
wrds: LONG CARDINAL ~ WordCountFromBit[totalBits];
check: BOOL[FALSE..FALSE] ~ (nWords < wrds);
s: SampleMap ~ IF scratchDescriptor#NIL THEN scratchDescriptor ELSE NEW[SampleMapRep];
s^ ← [
sSize: sSize,
fSize: fSize,
bitsPerSample: bitsPerSample,
base: base,
bitsPerLine: bitsPerLine,
ref: ref
];
RETURN [s];
};
smallSize: NAT ← 511;
WordSeqRep: TYPE ~ RECORD [SEQUENCE length: NAT OF WORD];
Create:
PUBLIC
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..Basics.bitsPerWord]]
RETURNS [SampleMap] ~ {
bitsPerLine: NAT ~ RoundUp[Basics.LongMult[fSize, bitsPerSample]];
nWords: LONG CARDINAL ~ Basics.LongMult[sSize, bitsPerLine/bitsPerWord];
IF nWords <= smallSize
THEN
TRUSTED {
words: NAT ← MAX[NAT[nWords], 1];
wordSeq: REF WordSeqRep ← NEW[WordSeqRep[words]];
RETURN [UnsafeCreate[
sSize: sSize,
fSize: fSize,
bitsPerSample: bitsPerSample,
bitsPerLine: bitsPerLine,
base: [word: @wordSeq[0], bit: 0],
nWords: words,
ref: wordSeq
]]
}
ELSE {
vm: CountedVM.Handle ~ Allocate[nWords];
RETURN [FromVM[
sSize: sSize,
fSize: fSize,
bitsPerSample: bitsPerSample,
vm: vm
]];
};
};
Allocate:
PROC [nWords:
LONG
CARDINAL]
RETURNS [vm: CountedVM.Handle ←
NIL] ~ {
nWords ← MAX[nWords, 256];
vm ← CountedVM.SimpleAllocate[nWords ! VM.CantAllocate => CONTINUE];
IF vm =
NIL
THEN {
Try flushing the global function cache to get some space back.
cache: FunctionCache.Cache ~ FunctionCache.GlobalCache[];
info: FunctionCache.CacheInfo ~ FunctionCache.GetInfo[cache];
FunctionCache.SetLimits[cache, 0, 0];
FunctionCache.SetLimits[x: cache, maxEntries: info.maxEntries, maxTotalSize: info.maxTotalSize];
ClearScratch[];
vm ← CountedVM.SimpleAllocate[nWords];
};
};
FromVM:
PUBLIC
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..Basics.bitsPerWord], vm: CountedVM.Handle]
RETURNS [SampleMap] ~
TRUSTED {
RETURN [UnsafeCreate[
sSize: sSize,
fSize: fSize,
bitsPerSample: bitsPerSample,
bitsPerLine: RoundUp[fSize*bitsPerSample],
base: [word: vm.pointer, bit: 0],
nWords: vm.words,
ref: vm
]]
};
FromSubMap:
PUBLIC
PROC [subMap: SubMap]
RETURNS [SampleMap] ~
TRUSTED {
s: SampleMap ~ NEW[SampleMapRep ← subMap.sampleMap^];
bitsPerLine: NAT ~ s.bitsPerLine;
bitsPerSample: NAT ~ s.bitsPerSample;
sMin: NAT ~ Check[subMap.start.s, s.sSize];
fMin: NAT ~ Check[subMap.start.f, s.fSize];
sSize: NAT ~ MIN[subMap.size.s, LOOPHOLE[s.sSize-sMin, NAT]];
fSize: NAT ~ MIN[subMap.size.f, LOOPHOLE[s.fSize-fMin, NAT]];
skipBits: LONG CARDINAL ~ Basics.LongMult[sMin, bitsPerLine] + Basics.LongMult[fMin, bitsPerSample] + s.base.bit;
s.sSize ← sSize;
s.fSize ← fSize;
s.base ← IndexBit[s.base.word, [lc[skipBits]]];
RETURN [s];
};
Copy:
PUBLIC
PROC [subMap: SubMap]
RETURNS [SampleMap] ~ {
s: SampleMap ~ subMap.sampleMap;
sMin: NAT ~ Check[subMap.start.s, s.sSize];
fMin: NAT ~ Check[subMap.start.f, s.fSize];
sSize: NAT ~ MIN[subMap.size.s, LOOPHOLE[s.sSize-sMin, NAT]];
fSize: NAT ~ MIN[subMap.size.f, LOOPHOLE[s.fSize-fMin, NAT]];
new: SampleMap ~ Create[sSize: sSize, fSize: fSize, bitsPerSample: s.bitsPerSample];
Transfer[dest: new, destStart: [0, 0], source: subMap, function: [null, null]];
RETURN [new];
};
nScratch: NAT ~ 5;
scratchRefs:
ARRAY [0..nScratch)
OF SampleMap ←
ALL[
NIL];
ObtainScratch:
PUBLIC
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..Basics.bitsPerWord]]
RETURNS [SampleMap] ~ {
TryObtainScratch:
ENTRY
PROC
RETURNS [SampleMap] ~
TRUSTED
INLINE {
bitsPerLine: NAT ~ RoundUp[Basics.LongMult[fSize, bitsPerSample]];
nWords: INT ~ LOOPHOLE[Basics.LongMult[sSize, bitsPerLine/bitsPerWord]];
FOR i:
NAT
IN [0..nScratch)
DO
s: SampleMap ← scratchRefs[i];
IF s #
NIL
THEN
WITH s.ref
SELECT
FROM
vm: CountedVM.Handle => {
IF vm.words >= nWords
THEN {
scratchRefs[i] ← NIL;
s.sSize ← sSize;
s.fSize ← fSize;
s.bitsPerSample ← bitsPerSample;
s.bitsPerLine ← bitsPerLine;
RETURN [s]
};
};
ENDCASE => NULL;
ENDLOOP;
RETURN [NIL]
};
s: SampleMap ← TryObtainScratch[];
IF s =
NIL
THEN {
nWords: INT ~ ComputeWords[sSize, fSize, bitsPerSample];
vm: CountedVM.Handle ~ Allocate[nWords];
s ← FromVM[sSize: sSize, fSize: fSize, bitsPerSample: bitsPerSample, vm: vm];
};
RETURN [s]
};
ReleaseScratch:
PUBLIC
ENTRY
PROC [sampleMap: SampleMap] ~ {
r: SampleMap ← sampleMap;
FOR i:
NAT
IN [0..nScratch)
UNTIL r =
NIL
DO
Push least-recently-used towards end.
t: SampleMap ← scratchRefs[i];
scratchRefs[i] ← r;
r ← t;
IF r = sampleMap THEN RETURN WITH ERROR MultipleReleaseOfScratch;
ENDLOOP;
};
ClearScratch:
ENTRY
PROC ~ {
FOR i:
NAT
IN [0..nScratch)
DO
scratchRefs[i] ← NIL;
ENDLOOP;
};
DoWithScratch:
PUBLIC
PROC [sSize:
CARDINAL, fSize:
CARDINAL, bitsPerSample: [0..Basics.bitsPerWord], action:
PROC[SampleMap]] ~ {
scratch: SampleMap ~ ObtainScratch[sSize, fSize, bitsPerSample];
action[scratch ! UNWIND => ReleaseScratch[scratch]];
ReleaseScratch[scratch];
};
Size:
PUBLIC
PROC [sampleMap: SampleMap]
RETURNS [
CVEC] ~ {
RETURN [[s: sampleMap.sSize, f: sampleMap.fSize]]};
Clear:
PUBLIC
PROC [sampleMap: SampleMap] ~
TRUSTED {
bitsPerLine: NAT ~ sampleMap.bitsPerLine;
pointer: LONG POINTER ← sampleMap.base.word;
fillBitsPerLine: NAT ~ bitsPerLine - sampleMap.bitsPerSample*sampleMap.fSize;
IF fillBitsPerLine < bitsPerWord
THEN {
Contiguous, except perhaps for some padding.
nBits: LONG CARDINAL ~ Basics.LongMult[bitsPerLine, sampleMap.sSize]+sampleMap.base.bit-fillBitsPerLine;
nWords: LONG CARDINAL ← WordCountFromBit[nBits];
WHILE nWords > 32768
DO
PrincOpsUtils.LongZero[pointer, 32768];
pointer ← pointer + 32768;
nWords ← nWords - 32768;
ENDLOOP;
PrincOpsUtils.LongZero[pointer, nWords];
}
ELSE {
Discontiguous, so do pieces (could BITBLT here; which is cheaper?)
dataBitsPlus: NAT ~ sampleMap.bitsPerSample*sampleMap.fSize + (bitsPerWord-1);
bit: CARDINAL ← sampleMap.base.bit;
FOR i:
NAT
IN [0..sampleMap.sSize)
DO
PrincOpsUtils.LongZero[where: pointer, nwords: (bit + dataBitsPlus)/bitsPerWord];
bit ← bit + bitsPerLine;
pointer ← pointer + bit/bitsPerWord;
bit ← bit MOD bitsPerWord;
ENDLOOP;
};
};
GetSample:
PUBLIC
PROC [sampleMap: SampleMap, index:
CVEC]
RETURNS [
CARDINAL] ~
TRUSTED {
s: CARDINAL ~ Basics.BoundsCheck[index.s, sampleMap.sSize];
f: CARDINAL ~ Basics.BoundsCheck[index.f, sampleMap.fSize];
bitsPerSample: NAT ~ sampleMap.bitsPerSample;
bitIndex: LONG CARDINAL ~ sampleMap.base.bit + Basics.LongMult[s, sampleMap.bitsPerLine] + Basics.LongMult[f, bitsPerSample];
bitAddress: PrincOps.BitAddress ~ IndexBit[sampleMap.base.word, [lc[bitIndex]]];
pointer: LONG POINTER TO ARRAY [0..1] OF WORD ~ bitAddress.word;
shiftAmt: INTEGER ~ bitAddress.bit + bitsPerSample - bitsPerWord;
mask: CARDINAL ~ Shift[1, bitsPerSample]-1;
shiftedBits:
CARDINAL ~
IF shiftAmt <= 0
THEN Shift[pointer^[0], shiftAmt]
ELSE Shift[pointer^[0], shiftAmt] + Shift[pointer^[1], shiftAmt-16];
RETURN [BITAND[shiftedBits, mask]]
};
PutSample:
PUBLIC
PROC [sampleMap: SampleMap, index:
CVEC, value:
CARDINAL, function: Function] ~
TRUSTED {
s: CARDINAL ~ Basics.BoundsCheck[index.s, sampleMap.sSize];
f: CARDINAL ~ Basics.BoundsCheck[index.f, sampleMap.fSize];
bitsPerSample: NAT ~ sampleMap.bitsPerSample;
bitIndex: LONG CARDINAL ~ sampleMap.base.bit + Basics.LongMult[s, sampleMap.bitsPerLine] + Basics.LongMult[f, bitsPerSample];
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bb^ ← [
dst: IndexBit[sampleMap.base.word, [lc[bitIndex]]],
dstBpl: 0,
src: [word: @value, bit: bitsPerWord-bitsPerSample],
srcDesc: [srcBpl[0]],
height: 1,
width: bitsPerSample,
flags: [direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: FALSE, srcFunc: function.srcFunc, dstFunc: function.dstFunc]
];
PrincOpsUtils.BITBLT[bb];
};
DumbTransfer:
PROC [dest: SampleMap, destStart:
CVEC, source: SubMap, function: Function] ~ {
sSize: NAT ~ MIN[source.size.s, dest.sSize-destStart.s, source.sampleMap.sSize-source.start.s];
fSize: NAT ~ MIN[source.size.f, dest.fSize-destStart.f, source.sampleMap.fSize-source.start.f];
FOR s:
NAT
IN [0..sSize)
DO
FOR f:
NAT
IN [0..fSize)
DO
sample: CARDINAL ~ GetSample[source.sampleMap, [source.start.s+s, source.start.f+f]];
PutSample[dest, [destStart.s+s, destStart.f+f], sample, function];
ENDLOOP;
ENDLOOP;
};
BitAddressOverlay:
TYPE ~
MACHINE
DEPENDENT
RECORD [
This record is to designed to avoid the need for partial-word access to the bit offset field, since the BITBLT format has carefully made this field word-aligned, and PrincOps.BitAddress has just as carefully made it hard to take advantage of this fact.
SELECT
OVERLAID *
FROM
ba => [bitAddress: PrincOps.BitAddress],
ov => [pointer: LONG POINTER, offset: CARDINAL],
ENDCASE
];
IndexBit:
UNSAFE
PROC [pointer:
LONG
POINTER, bitOffset: Basics.LongNumber]
RETURNS [PrincOps.BitAddress] ~
UNCHECKED
INLINE {
addr: BitAddressOverlay ~ [ov[
pointer: pointer + Basics.DoubleShiftRight[bitOffset, logBitsPerWord].lc,
offset: bitOffset.lo MOD bitsPerWord
]];
RETURN [addr.bitAddress]
};
Transfer:
PUBLIC
PROC [dest: SampleMap, destStart:
CVEC, source: SubMap, function: Function] ~
TRUSTED {
bps: NAT ~ dest.bitsPerSample;
src: SampleMap ~ source.sampleMap;
sSize: NAT ~ MIN[source.size.s, dest.sSize-destStart.s, source.sampleMap.sSize-source.start.s];
fSize: NAT ~ MIN[source.size.f, src.fSize-source.start.f, dest.fSize-destStart.f];
SELECT
TRUE
FROM
source.sampleMap.bitsPerSample = bps => {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
dstBitIndex:
LONG
CARDINAL ~ dest.base.bit +
Basics.LongMult[Check[destStart.s, dest.sSize], dest.bitsPerLine] +
Basics.LongMult[Check[destStart.f, dest.fSize], bps];
srcBitIndex:
LONG
CARDINAL ~ src.base.bit +
Basics.LongMult[Check[source.start.s, src.sSize], src.bitsPerLine] +
Basics.LongMult[Check[source.start.f, src.fSize], bps];
bb^ ← disjointBitBltTable;
bb.dst ← IndexBit[dest.base.word, [lc[dstBitIndex]]];
bb.dstBpl ← dest.bitsPerLine;
bb.src ← IndexBit[src.base.word, [lc[srcBitIndex]]];
bb.srcDesc ← [srcBpl[src.bitsPerLine]];
bb.height ← sSize;
bb.width ← fSize * bps;
bb.flags.srcFunc ← function.srcFunc;
bb.flags.dstFunc ← function.dstFunc;
PrincOpsUtils.BITBLT[bb];
};
ENDCASE => DumbTransfer[dest, destStart, source, function];
};
Move:
PUBLIC
PROC [sampleMap: SampleMap, destStart:
CVEC, sourceStart:
CVEC, size:
CVEC, function: Function] ~
TRUSTED {
bps: NAT ~ sampleMap.bitsPerSample;
bpl: NAT ~ sampleMap.bitsPerLine;
sSize: NAT ~ sampleMap.sSize;
fSize: NAT ~ sampleMap.fSize;
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
dstBitIndex:
LONG
CARDINAL ← sampleMap.base.bit +
Basics.LongMult[Check[destStart.s, sSize], bpl] +
Basics.LongMult[Check[destStart.f, fSize], bps];
srcBitIndex:
LONG
CARDINAL ← sampleMap.base.bit +
Basics.LongMult[Check[sourceStart.s, sSize], bpl] +
Basics.LongMult[Check[sourceStart.f, fSize], bps];
sSamples: NAT ~ MIN[size.s, sSize-sourceStart.s, sSize-destStart.s];
fSamples: NAT ~ MIN[size.f, fSize-sourceStart.f, fSize-destStart.f];
bb^ ← disjointBitBltTable;
bb.dstBpl ← bpl;
bb.srcDesc ← [srcBpl[bpl]];
bb.height ← sSamples;
bb.width ← bps * fSamples;
bb.flags.srcFunc ← function.srcFunc;
bb.flags.dstFunc ← function.dstFunc;
IF sSamples > 0
AND (sourceStart.f+fSamples) > destStart.f
AND
(destStart.f+fSamples) > sourceStart.f
AND
(sourceStart.s+sSamples) > destStart.s
AND
(destStart.s+sSamples) > sourceStart.s
THEN {
bb.flags.disjoint ← FALSE; -- the rectangles overlap
IF sourceStart.s=destStart.s THEN bb.flags.disjointItems ← FALSE; -- so do the items
IF destStart.s>sourceStart.s
OR (destStart.s=sourceStart.s
AND destStart.f>sourceStart.f)
THEN {
-- reverse direction
delta: LONG CARDINAL ← Basics.LongMult[sSamples-1, bpl];
bb.flags.direction ← backward; bb.srcDesc.srcBpl ← bb.dstBpl ← -bb.dstBpl;
dstBitIndex ← dstBitIndex + delta;
srcBitIndex ← srcBitIndex + delta;
};
};
bb.dst ← IndexBit[sampleMap.base.word, [lc[dstBitIndex]]];
bb.src ← IndexBit[sampleMap.base.word, [lc[srcBitIndex]]];
PrincOpsUtils.BITBLT[bb];
};
DumbFill:
PROC [dest: SubMap, value:
CARDINAL, function: Function] ~ {
sSize: NAT ~ MIN[dest.size.s, dest.sampleMap.sSize-dest.start.s];
fSize: NAT ~ MIN[dest.size.f, dest.sampleMap.fSize-dest.start.f];
FOR s:
NAT
IN [0..sSize)
DO
FOR f:
NAT
IN [0..fSize)
DO
PutSample[dest.sampleMap, [dest.start.s+s, dest.start.f+f], value, function];
ENDLOOP;
ENDLOOP;
};
replicator:
ARRAY [0..4]
OF
CARDINAL ~ [
0FFFFH, 05555H, 01111H, 00101H, 00001H];
Fill:
PUBLIC
PROC [dest: SubMap, value:
CARDINAL, function: Function] ~ {
bps: NAT ~ dest.sampleMap.bitsPerSample;
IF bitsPerWord
MOD bps = 0
THEN
TRUSTED {
dstBitIndex:
LONG
CARDINAL ~ dest.sampleMap.base.bit +
Basics.LongMult[Check[dest.start.s, dest.sampleMap.sSize], dest.sampleMap.bitsPerLine] +
Basics.LongMult[Check[dest.start.f, dest.sampleMap.fSize], bps];
sSize: NAT ~ MIN[dest.size.s, dest.sampleMap.sSize-dest.start.s];
fSize: NAT ~ MIN[dest.size.f, dest.sampleMap.fSize-dest.start.f];
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
replicatedPixel: CARDINAL ← BITAND[value, Shift[1, bps]-1] * replicator[Lg[bps]];
IF function = [null, complement]
THEN {
Bug in Dorado BITBLT microcode (as of December 4, 1985)
replicatedPixel ← CARDINAL.LAST-replicatedPixel;
function ← [null, null];
};
bb^ ← grayBitBltTable;
bb.dst ← IndexBit[dest.sampleMap.base.word, [lc[dstBitIndex]]];
bb.dstBpl ← dest.sampleMap.bitsPerLine;
bb.src.word ← @replicatedPixel;
bb.height ← MIN[dest.size.s, dest.sampleMap.sSize-dest.start.s];
bb.width ← bps*MIN[dest.size.f, dest.sampleMap.fSize-dest.start.f];
bb.flags.srcFunc ← function.srcFunc;
bb.flags.dstFunc ← function.dstFunc;
PrincOpsUtils.BITBLT[bb];
}
ELSE DumbFill[dest, value, function];
};
TileBox:
PUBLIC
PROC [dest: SampleMap, start:
CVEC, size:
CVEC, source: SampleMap, s0, f0:
INTEGER, phase:
NAT, function: Function] ~ {
boxes: PROC[box: BoxProc] ~ {box[start.s, start.f, start.s+size.s, start.f+size.f]};
TileBoxes[dest, boxes, source, s0, f0, phase, function];
};
QR: TYPE ~ RECORD [quotient: INTEGER, remainder: NAT];
DivMod:
PROC [n:
INTEGER, d:
NAT]
RETURNS [qr:
QR] ~ {
Number-theoretic: 0 <= remainder < d, n = quotient*d + remainder
IF d#1
THEN {
nn: Basics.LongNumber ← [li[n]];
qq: Basics.LongNumber ← [lc[0]];
IF nn.li < 0 THEN {nn.highbits ← nn.highbits + d; -- qq.highbits ← CARDINAL.LAST --};
[quotient: qq.lowbits, remainder: qr.remainder] ← Basics.LongDivMod[nn.lc, d];
quotient ← qq.li;
qr.quotient ← LOOPHOLE[qq.lowbits];
}
ELSE RETURN [[quotient: n, remainder: 0]];
};
Mod:
PROC [n:
INT, d:
NAT]
RETURNS [remainder:
NAT] ~ {
Number-theoretic: 0 <= remainder < d
IF d#1
THEN {
nn: Basics.LongNumber ← [li[n]];
WHILE nn.li < 0 DO nn.highbits ← nn.highbits + d ENDLOOP;
WHILE nn.highbits >= d DO nn.highbits ← nn.highbits - d ENDLOOP;
RETURN [Basics.LongDivMod[nn.lc, d].remainder];
}
ELSE RETURN [remainder: 0];
};
TileFromStipple:
PUBLIC
PROC [stipple:
CARDINAL, bitsPerSample: [0..bitsPerWord], sample0, sample1:
CARDINAL, obtainScratch:
BOOL]
RETURNS [SampleMap] ~ {
easy: BOOL ~ (16 MOD (bitsPerSample*4) = 0) OR (bitsPerSample=8 AND BITAND[stipple, 3333H] = BITAND[stipple/4, 3333H]);
fSize: NAT ~ IF easy THEN 16/bitsPerSample ELSE 16;
sSize: NAT ~ IF easy THEN 4 ELSE 8;
temp: SampleMap ~ ObtainScratch[4, 4, bitsPerSample];
tile: SampleMap ~ (IF obtainScratch THEN ObtainScratch ELSE Create)[sSize: sSize, fSize: fSize, bitsPerSample: bitsPerSample];
Clear[tile];
FOR s:
NAT
DECREASING
IN [0..4)
DO
FOR f:
NAT
DECREASING
IN [0..4)
DO
PutSample[temp, [s, f], IF stipple MOD 2 = 0 THEN sample0 ELSE sample1, [null, null]];
stipple ← stipple/2;
ENDLOOP;
ENDLOOP;
TileBox[tile, [0, 0], [sSize, fSize], temp, 0, 0, 0, [null, null]];
ReleaseScratch[temp];
RETURN [tile];
};
Zeros:
PROC [pointer:
LONG
POINTER, count:
NAT]
RETURNS [
BOOL] ~
TRUSTED {
Checks for (pointer+i)^ = 0 for i IN [0..count)
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
chomp: NAT ~ 8;
scratch: ARRAY [0..chomp) OF WORD ← ALL[0];
bbTableSpace: PrincOps.BBTableSpace;
bb^ ← disjointBitBltTable;
bb.dstBpl ← 0;
bb.srcDesc ← [srcBpl[chomp*bitsPerWord]];
bb.height ← count/chomp;
bb.width ← chomp*bitsPerWord;
bb.flags.srcFunc ← null;
bb.flags.dstFunc ← or;
bb.dst.word ← @scratch;
bb.src.word ← pointer;
IF bb.height # 0 THEN PrincOpsUtils.BITBLT[bb];
bb.src.word ← pointer + Basics.LongMult[bb.height, chomp];
bb.height ← 1;
bb.width ← count MOD chomp;
IF bb.width # 0 THEN PrincOpsUtils.BITBLT[bb];
FOR i: NAT IN [0..MIN[chomp, count]) DO IF scratch[i]#0 THEN RETURN [FALSE] ENDLOOP;
RETURN [TRUE];
};
Equal:
PUBLIC
PROC [a, b: SubMap]
RETURNS [
BOOL] ~ {
sSize: NAT ~ MIN[NAT[a.sampleMap.sSize-a.start.s], a.size.s];
fSize: NAT ~ MIN[NAT[a.sampleMap.fSize-a.start.f], a.size.f];
IF sSize =
MIN[
NAT[b.sampleMap.sSize-b.start.s], b.size.s]
AND
fSize =
MIN[
NAT[b.sampleMap.fSize-b.start.f], b.size.f]
AND
a.sampleMap.bitsPerSample = b.sampleMap.bitsPerSample
THEN {
bandSize: NAT ← MIN[MAX[4096/fSize, 1], sSize];
band: SampleMap ~ ObtainScratch[sSize: bandSize, fSize: fSize, bitsPerSample: a.sampleMap.bitsPerSample];
equal: BOOL ← TRUE;
Clear[band];
FOR s:
NAT ← 0, s+bandSize
UNTIL s = sSize
DO
Transfer[band, [0, 0], [a.sampleMap, [s+a.start.s, a.start.f], [bandSize, fSize]], [null, null]];
Transfer[band, [0, 0], [b.sampleMap, [s+b.start.s, b.start.f], [bandSize, fSize]], [xor, null]];
IF NOT Zeros[band.base.word, ComputeWords[bandSize, fSize, band.bitsPerSample]] THEN {equal ← FALSE; EXIT};
bandSize ← MIN[sSize-s, bandSize];
ENDLOOP;
ReleaseScratch[band];
RETURN [equal];
}
ELSE RETURN [FALSE];
};
IsAll:
PUBLIC
PROC [subMap: SubMap, value:
CARDINAL ← 0]
RETURNS [
BOOLEAN] ~ {
sSize: NAT ~ MIN[NAT[subMap.sampleMap.sSize-subMap.start.s], subMap.size.s];
fSize: NAT ~ MIN[NAT[subMap.sampleMap.fSize-subMap.start.f], subMap.size.f];
bandSize: NAT ← MIN[MAX[4096/fSize, 1], sSize];
band: SampleMap ~ ObtainScratch[sSize: bandSize, fSize: fSize, bitsPerSample: subMap.sampleMap.bitsPerSample];
equal: BOOL ← TRUE;
Clear[band];
FOR s:
NAT ← 0, s+bandSize
UNTIL s = sSize
DO
Transfer[band, [0, 0], [subMap.sampleMap, [s+subMap.start.s, subMap.start.f], [bandSize, fSize]], [null, null]];
IF value#0 THEN Fill[dest: [band, [0,0], [bandSize, fSize]], value: value, function: [xor, null]];
IF NOT Zeros[band.base.word, ComputeWords[bandSize, fSize, band.bitsPerSample]] THEN {equal ← FALSE; EXIT};
bandSize ← MIN[sSize-s, bandSize];
ENDLOOP;
ReleaseScratch[band];
RETURN [equal];
};
Trim:
PUBLIC
PROC [subMap: SubMap, background:
CARDINAL ← 0]
RETURNS [SubMap] ~ {
sSize: NAT ← MIN[NAT[subMap.sampleMap.sSize-subMap.start.s], subMap.size.s];
fSize: NAT ← MIN[NAT[subMap.sampleMap.fSize-subMap.start.f], subMap.size.f];
band: SampleMap ← ObtainScratch[sSize: 1, fSize: fSize, bitsPerSample: subMap.sampleMap.bitsPerSample];
smin: NAT ← subMap.start.s;
smax: NAT ← smin+sSize;
fmin: NAT ← subMap.start.f;
fmax: NAT ← fmin+fSize;
bandWords: NAT ~ ComputeWords[1, fSize, band.bitsPerSample];
Clear[band];
WHILE smin < smax
-- OR EXIT below --
DO
Transfer[band, [0, 0], [subMap.sampleMap, [smax-1, subMap.start.f], [1, fSize]], [null, null]];
IF background#0 THEN Fill[dest: [band, [0,0], [1, fSize]], value: background, function: [xor, null]];
IF NOT Zeros[band.base.word, bandWords] THEN EXIT;
smax ← smax-1;
ENDLOOP;
WHILE smin < smax
-- OR EXIT below --
DO
Transfer[band, [0, 0], [subMap.sampleMap, [smin, subMap.start.f], [1, fSize]], [null, null]];
IF background#0 THEN Fill[dest: [band, [0,0], [1, fSize]], value: background, function: [xor, null]];
IF NOT Zeros[band.base.word, bandWords] THEN EXIT;
smin ← smin+1;
ENDLOOP;
ReleaseScratch[band];
band ← NIL;
IF smin=smax THEN RETURN [[subMap.sampleMap, [smin, fmin], [0, 0]]];
FOR delta:
NAT ← 16, delta/4
UNTIL delta=0
DO
WHILE fmin+delta <= fmax
AND IsAll[[subMap.sampleMap, [smin, fmax-delta], [smax-smin, delta]], background]
DO
fmax ← fmax-delta;
ENDLOOP;
WHILE fmin+delta <= fmax
AND IsAll[[subMap.sampleMap, [smin, fmin], [smax-smin, delta]], background]
DO
fmin ← fmin+delta;
ENDLOOP;
ENDLOOP;
RETURN [[subMap.sampleMap, [smin, fmin], [smax-smin, fmax-fmin]]]
};
DumbTileBox:
PROC [dest: SampleMap, start:
CVEC, size:
CVEC, source: SampleMap, s0, f0:
INTEGER, phase:
NAT, function: Function] ~ {
FOR s:
NAT
IN [start.s..start.s+size.s)
DO
qr: QR ~ DivMod[(INTEGER[s]-s0), source.sSize];
fSource: CARDINAL ← Mod[INT[start.f]-f0 - QMul[qr.quotient, phase], source.fSize];
FOR f:
NAT
IN [start.f..start.f+size.f)
DO
sample: CARDINAL ~ GetSample[source, [qr.remainder, fSource]];
PutSample[dest, [s, f], sample, function];
fSource ← fSource + 1;
IF fSource = source.fSize THEN fSource ← 0;
ENDLOOP;
ENDLOOP;
};
EnlargedSize:
PROC [fSize:
NAT, bps:
NAT]
RETURNS [
NAT] ~ {
n: CARDINAL ~ ((smallWidth+fSize-1)/fSize+bps-1)/bps;
RETURN [Basics.LongMult[n, fSize]]
};
smallWidth: NAT ← 128;
BoxProc: TYPE ~ SampleMapOps.BoxProc;
TileBoxes:
PUBLIC
PROC [dest: SampleMap, boxes:
PROC[BoxProc], source: SampleMap, s0, f0:
INTEGER, phase:
NAT, function: Function] ~ {
sSize: NAT ~ dest.sSize;
fSize: NAT ~ dest.fSize;
bps: NAT ~ dest.bitsPerSample;
MacroBrickAction:
PROC [scratch: SampleMap] ~ {
scratchBoxes: PROC[box: BoxProc] ~ {box[0, 0, scratch.sSize, scratch.fSize]};
GeneralTileBoxes[scratch, scratchBoxes, source, 0, 0, phase, [null, null]];
GeneralTileBoxes[dest, boxes, scratch, s0, f0, phase, function];
};
IF bps=source.bitsPerSample
AND source.fSize*bps = bitsPerWord
AND source.bitsPerLine = bitsPerWord
AND source.sSize
IN (0..16]
AND phase = 0
AND source.base.bit = 0
AND function # [null, complement]
THEN
TRUSTED {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
destBPL: CARDINAL ~ dest.bitsPerLine;
easyBox:
SAFE
PROC [smin, fmin, smax, fmax:
CARDINAL] ~
TRUSTED {
dstBitIndex:
LONG
CARDINAL ~ dest.base.bit +
Basics.LongMult[Check[smin, smax], destBPL] +
Basics.LongMult[Check[fmin, fmax], bps];
yOffset: CARDINAL ~ LOOPHOLE[smin-s0, CARDINAL] MOD source.sSize;
bb.dst ← IndexBit[dest.base.word, [lc[dstBitIndex]]];
bb.src.word ← source.base.word+yOffset;
bb.src.bit ← LOOPHOLE[fmin-f0, CARDINAL] MOD 16;
bb.srcDesc.gray.yOffset ← yOffset;
bb.height ← Check[smax, sSize]-smin;
bb.width ← Basics.LongMult[Check[fmax, fSize]-fmin, bps];
PrincOpsUtils.BITBLT[bb];
};
bb^ ← grayBitBltTable;
bb.dstBpl ← dest.bitsPerLine;
bb.srcDesc.gray.heightMinusOne ← source.sSize-1;
bb.flags.srcFunc ← function.srcFunc;
bb.flags.dstFunc ← function.dstFunc;
boxes[easyBox];
RETURN
};
IF bps#source.bitsPerSample
OR source.fSize*bps <
MIN[smallWidth, dest.fSize]
THEN DoWithScratch[sSize: source.sSize, fSize: EnlargedSize[source.fSize, bps], bitsPerSample: bps, action: MacroBrickAction]
ELSE GeneralTileBoxes[dest, boxes, source, s0, f0, phase, function];
};
QMul:
PROC [a:
INTEGER, b:
CARDINAL]
RETURNS [
INT] ~
INLINE {
IF a >= 0 THEN RETURN [LOOPHOLE[Basics.LongMult[a, b]]]
ELSE RETURN [-LOOPHOLE[Basics.LongMult[-a, b], INT]]
};
GeneralTileBoxes:
PROC [dest: SampleMap, boxes:
PROC[BoxProc], source: SampleMap, s0, f0:
INTEGER, phase:
NAT, function: Function] ~ {
bps: NAT ~ dest.bitsPerSample;
sSize: NAT ~ dest.sSize;
fSize: NAT ~ dest.fSize;
box:
SAFE
PROC [smin, fmin, smax, fmax:
CARDINAL] ~
TRUSTED {
sBrickSize: NAT ~ source.sSize;
fBrickSize: NAT ~ source.fSize;
qr: QR ~ DivMod[(INTEGER[smin]-s0), sBrickSize];
s: CARDINAL ← smin;
sDelta: CARDINAL ← sBrickSize - qr.remainder;
fSource: CARDINAL ← Mod[fmin-f0 - QMul[qr.quotient, phase], fBrickSize];
WHILE s < smax
DO
sBrick: NAT ~ sBrickSize-sDelta;
sClipSize: NAT ~ MIN[sBrickSize+s, smax]-s;
f: NAT ← fmin;
fDelta: NAT ← fBrickSize-fSource;
WHILE f < fmax
DO
Transfer[dest: dest, destStart: [s, f], source: [source, [sBrick, fBrickSize-fDelta], [sClipSize, MIN[fBrickSize+f, fmax]-f]], function: function];
f ← f + fDelta;
fDelta ← fBrickSize;
ENDLOOP;
s ← s + sDelta;
sDelta ← sBrickSize;
WHILE fSource < phase DO fSource ← fSource + fBrickSize ENDLOOP;
fSource ← fSource - phase;
ENDLOOP;
};
boxes[box];
};
Apply:
PUBLIC
PROC [dest, source: SampleMap, op:
PROC [a, b:
CARDINAL]
RETURNS [
CARDINAL]] ~ {
fSize: NAT ~ MIN[dest.fSize, source.fSize];
a: Buffer ~ ObtainBuffer[fSize];
b: Buffer ~ ObtainBuffer[fSize];
FOR s:
NAT
IN [0..
MIN[dest.sSize, source.sSize])
DO
Get[buffer: a, sampleMap: dest, s: s];
Get[buffer: b, sampleMap: source, s: s];
FOR f:
NAT
IN [0..fSize)
DO
a[f] ← op[a[f],b[f]];
ENDLOOP;
Put[buffer: a, sampleMap: dest, s: s, function: [null, null]];
ENDLOOP;
ReleaseBuffer[a];
ReleaseBuffer[b];
};
Get:
PUBLIC
PROC [buffer: Buffer, start:
NAT ← 0, count:
NAT ← maxCount,
sampleMap: SampleMap, s, f:
NAT ← 0, ds:
NAT ← 0, df:
NAT ← 1] ~
TRUSTED {
size: NAT ~ MIN[count, buffer.length-start];
IF size # 0
THEN {
sSize: NAT ~ sampleMap.sSize;
fSize: NAT ~ sampleMap.fSize;
bpl: NAT ~ sampleMap.bitsPerLine;
bps: NAT ~ sampleMap.bitsPerSample;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bbTableSpace: PrincOps.BBTableSpace;
bufferPointer: LONG POINTER ~ InlineGetPointer[buffer, start, size];
srcBitIndex:
LONG
CARDINAL ← sampleMap.base.bit +
Basics.LongMult[Basics.BoundsCheck[s, sSize], bpl] +
Basics.LongMult[Basics.BoundsCheck[f, fSize], bps];
srcBitDelta: NAT ~ Basics.LongMult[ds, bpl] + Basics.LongMult[df, bps];
srcBitSkipDelta: NAT ← srcBitDelta;
lgSkip: NAT ← 0;
skipMinusOne: NAT ← 0;
IF ds > 0 THEN [] ← Basics.BoundsCheck[s+Basics.LongMult[size-1, ds], sSize];
IF df > 0 THEN [] ← Basics.BoundsCheck[f+Basics.LongMult[size-1, df], fSize];
WHILE srcBitSkipDelta <=
NAT.
LAST/2
AND
LOOPHOLE[srcBitSkipDelta,
CARDINAL]
MOD bitsPerWord # 0
DO
srcBitSkipDelta ← srcBitSkipDelta * 2;
lgSkip ← lgSkip + 1;
ENDLOOP;
skipMinusOne ← Shift[1, lgSkip]-1;
PrincOpsUtils.LongZero[where: bufferPointer, nwords: size];
bb^ ← disjointBitBltTable;
bb.dst.bit ← bitsPerWord-bps;
bb.dstBpl ← Shift[bitsPerWord, lgSkip];
bb.srcDesc ← [srcBpl[srcBitSkipDelta]];
bb.width ← bps;
FOR i:
NAT
IN [0..Shift[1, lgSkip])
DO
bb.src ← IndexBit[sampleMap.base.word, [lc[srcBitIndex]]];
bb.height ← Shift[size-i+skipMinusOne, -lgSkip];
bb.dst.word ← bufferPointer+i;
PrincOpsUtils.BITBLT[bb];
srcBitIndex ← srcBitIndex + srcBitDelta;
ENDLOOP;
PrincOpsUtils.BITBLT[bb];
};
};
Put:
PUBLIC
PROC [buffer: Buffer, start:
NAT ← 0, count:
NAT ← maxCount,
sampleMap: SampleMap, s, f:
NAT ← 0, ds:
NAT ← 0, df:
NAT ← 1,
function: Function ← nullFunction] ~
TRUSTED {
size: NAT ~ MIN[count, buffer.length-start];
IF size # 0
THEN {
sSize: NAT ~ sampleMap.sSize;
fSize: NAT ~ sampleMap.fSize;
bpl: NAT ~ sampleMap.bitsPerLine;
bps: NAT ~ sampleMap.bitsPerSample;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bbTableSpace: PrincOps.BBTableSpace;
bufferPointer: LONG POINTER ~ InlineGetPointer[buffer, start, size];
dstBitIndex:
LONG
CARDINAL ← sampleMap.base.bit +
Basics.LongMult[Basics.BoundsCheck[s, sSize], bpl] +
Basics.LongMult[Basics.BoundsCheck[f, fSize], bps];
dstBitDelta: NAT ← Basics.LongMult[ds, bpl] + Basics.LongMult[df, bps];
dstBitSkipDelta: NAT ← dstBitDelta;
lgSkip: NAT ← 0;
skipMinusOne: NAT ← 0;
bufferFirst: LONG POINTER ← bufferPointer;
IF ds > 0 THEN [] ← Basics.BoundsCheck[s+Basics.LongMult[size-1, ds], sSize];
IF df > 0 THEN [] ← Basics.BoundsCheck[f+Basics.LongMult[size-1, df], fSize];
WHILE dstBitSkipDelta <=
NAT.
LAST/2
AND
LOOPHOLE[dstBitSkipDelta,
CARDINAL]
MOD bitsPerWord # 0
DO
dstBitSkipDelta ← dstBitSkipDelta * 2;
lgSkip ← lgSkip + 1;
ENDLOOP;
skipMinusOne ← Shift[1, lgSkip]-1;
bb^ ← disjointBitBltTable;
bb.flags.srcFunc ← function.srcFunc;
bb.flags.dstFunc ← function.dstFunc;
bb.dstBpl ← dstBitSkipDelta;
bb.src.bit ← bitsPerWord-bps;
bb.srcDesc ← [srcBpl[Shift[bitsPerWord, lgSkip]]];
bb.width ← bps;
FOR i:
NAT
IN [0..Shift[1, lgSkip])
DO
bb.dst ← IndexBit[sampleMap.base.word, [lc[dstBitIndex]]];
bb.height ← Shift[size-i+skipMinusOne, -lgSkip];
bb.src.word ← bufferPointer+i;
PrincOpsUtils.BITBLT[bb];
dstBitIndex ← dstBitIndex + dstBitDelta;
ENDLOOP;
};
};
Flip:
PUBLIC
PROC [buffer: Buffer] ~
TRUSTED {
size: NAT ~ buffer.length;
last: INTEGER ~ size-1;
s: LONG POINTER TO Basics.RawWords ~ InlineGetPointer[buffer, 0, size];
k: NAT ← size;
FOR j:
NAT
IN [0..size/2)
DO
t: CARDINAL ← s[j];
s[j] ← s[k ← k-1];
s[k] ← t;
ENDLOOP;
};
nScratchBuf: NAT ~ 6;
scratchBuf:
ARRAY [0..nScratchBuf)
OF Buffer ←
ALL[
NIL];
ObtainBuffer:
PUBLIC
ENTRY
PROC [length:
NAT]
RETURNS [Buffer] ~ {
FOR i:
NAT
IN [0..nScratchBuf)
DO
buf: Buffer ~ scratchBuf[i];
IF buf #
NIL
AND buf.maxLength >= length
THEN {
scratchBuf[i] ← NIL;
buf.length ← length;
RETURN [buf];
};
ENDLOOP;
RETURN [NEW[BufferRep[length] ← [length: length, samples:]]]
};
ReleaseBuffer:
PUBLIC
ENTRY
PROC [buffer: Buffer] ~ {
r: Buffer ← buffer;
buffer.length ← 0;
FOR i:
NAT
IN [0..nScratchBuf)
UNTIL r =
NIL
DO
Push least-recently-used towards end.
t: Buffer ← scratchBuf[i];
scratchBuf[i] ← r;
r ← t;
IF r = buffer THEN RETURN WITH ERROR MultipleReleaseOfScratch;
ENDLOOP;
};
InlineGetPointer:
PROC [buffer: Buffer, start:
NAT, count:
NAT]
RETURNS [
LONG
POINTER
TO Basics.RawWords] ~
TRUSTED
INLINE {
[] ← Check[start+count, buffer.maxLength];
TRUSTED {RETURN [LOOPHOLE[buffer, LONG POINTER TO Basics.RawWords]+SIZE[BufferRep[start]]]}
};
GetPointer:
PUBLIC
PROC [buffer: Buffer, start:
NAT, count:
NAT]
RETURNS [
LONG
POINTER
TO Basics.RawWords] ~ {
RETURN [InlineGetPointer[buffer, start, count]]};
GetMapPointer: PROC [sampleMap: SampleMap, start: CVEC, size: NAT] RETURNS [LONG POINTER TO Basics.RawWords] ~ TRUSTED {
bps: [bitsPerWord..bitsPerWord] ~ sampleMap.bitsPerSample;
zero: [0..0] ~ sampleMap.base.bit + (sampleMap.bitsPerLine MOD bitsPerWord);
end: NAT ~ Check[NAT[start.f]+size, sampleMap.fSize];
lineOffset: LONG CARDINAL ~ Basics.LongMult[Basics.BoundsCheck[start.s, sampleMap.sSize], sampleMap.bitsPerLine/bitsPerWord];
RETURN [sampleMap.base.word + lineOffset + start.f]
};