<<>>
<<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>>

    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;
            };

        <<RightJustifiedOnes: PROC [n: CARDINAL] RETURNS [WORD] ~ INLINE {>>
            <<RETURN [BITLSHIFT[1, n]-1]>>
            <<};>>
            <<>>
        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 {
                    <<-- only one destination word>>
                    dstLine[0] Ź MF[dstLine[0], SrcFetch[], BITAND[lMask, rMask]];
                    };
                FOR u: INT IN [2..unroll] DO 
                    BBLine&u: PROC ~ INLINE {
                        <<-- only &u destination words>>
                        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 {
                    <<-- many destination words>>
                    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 {
                        <<-- don't need to do whole setup for each line>>
                        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 {
                        <<-- need setup for every line>>
                        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.