
<<GreenBayImpl.mesa>>
<<Packers (and unpackers).>>
<<Copyright (C) 1984, Xerox Corporation.  All rights reserved.>>
<<Written October 29, 1984>>
<<Michael Plass, October 17, 1985 2:14:53 pm PDT>>
<<>>
DIRECTORY PrincOps, PrincOpsUtils, Basics, GreenBay;

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.