RasterOpForwardImpl.meta
Copyright Ó 1988, 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Michael Plass, October 1, 1991 4:37 pm PDT
Russ Atkinson (RRA) March 1, 1990 4:03:19 pm PST
Willie-s, June 13, 1991 4:28 pm PDT
DIRECTORY Basics, RasterBasics, RasterOp;
RasterOpForwardImpl: PROGRAM
IMPORTS Basics
EXPORTS RasterOp
~ BEGIN OPEN Basics;
bpw: CARDINAL ~ BITS[WORD];
BitOff: TYPE = [0..bpw);
BitCount: TYPE = [0..bpw];
DstFunc: TYPE ~ RasterBasics.DstFunc;
SrcFunc: TYPE ~ RasterBasics.SrcFunc;
BitAddress: TYPE ~ RasterBasics.BitAddress;
RawWords: TYPE ~ Basics.RawWords;
RawWordsPtr: TYPE ~ LONG POINTER TO RawWords;
WordPtr: TYPE = LONG POINTER TO WORD;
Procs
WordsForBits: PROC [bits: CARDINAL] RETURNS [CARDINAL] ~ INLINE {
RETURN [CARDINAL[bits+(bpw-1)]/bpw]
};
WordFloorUnitsForBits: PROC [bits: CARDINAL] RETURNS [CARDINAL] ~ INLINE {
RETURN [(CARDINAL[bits]/bpw)*CARDINAL[UNITS[WORD]]]
};
CombineUnderMask: PROC [mask, onesSrc, zerosSrc: WORD] RETURNS [WORD] ~ INLINE {
RETURN [BITXOR[BITAND[BITXOR[onesSrc, zerosSrc], mask], zerosSrc]]
};
rightJustifiedOnes: ARRAY BitCount OF WORD ~ InitRightJustifiedOnes[];
InitRightJustifiedOnes: PROC RETURNS [a: ARRAY BitCount OF WORD] ~ {
m: WORD ¬ 0;
FOR n: CARDINAL IN BitCount DO
a[n] ¬ m;
m ¬ m+m+1;
ENDLOOP;
};
RightJustifiedZeros: PROC [n: BitCount] RETURNS [WORD] ~ INLINE {
RETURN [BITNOT[rightJustifiedOnes[n]]]
};
FOR f: NAT IN [0..8) DO
unroll: INT ~ 4;
SrcFunc: PROC [s: ROPE] ~ {IF f MOD 2 = 1 THEN {BITNOT[%s]} ELSE {%s}};
F: PROC[d, s: ROPE] ~ {
SELECT f FROM
0 => {%s};
1 => {BITNOT[%s]};
2 => {BITAND[%d, %s]};
3 => {BITAND[%d, BITNOT[%s]]};
4 => {BITOR[%d, %s]};
5 => {BITOR[%d, BITNOT[%s]]};
6 => {BITXOR[%d, %s]};
7 => {BITXOR[%d, BITNOT[%s]]};
ENDCASE => ERROR;
}; 
Forward&f: PROC [dst: BitAddress, src: BitAddress, dstBpl, srcBpl, sSize, fSize: CARDINAL] ~ {
MF: PROC [d, s, mask: WORD] RETURNS [WORD] ~ INLINE {
RETURN [
IF f/2 = 2
THEN {
BITOR[d, BITAND[mask, ?SrcFunc[s]]]
}
ELSE {
BITXOR[BITAND[BITXOR[?F[d, s], d], mask], d]
};
]
};
DoUniformLines: PROC [count: CARDINAL, dstPtr: WordPtr, dstBit: BitOff, srcPtr: WordPtr, srcBit: BitOff] ~ {
dRast: CARD ~ WordFloorUnitsForBits[dstBpl];
sRast: CARD ~ WordFloorUnitsForBits[srcBpl];
ndw: CARDINAL ~ WordsForBits[dstBit + fSize];
number of destination words per (this) line
lMask: WORD ~ rightJustifiedOnes[bpw-dstBit];
mask for the leftmost dest word (ones where bits are to go)
rMask: WORD ~ RightJustifiedZeros[
(LOOPHOLE[bpw-dstBit-fSize, CARDINAL]) MOD bpw];
mask for the rightmost dest word
lSA: BitOff ~ (LOOPHOLE[srcBit-dstBit, CARDINAL]) MOD bpw; -- left shift amount
w: WORD ¬ 0; -- source word, aligned with destination
dstLine: RawWordsPtr ¬ NIL; -- destination line word address
srcLine: RawWordsPtr ¬ NIL; -- source line word address
FOR alignment: NAT IN [0..1] DO 
Inner&alignment: PROC = INLINE {
IF alignment # 0
THEN {
hi: WORD; -- left unshifted source word
lo: WORD ¬ 0; -- right unshifted source word
rSA: BitOff = bpw - lSA;
amount to shift source words right to line them up
nsw: CARDINAL = WordsForBits[srcBit + fSize];
fetchLastWord: BOOL = IF srcBit >= dstBit THEN (nsw>ndw) ELSE (nsw>=ndw);
true if last source word needs to be fetched
FetchNext: PROC ~ INLINE {
fetches the next aligned source bits, and bumps source pointer
hi ¬ lo;
lo ¬ srcLine[0];
srcLine ¬ srcLine+SIZE[WORD];
w ¬ BITLSHIFT[hi, lSA]+BITRSHIFT[lo, rSA]
};
FetchNextOff: PROC [wordOffset: CARDINAL] ~ INLINE {
fetches the next word at the given offset, no pointer change
hi ¬ lo;
lo ¬ srcLine[wordOffset];
w ¬ BITLSHIFT[hi, lSA]+BITRSHIFT[lo, rSA]
};
FetchLast: PROC [wordOffset: CARDINAL, fetch: BOOL] ~ INLINE {
-- fetches the final source bits on a line, avoiding a spurious fetch
w ¬ BITLSHIFT[lo, lSA];
IF fetch THEN w ¬ w + BITRSHIFT[srcLine[wordOffset], rSA];
};
BBLineSetup: PROC ~ INLINE {
dstLine ¬ LOOPHOLE[dstPtr];
srcLine ¬ LOOPHOLE[srcPtr];
IF srcBit >= dstBit THEN FetchNext[];
};
}
ELSE {
-- Aligned case is simpler
fetchLastWord: BOOL ~ TRUE;
true if last source word needs to be fetched
FetchNext: PROC ~ INLINE {
fetches the next aligned source bits, and bumps source pointer
w ¬ srcLine[0];
srcLine ¬ srcLine+SIZE[WORD];
};
FetchNextOff: PROC [wordOffset: CARDINAL] ~ INLINE {
fetches the word at the given offset, no pointer change
w ¬ srcLine[wordOffset];
};
FetchLast: PROC [wordOffset: CARDINAL, fetch: BOOL] ~ INLINE {
-- fetches the final source bits on a line, avoiding a spurious fetch
w ¬ srcLine[wordOffset];
};
BBLineSetup: PROC ~ INLINE {
dstLine ¬ LOOPHOLE[dstPtr];
srcLine ¬ LOOPHOLE[srcPtr];
};
};
SELECT ndw FROM
1 => {
Special encoding of one destination word case for speed
bothMask: WORD ~ BITAND[lMask, rMask];
IF fetchLastWord
THEN
DO
BBLineSetup[];
FetchLast[0, TRUE];
dstLine[0] ¬ MF[dstLine[0], w, bothMask];
IF count <= 1 THEN EXIT;
count ¬ count - 1;
dstPtr ¬ dstPtr + dRast;
srcPtr ¬ srcPtr + sRast;
ENDLOOP
ELSE
DO
BBLineSetup[];
FetchLast[0, FALSE];
dstLine[0] ¬ MF[dstLine[0], w, bothMask];
IF count <= 1 THEN EXIT;
count ¬ count - 1;
dstPtr ¬ dstPtr + dRast;
srcPtr ¬ srcPtr + sRast;
ENDLOOP
};
FOR u: INT IN [2..unroll] DO um: INT = u-1; 
&u => {
DO
BBLineSetup[];
FetchNextOff[0];
dstLine[0] ¬ MF[dstLine[0], w, lMask];
FOR j: INT IN [1..um) DO 
FetchNextOff[&j];
dstLine[&j] ¬ ?F[dstLine[&j], w];
ENDLOOP;
FetchLast[&um, fetchLastWord];
dstLine[&um] ¬ MF[dstLine[&um], w, rMask];
IF count <= 1 THEN EXIT;
count ¬ count - 1;
dstPtr ¬ dstPtr + dRast;
srcPtr ¬ srcPtr + sRast;
ENDLOOP;
};
ENDLOOP;
ENDCASE => {
checkUnroll: [2..256] = &unroll;
DO
nw: CARDINAL ¬ LOOPHOLE[ndw-2, CARDINAL];
BBLineSetup[];
FetchNextOff[0];
dstLine[0] ¬ MF[dstLine[0], w, lMask];
dstLine ¬ dstLine+SIZE[WORD];
srcLine ¬ srcLine+SIZE[WORD];
WHILE nw >= 4 DO
FetchNextOff[0];
dstLine[0] ¬ ?F[dstLine[0], w];
FetchNextOff[1];
dstLine[1] ¬ ?F[dstLine[1], w];
FetchNextOff[2];
dstLine[2] ¬ ?F[dstLine[2], w];
FetchNextOff[3];
dstLine[3] ¬ ?F[dstLine[3], w];
dstLine ¬ dstLine+SIZE[WORD]*4;
srcLine ¬ srcLine+SIZE[WORD]*4;
nw ¬ nw - 4;
ENDLOOP;
IF nw >= 2 THEN {
FetchNextOff[0];
dstLine[0] ¬ ?F[dstLine[0], w];
FetchNextOff[1];
dstLine[1] ¬ ?F[dstLine[1], w];
dstLine ¬ dstLine+SIZE[WORD]*2;
srcLine ¬ srcLine+SIZE[WORD]*2;
nw ¬ nw - 2;
};
IF nw = 1 THEN {
One trailing word
FetchNextOff[0];
dstLine[0] ¬ ?F[dstLine[0], w];
dstLine ¬ dstLine+SIZE[WORD];
srcLine ¬ srcLine+SIZE[WORD];
};
FetchLast[0, fetchLastWord];
dstLine[0] ¬ MF[dstLine[0], w, rMask];
IF count <= 1 THEN EXIT;
count ¬ count - 1;
dstPtr ¬ dstPtr + dRast;
srcPtr ¬ srcPtr + sRast;
ENDLOOP;
};
};
ENDLOOP;
IF lSA = 0 THEN { Inner0[] } ELSE { Inner1[] };
};
IF BITOR[sSize, fSize] # 0 THEN {
IF dstBpl MOD bpw = 0 AND srcBpl MOD bpw = 0
THEN {
-- don't need to do whole setup for each line
DoUniformLines[sSize, dst.word, dst.bit, src.word, src.bit];
}
ELSE {
-- need setup for every line
DO
DoUniformLines[1, dst.word, dst.bit, src.word, src.bit];
IF (sSize ¬ sSize - 1) = 0 THEN EXIT;
dst.word ¬ dst.word + WordFloorUnitsForBits[(dst.bit+dstBpl)];
dst.bit ¬ CARDINAL[(dst.bit+dstBpl)] MOD bpw;
src.word ¬ src.word + WordFloorUnitsForBits[(src.bit+srcBpl)];
src.bit ¬ CARDINAL[(src.bit+srcBpl)] MOD bpw;
ENDLOOP;
};
};
};
ENDLOOP;
forwardOp: PUBLIC ARRAY DstFunc OF ARRAY SrcFunc OF PROC [dst: BitAddress, src: BitAddress, dstBpl, srcBpl, sSize, fSize: CARDINAL] ¬ [[Forward0, Forward1], [Forward2, Forward3], [Forward4, Forward5], [Forward6, Forward7]];
END.