GreenBayImpl:
PROGRAM
IMPORTS Basics, PrincOpsUtils
EXPORTS GreenBay ~
BEGIN
bitsPerWord:
NAT ~ Basics.bitsPerWord;
special:
BOOLEAN ←
TRUE;
-- True to allow special casing
specialBits:
BOOLEAN ←
FALSE;
-- True to allow extra-special casing for bitmaps
IsPowerOfTwo:
PROC [c:
CARDINAL]
RETURNS [
BOOLEAN] ~
INLINE {
RETURN [Basics.BITAND[c, c-1] = 0]
};
Lg:
PROC [c:
CARDINAL]
RETURNS [lg:
CARDINAL] ~ {
lg ← 0;
WHILE c > 1 DO lg ← lg + 1; c ← c/2 ENDLOOP;
};
Pack:
PUBLIC
PROC [
wordPointer: LONG POINTER TO WORD, -- Pointer to the destination (one element per word)
bitsPerElement: (0..bitsPerWord],
base: LONG POINTER, -- Pointer to the source (elements may cross word boundaries)
start: NAT, -- Index of starting element
count: NAT -- Number of elements
] ~ {
IF specialBits AND 32 MOD bitsPerWord = 0 AND bitsPerElement=1 THEN PackBits[wordPointer, base, start, count]
ELSE IF special AND IsPowerOfTwo[bitsPerElement] THEN PackAligned[wordPointer, bitsPerElement, base, start, count]
ELSE {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bit: LONG CARDINAL ← Basics.LongMult[start, bitsPerElement];
bb^ ← [
dst: [word: base+bit/bitsPerWord, bit: bit MOD bitsPerWord],
dstBpl: bitsPerElement,
src: [word: wordPointer, bit: bitsPerWord-bitsPerElement],
srcDesc: [srcBpl[bitsPerWord]],
width: bitsPerElement,
height: count,
flags: []
];
PrincOpsUtils.BITBLT[bb];
};
};
PackBits:
PROC [
wordPointer: LONG POINTER TO WORD,
base: LONG POINTER,
start: NAT,
count: NAT
] ~ {
dst: LONG POINTER TO PACKED ARRAY [0..32) OF [0..1] ← base+start/bitsPerWord;
bit: NAT ← start MOD bitsPerWord;
IF bit # 0
THEN {
WHILE count#0
AND bit#32
DO
dst[bit] ← wordPointer^ MOD 2;
bit ← bit + 1;
wordPointer ← wordPointer + 1;
count ← count - 1;
ENDLOOP;
dst ← dst + SIZE[PACKED ARRAY [0..32) OF [0..1]];
bit ← 0;
};
WHILE count>=32
DO
b: ARRAY [0..32) OF [0..1] ← LOOPHOLE[wordPointer, LONG POINTER TO ARRAY [0..32) OF [0..1]]^;
dst^ ← [b[0], b[1], b[2], b[3], b[4], b[5], b[6], b[7], b[8], b[9], b[10], b[11], b[12], b[13], b[14], b[15], b[16], b[17], b[18], b[19], b[20], b[21], b[22], b[23], b[24], b[25], b[26], b[27], b[28], b[29], b[30], b[31]];
dst ← dst + SIZE[PACKED ARRAY [0..32) OF [0..1]];
wordPointer ← wordPointer + SIZE[ARRAY [0..32) OF WORD];
count ← count - 32;
ENDLOOP;
WHILE count#0
DO
dst[bit] ← wordPointer^ MOD 2;
bit ← bit + 1;
wordPointer ← wordPointer + 1;
count ← count - 1;
ENDLOOP;
};
PackAligned:
PROC [
wordPointer: LONG POINTER TO WORD,
bitsPerElement: NAT,
base: LONG POINTER,
start: NAT,
count: NAT
] ~ {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
lgBitsPerElement: NAT ← Lg[bitsPerElement];
lgBitsPerWord: INTEGER ~ Basics.logBitsPerWord;
lgElementsPerWord: INTEGER ← lgBitsPerWord-lgBitsPerElement;
elementsPerWord: NAT ← Basics.BITSHIFT[1, lgElementsPerWord];
bit: CARDINAL ← Basics.BITSHIFT[start, lgBitsPerElement] MOD bitsPerWord;
base ← base + Basics.BITSHIFT[start, -lgElementsPerWord];
bb^ ← [
dst: [word: NIL, bit: 0],
dstBpl: bitsPerWord,
src: [word: wordPointer, bit: bitsPerWord-bitsPerElement],
srcDesc: [srcBpl[Basics.BITSHIFT[bitsPerWord, lgElementsPerWord]]],
width: bitsPerElement,
height: 0,
flags: []
];
FOR j:
NAT
IN [0..elementsPerWord)
DO
bb.dst ← [word: base+bit/bitsPerWord, bit: bit MOD bitsPerWord];
bb.height ← Basics.BITSHIFT[(count-j+(elementsPerWord-1)), -lgElementsPerWord];
PrincOpsUtils.BITBLT[bb];
bb.src.word ← bb.src.word+1;
bit ← bit + bitsPerElement;
ENDLOOP;
UnPack:
PUBLIC
PROC [
wordPointer: LONG POINTER TO WORD, -- Pointer to the source (one element per word)
bitsPerElement: (0..bitsPerWord],
base: LONG POINTER,
start: NAT,
count: NAT
] ~ {
IF specialBits AND 32 MOD bitsPerWord = 0 AND bitsPerElement=1 THEN UnPackBits[wordPointer, base, start, count]
ELSE IF special AND IsPowerOfTwo[bitsPerElement] THEN UnPackAligned[wordPointer, bitsPerElement, base, start, count]
ELSE {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bit: LONG CARDINAL ← Basics.LongMult[start, bitsPerElement];
PrincOpsUtils.LongZero[where: wordPointer, nwords: count];
bb^ ← [
dst: [word: wordPointer, bit: bitsPerWord-bitsPerElement],
dstBpl: bitsPerWord,
src: [word: base+bit/bitsPerWord, bit: bit MOD bitsPerWord],
srcDesc: [srcBpl[bitsPerElement]],
width: bitsPerElement,
height: count,
flags: []
];
PrincOpsUtils.BITBLT[bb];
};
};
Assert:
PROC [true:
BOOLEAN] ~ {
IF
NOT true
THEN
ERROR};
UnPackBits:
PROC [
wordPointer: LONG POINTER TO WORD, -- Pointer to the source (one element per word)
base: LONG POINTER,
start: NAT,
count: NAT
] ~ {
src: LONG POINTER TO CARDINAL ← base + start/bitsPerWord;
bit: NAT ← start MOD bitsPerWord;
word: CARDINAL ← 0;
IF bit#0
THEN {
word ← Basics.BITSHIFT[src^, bit];
src ← src + 1;
WHILE count#0
AND bit#bitsPerWord
DO
Assert[word = Basics.BITSHIFT[(src-1)^, bit]];
wordPointer^ ← Basics.BITSHIFT[word, 1-bitsPerWord];
count ← count-1;
bit ← bit+1;
word ← 2*word;
wordPointer ← wordPointer + 1;
ENDLOOP;
};
WHILE count>=32
DO
a: LONG POINTER TO ARRAY [0..32) OF WORD ← LOOPHOLE[wordPointer];
lp: LONG POINTER TO PACKED ARRAY [0..32) OF [0..1] ~ LOOPHOLE[src];
b: PACKED ARRAY [0..32) OF [0..1] ← lp^;
p:
POINTER
TO
PACKED
ARRAY [0..32)
OF [0..1] ~ @b;
This short pointer nonsense can go away for Dragon, but on a Dorado it saves a little for each bit.
a^ ← [p^[0], p^[1], p^[2], p^[3], p^[4], p^[5], p^[6], p^[7], p^[8], p^[9], p^[10], p^[11], p^[12], p^[13], p^[14], p^[15], p^[16], p^[17], p^[18], p^[19], p^[20], p^[21], p^[22], p^[23], p^[24], p^[25], p^[26], p^[27], p^[28], p^[29], p^[30], p^[31]];
wordPointer ← wordPointer + 32;
count ← count - 32;
src ← src + SIZE[PACKED ARRAY [0..32) OF [0..1]];
ENDLOOP;
WHILE count#0
DO
Assert[word = Basics.BITSHIFT[(src-1)^, bit]];
IF bit = bitsPerWord THEN {bit ← 0; word ← src^; src ← src + 1};
Assert[word = Basics.BITSHIFT[(src-1)^, bit]];
wordPointer^ ← Basics.BITSHIFT[word, 1-bitsPerWord];
count ← count-1;
word ← 2*word;
wordPointer ← wordPointer + 1;
bit ← bit+1;
ENDLOOP;
};
UnPackAligned:
PROC [
wordPointer: LONG POINTER TO WORD,
bitsPerElement: NAT,
base: LONG POINTER,
start: NAT,
count: NAT
] ~ {
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
lgBitsPerElement: NAT ← Lg[bitsPerElement];
lgBitsPerWord: INTEGER ~ Basics.logBitsPerWord;
lgElementsPerWord: INTEGER ← lgBitsPerWord-lgBitsPerElement;
elementsPerWord: NAT ← Basics.BITSHIFT[1, lgElementsPerWord];
bit: CARDINAL ← Basics.BITSHIFT[start, lgBitsPerElement] MOD bitsPerWord;
base ← base + Basics.BITSHIFT[start, -lgElementsPerWord];
PrincOpsUtils.LongZero[where: wordPointer, nwords: count];
bb^ ← [
dst: [word: wordPointer, bit: bitsPerWord-bitsPerElement],
dstBpl: Basics.BITSHIFT[bitsPerWord, lgElementsPerWord],
src: [word: NIL, bit: 0],
srcDesc: [srcBpl[bitsPerWord]],
width: bitsPerElement,
height: 0,
flags: []
];
FOR j:
NAT
IN [0..elementsPerWord)
DO
bb.src ← [word: base+bit/bitsPerWord, bit: bit MOD bitsPerWord];
bb.height ← Basics.BITSHIFT[(count-j+(elementsPerWord-1)), -lgElementsPerWord];
PrincOpsUtils.BITBLT[bb];
bb.dst.word ← bb.dst.word+1;
bit ← bit + bitsPerElement;
ENDLOOP;
END.