<<>> <> <> <> <> <> 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; <> 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]; <> lMask: WORD ~ rightJustifiedOnes[bpw-dstBit]; <> rMask: WORD ~ RightJustifiedZeros[ (LOOPHOLE[bpw-dstBit-fSize, CARDINAL]) MOD bpw]; <> 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; <> nsw: CARDINAL = WordsForBits[srcBit + fSize]; fetchLastWord: BOOL = IF srcBit >= dstBit THEN (nsw>ndw) ELSE (nsw>=ndw); <> FetchNext: PROC ~ INLINE { <> hi ¬ lo; lo ¬ srcLine[0]; srcLine ¬ srcLine+SIZE[WORD]; w ¬ BITLSHIFT[hi, lSA]+BITRSHIFT[lo, rSA] }; FetchNextOff: PROC [wordOffset: CARDINAL] ~ INLINE { <> 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; <> FetchNext: PROC ~ INLINE { <> w ¬ srcLine[0]; srcLine ¬ srcLine+SIZE[WORD]; }; FetchNextOff: PROC [wordOffset: CARDINAL] ~ INLINE { <> 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 => { <> 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 { <> 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.