DIRECTORY Basics, RasterBasics, RasterOp; RasterOpTileImpl: PROGRAM IMPORTS Basics EXPORTS RasterOp ~ BEGIN OPEN Basics; DstFunc: TYPE ~ RasterBasics.DstFunc; SrcFunc: TYPE ~ RasterBasics.SrcFunc; BitAddress: TYPE ~ RasterBasics.BitAddress; RawWords: TYPE ~ Basics.RawWords; bpw: CARDINAL ~ BITS[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]]] }; rightJustifiedOnes: ARRAY [0..bpw] OF WORD ~ InitRightJustifiedOnes[]; InitRightJustifiedOnes: PROC RETURNS [a: ARRAY [0..bpw] OF WORD] ~ { m: WORD ¬ 0; FOR n: CARDINAL IN [0..bpw] DO a[n] ¬ m; m ¬ m+m+1; ENDLOOP; }; RightJustifiedZeros: PROC [n: [0..bpw]] RETURNS [WORD] ~ INLINE { RETURN [BITNOT[rightJustifiedOnes[n]]] }; FOR f: NAT IN [0..8) DO unroll: INT ~ 4; usesd: BOOL ~ NOT (f=0 OR f=1);  Tile&f: PROC [dst: BitAddress, src: LONG POINTER TO RawWords, dstBpl, src0, sSizeTile, sSize, fSize: CARDINAL] ~ { dstLine: LONG POINTER TO ARRAY [0..&unroll) OF WORD; -- destination line word address ndw: CARDINAL ¬ 0; -- number of destination words per (this) line lMask: WORD; -- mask for the leftmost dest word (ones where bits are to go) rMask: WORD; -- mask for the rightmost dest word srcIndex: CARDINAL ¬ src0; SrcFetch: PROC RETURNS [WORD] ~ INLINE {RETURN[ SELECT f MOD 2 FROM 0 => {src[srcIndex]}; 1 => {BITNOT[src[srcIndex]]}; ENDCASE => ERROR; ]}; F: PROC [IF usesd THEN {d, };s: WORD] RETURNS [WORD] ~ INLINE {RETURN[ SELECT f FROM 0, 1 => {s}; 2, 3 => {BITAND[d, s]}; 4, 5 => {BITOR[d, s]}; 6, 7 => {BITXOR[d, s]}; ENDCASE => ERROR; ]}; MF: PROC [d, s, mask: WORD] RETURNS [WORD] ~ INLINE { RETURN [ IF f/2 = 2 THEN { BITOR[d, BITAND[mask, s]] } ELSE { BITXOR[BITAND[BITXOR[F[IF usesd THEN {d, };s], d], mask], d] }; ] }; LineSetup: PROC ~ INLINE { ndw ¬ WordsForBits[dst.bit + fSize]; lMask ¬ rightJustifiedOnes[bpw-dst.bit]; rMask ¬ RightJustifiedZeros[(LOOPHOLE[bpw-dst.bit-fSize, CARDINAL]) MOD bpw]; }; BBLine1: PROC ~ INLINE { dstLine[0] ¬ MF[dstLine[0], SrcFetch[], BITAND[lMask, rMask]]; }; FOR u: INT IN [2..unroll] DO  BBLine&u: PROC ~ INLINE { w: WORD ~ SrcFetch[]; dstLine[0] ¬ MF[dstLine[0], w, lMask]; FOR j: INT IN [1..u-1) DO  dstLine[&j] ¬ F[IF usesd THEN {dstLine[&j], };w]; ENDLOOP; dstLine[&u-1] ¬ MF[dstLine[&u-1], w, rMask]; }; ENDLOOP; BBLineN: PROC ~ INLINE { w: WORD ~ SrcFetch[]; dstLine[0] ¬ MF[dstLine[0], w, lMask]; dstLine ¬ dstLine+SIZE[WORD]; THROUGH [0..CARDINAL[ndw-2] / &unroll) DO FOR j: INT IN [0..unroll) DO  dstLine[&j] ¬ F[IF usesd THEN {dstLine[&j], };w]; ENDLOOP; dstLine ¬ dstLine+SIZE[ARRAY [0..&unroll) OF WORD]; ENDLOOP; THROUGH [0..CARDINAL[ndw-2] MOD &unroll) DO dstLine[0] ¬ F[IF usesd THEN {dstLine[0], };w]; dstLine ¬ dstLine+SIZE[WORD]; ENDLOOP; dstLine[0] ¬ MF[dstLine[0], w, rMask]; }; BBLine: PROC ~ INLINE { IF ndw = 1 THEN BBLine1[] ELSE BBLineN[] }; IF CARDINAL[dstBpl] MOD bpw = 0 THEN { dRast: CARD ~ WordFloorUnitsForBits[dstBpl]; LineSetup[]; SELECT ndw FROM FOR u: INT IN [1..unroll] DO  &u => { DO dstLine ¬ LOOPHOLE[dst.word]; BBLine&u[]; IF (sSize ¬ sSize - 1) = 0 THEN EXIT; dst.word ¬ dst.word + dRast; srcIndex ¬ srcIndex + 1; IF srcIndex = sSizeTile THEN srcIndex ¬ 0; ENDLOOP; }; ENDLOOP; ENDCASE => { DO dstLine ¬ LOOPHOLE[dst.word]; BBLine[]; IF (sSize ¬ sSize - 1) = 0 THEN EXIT; dst.word ¬ dst.word + dRast; srcIndex ¬ srcIndex + 1; IF srcIndex = sSizeTile THEN srcIndex ¬ 0; ENDLOOP; }; } ELSE { DO LineSetup[]; dstLine ¬ LOOPHOLE[dst.word]; BBLine[]; IF (sSize ¬ sSize - 1) = 0 THEN EXIT; dst.word ¬ dst.word + WordFloorUnitsForBits[(dst.bit+dstBpl)]; dst.bit ¬ CARDINAL[(dst.bit+dstBpl)] MOD bpw; srcIndex ¬ srcIndex + 1; IF srcIndex = sSizeTile THEN srcIndex ¬ 0; ENDLOOP; }; }; ENDLOOP; tileOp: PUBLIC ARRAY DstFunc OF ARRAY SrcFunc OF PROC [dst: BitAddress, src: LONG POINTER TO RawWords, dstBpl, src0, sSizeTile, sSize, fSize: CARDINAL] ¬ [[Tile0, Tile1], [Tile2, Tile3], [Tile4, Tile5], [Tile6, Tile7]]; END. Ά RasterOpTileImpl.meta Copyright Σ 1988, 1989, 1991 by Xerox Corporation. All rights reserved. Michael Plass, October 1, 1991 11:22 am PDT Willie-s, June 13, 1991 3:41 pm PDT RightJustifiedOnes: PROC [n: CARDINAL] RETURNS [WORD] ~ INLINE { RETURN [BITLSHIFT[1, n]-1] }; -- only one destination word -- only &u destination words -- many destination words -- don't need to do whole setup for each line -- need setup for every line Κo•NewlineDelimiter –(cedarcode) style™™Icodešœ Οeœ=™HKšœ+™+K™#—K˜KšΟk œ ˜)K˜KšΠlnœž˜Kšžœ˜Kšžœ ˜šœžœžœ˜K˜Kšœ žœ˜%Kšœ žœ˜%Kšœ žœ˜+šœ žœ˜!K˜—šœžœžœžœ˜K˜—š Οn œžœžœžœžœžœ˜AKšžœžœ˜#Kšœ˜K˜—š  œžœžœžœžœžœ˜JKš žœžœ žœžœžœ˜3Kšœ˜K˜—Kšœžœ žœžœ˜Fš  œžœžœžœ žœžœ˜DKšœžœ˜ šžœžœžœ ž˜Kšœ ˜ K˜ Kšžœ˜—Kšœ˜K˜—š  œžœžœžœžœžœ™@Kšžœž œ ™Kšœ™K™—š  œžœžœžœžœ˜AKšžœžœ˜&Kšœ˜K˜—šΠtzΠkzΟz’£’£’˜Kš‘’‘£‘˜Kš £‘’‘’£’£‘˜!š œžœžœžœžœ2žœ˜rKšœ žœžœžœžœžœžœΟc ˜UKšœžœ€.˜AKšœžœ€>˜KKšœžœ€#˜0Kšœ žœ˜š  œžœžœžœžœžœ˜/š‘’£’£’˜Kš£œ £˜Kš£žœ£˜Kš’£’£‘˜—Kšœ˜—š œžœ‘’£’£‘œ‘£‘œžœžœžœžœžœ˜Jš‘’£’˜Kš£ œ£˜Kš£ žœ£˜Kš£ žœ£˜Kš£ žœ£˜Kš’£’£‘˜—Kšœ˜—š žœžœžœžœžœžœ˜5šžœ˜š‘’£‘˜ š’£‘˜Kšžœžœ ˜Kš‘£˜—š’£‘˜Kšžœžœžœ‘’£’£‘œ‘£‘œ˜@Kš‘˜——Kšœ˜—Kšœ˜—š  œžœžœ˜Kšœ$˜$Kšœ(˜(Kšœžœžœžœ˜MKšœ˜—š œžœžœ˜Kšœ™Kšœ žœžœ˜>K˜—š ‘’£’£’£ ’‘˜š œžœžœ˜Kšœ™Kšœžœ˜Kšœ žœ˜&š ‘’£’£’£ ’‘˜Kš œ‘’£’£‘œ ‘£‘œ˜5Kš‘’£‘˜ —Kšœžœ˜,K˜—Kš‘’£‘˜ —š œžœžœ˜Kšœ™Kšœžœ˜Kšœ žœ˜&Kšœžœžœ˜šžœžœž˜)š ‘’£’£’£ ’‘˜Kš œ‘’£’£‘œ ‘£‘œ˜5Kš‘’£‘˜ —Kš œžœžœžœžœ˜3Kšžœ˜—šžœžœžœ ž˜+Kš œ‘’£’£‘œ ‘£‘œ˜3Kšœžœžœ˜Kšžœ˜—Kšœ žœ˜&K˜—Kš  œžœžœžœ žœ žœ ˜Cšžœžœ žœ˜šžœ˜Kš€-™-Kšœžœ!˜,K˜ šžœž˜š ‘’£’£’£ ’‘˜˜šž˜Kšœ žœ ˜K˜ Kšžœžœžœ˜%K˜Kšœ˜Kšžœžœ˜*Kšžœ˜—K˜—Kš‘’£‘˜ —šžœ˜ šž˜Kšœ žœ ˜K˜ Kšžœžœžœ˜%K˜Kšœ˜Kšžœžœ˜*Kšžœ˜—Kšœ˜——Kšœ˜—šžœ˜Kš€™šž˜K˜ Kšœ žœ ˜K˜ Kšžœžœžœ˜%Kšœ>˜>Kšœ žœžœ˜-Kšœ˜Kšžœžœ˜*Kšžœ˜—Kšœ˜——K˜—Kš‘’£‘˜ —K˜Kšœž œ žœžœ žœžœžœžœžœ2žœE˜Ϋ—Kšžœ˜K˜K˜—…—?