<<>> <> <> <> <> <> DIRECTORY Basics, UnsafeTile; UnsafeTileImpl: PROGRAM IMPORTS Basics EXPORTS UnsafeTile = BEGIN OPEN Basics; checking: BOOL = TRUE; bpu: NAT = BITS[UNIT]; bpw: NAT = BITS[WORD]; upw: NAT = UNITS[WORD]; DstFunc: TYPE = UnsafeTile.DstFunc; BitOffset: TYPE = CARDINAL[0..bpw); BitCount: TYPE = CARDINAL[0..bpw]; Arg: TYPE = LONG POINTER TO UnsafeTile.ArgRecord; BitsPtr: TYPE = LONG POINTER TO RawBits; RawBits: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF BIT]; WordPtr: TYPE = LONG POINTER TO WORD; Op: PUBLIC UNSAFE PROC [arg: Arg] = UNCHECKED { fSizeTile: NAT = arg.fSizeTile; IF checking THEN { <> IF arg.firstBit >= fSizeTile THEN BadAssertion[]; IF arg.phase >= fSizeTile THEN BadAssertion[]; IF arg.firstLine >= arg.sSizeTile THEN BadAssertion[]; }; IF arg.fSize = 0 OR arg.sSize = 0 THEN RETURN; IF fSizeTile <= bpw THEN { <> IF BITAND[fSizeTile, fSizeTile-1] = 0 THEN Fast1[arg] <> ELSE Fast2[arg]; <> RETURN; }; Fast3[arg]; }; Fast1: PUBLIC UNSAFE PROC [arg: Arg] = UNCHECKED { tileLine: NAT ¬ arg.firstLine; firstBit: BitOffset ¬ arg.firstBit; srcBpl: NAT = arg.srcBpl; srcBit: BitOffset ¬ arg.srcBit; src: WordPtr ¬ arg.srcWord; dst: WordPtr ¬ arg.dstWord; dstBit: BitOffset ¬ arg.dstBit; fSize: NAT = arg.fSize; fSizeTile: BitCount = arg.fSizeTile; sSizeTile: NAT = arg.sSizeTile; sSize: NAT ¬ arg.sSize; sw: WORD; invert: WORD = arg.srcInvert; FetchSource: PROC = INLINE { <> k: BitCount ¬ fSizeTile; sw ¬ BITXOR[src­, invert]; IF srcBit # 0 THEN { <> sw ¬ BITLSHIFT[sw, srcBit]; IF srcBit+k > bpw THEN sw ¬ sw + BITRSHIFT[BITXOR[(src+upw)­, invert], bpw-srcBit]; }; IF k < bpw THEN { <> sw ¬ BITAND[sw, BITLSHIFT[WORD.LAST, bpw-k]]; DO sw ¬ sw + BITRSHIFT[sw, k]; k ¬ k + k; IF k = bpw THEN EXIT; ENDLOOP; }; IF firstBit # 0 THEN sw ¬ BITLSHIFT[sw, firstBit] + BITRSHIFT[sw, bpw-firstBit]; <> }; DoFastLine1: PROC [df: DstFunc] = INLINE { <> rem: NAT ¬ fSize; dwp: WordPtr ¬ dst; IF dstBit # 0 THEN { <> dw: WORD ¬ dwp­; mask: WORD ¬ BITRSHIFT[WORD.LAST, dstBit]; rw: WORD = BITRSHIFT[sw, dstBit]; rem ¬ rem + dstBit; IF rem < bpw THEN mask ¬ BITXOR[mask, BITRSHIFT[WORD.LAST, rem]]; SELECT df FROM null => dwp­ ¬ BITAND[dw, BITNOT[mask]] + BITAND[rw, mask]; and => dwp­ ¬ BITAND[dw, BITNOT[mask]] + BITAND[BITAND[dw, rw], mask]; or => dwp­ ¬ BITAND[dw, BITNOT[mask]] + BITAND[BITOR[dw, rw], mask]; xor => dwp­ ¬ BITAND[dw, BITNOT[mask]] + BITAND[BITXOR[dw, rw], mask]; ENDCASE; IF rem <= bpw THEN GO TO done; <> sw ¬ BITLSHIFT[sw, bpw-dstBit] + rw; rem ¬ rem - bpw; dwp ¬ dwp + upw; }; WHILE rem >= bpw*2 DO <> SELECT df FROM null => {dwp­ ¬ sw; (dwp+upw)­ ¬ sw}; and => {dwp­ ¬ BITAND[dwp­, sw]; (dwp+upw)­ ¬ BITAND[(dwp+upw)­, sw]}; or => {dwp­ ¬ BITOR[dwp­, sw]; (dwp+upw)­ ¬ BITOR[(dwp+upw)­, sw]}; xor => {dwp­ ¬ BITXOR[dwp­, sw]; (dwp+upw)­ ¬ BITXOR[(dwp+upw)­, sw]}; ENDCASE; rem ¬ rem - bpw*2; dwp ¬ dwp + upw*2; ENDLOOP; IF rem >= bpw THEN { <> SELECT df FROM null => dwp­ ¬ sw; and => dwp­ ¬ BITAND[dwp­, sw]; or => dwp­ ¬ BITOR[dwp­, sw]; ENDCASE => dwp­ ¬ BITXOR[dwp­, sw]; rem ¬ rem - bpw; dwp ¬ dwp + upw; }; IF rem # 0 THEN { <> mask: WORD = BITRSHIFT[WORD.LAST, rem]; dw: WORD = dwp­; SELECT df FROM null => dwp­ ¬ BITAND[dw, mask] + BITAND[sw, BITNOT[mask]]; and => dwp­ ¬ BITAND[dw, mask] + BITAND[BITAND[dw, sw], BITNOT[mask]]; or => dwp­ ¬ BITAND[dw, mask] + BITAND[BITOR[dw, sw], BITNOT[mask]]; xor => dwp­ ¬ BITAND[dw, mask] + BITAND[BITXOR[dw, sw], BITNOT[mask]]; ENDCASE; }; EXITS done => {}; }; BumpDst: PROC = INLINE { <> next: NAT = dstBit + arg.dstBpl; dstBit ¬ next MOD bpw; dst ¬ dst + NAT[next-dstBit] / bpu; }; BumpSrc: PROC = INLINE { <> next: NAT = srcBit + srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit] / bpu; tileLine ¬ tileLine+1; IF tileLine = sSizeTile THEN { <> firstBit ¬ BITAND[firstBit + (fSizeTile-arg.phase), fSizeTile-1]; tileLine ¬ 0; srcBit ¬ arg.srcBit; src ¬ arg.srcWord; }; }; WithFunction: PROC [df: DstFunc] = INLINE { DO FetchSource[]; DoFastLine1[df]; IF sSize = 1 THEN EXIT; sSize ¬ sSize - 1; BumpDst[]; BumpSrc[]; ENDLOOP; }; IF checking AND BITAND[fSizeTile, fSizeTile-1] # 0 THEN BadAssertion[]; <> IF sSize # 0 THEN { IF tileLine # 0 THEN { <> next: NAT ¬ srcBit + tileLine*srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit]/bpu; }; <> SELECT arg.dstFunc FROM null => WithFunction[null]; and => WithFunction[and]; or => WithFunction[or]; ENDCASE => WithFunction[xor]; }; }; Fast2: PUBLIC UNSAFE PROC [arg: Arg] = UNCHECKED { <> BumpDst: PROC = INLINE { <> next: NAT = dstBit + arg.dstBpl; dstBit ¬ next MOD bpw; dst ¬ dst + NAT[next-dstBit] / bpu; }; BumpSrc: PROC = INLINE { <> next: NAT = srcBit + arg.srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit] / bpu; tileLine ¬ tileLine+1; IF tileLine = arg.sSizeTile THEN { phase: NAT = arg.phase; IF firstBit < phase THEN firstBit ¬ firstBit + (fSizeTile-phase) ELSE firstBit ¬ firstBit - phase; tileLine ¬ 0; srcBit ¬ arg.srcBit; src ¬ arg.srcWord; }; }; GetSrc: PROC = INLINE { <> comp: BitOffset = bpw-fSizeTile; sw ¬ BITXOR[src­, invert]; IF srcBit # 0 THEN { lim: NAT = srcBit+fSizeTile; sw ¬ BITLSHIFT[sw, srcBit]; IF lim > bpw THEN sw ¬ sw + BITRSHIFT[BITXOR[(src+upw)­, invert], bpw-srcBit]; }; IF fSizeTile <= bpw/2 THEN sw ¬ BITRSHIFT[sw, comp] * replicatorMultArray[fSizeTile] <> ELSE sw ¬ BITAND[sw, BITLSHIFT[WORD.LAST, comp]]; }; tileLine: NAT ¬ arg.firstLine; firstBit: BitOffset ¬ arg.firstBit; srcBit: BitOffset ¬ arg.srcBit; src: WordPtr ¬ arg.srcWord; dst: WordPtr ¬ arg.dstWord; dstBit: BitOffset ¬ arg.dstBit; fSizeTile: NAT = arg.fSizeTile; tBits: NAT = replicatorBitsArray[fSizeTile]; sSize: NAT ¬ arg.sSize; invert: WORD = arg.srcInvert; df: DstFunc = arg.dstFunc; sw: WORD ¬ 0; -- initialized to keep compiler happy IF checking AND fSizeTile > bpw THEN BadAssertion[]; <> IF sSize # 0 AND arg.fSize # 0 THEN { IF tileLine # 0 THEN { <> next: NAT ¬ srcBit + tileLine*arg.srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit]/bpu; }; DO <> rem: NAT ¬ arg.fSize; -- remaining bits in dst line xBits: NAT ¬ bpw-dstBit; -- bits to move dwp: WordPtr ¬ dst; -- dst word ptr within line shift: NAT ¬ firstBit; dShift: NAT ¬ dstBit; DoFastLine2: PROC [df: DstFunc] = INLINE { DO <> tw: WORD ¬ BITLSHIFT[sw, shift]; valid: NAT ¬ tBits - shift; IF rem < xBits THEN xBits ¬ rem; WHILE valid < xBits DO tw ¬ BITRSHIFT[sw, valid] + tw; valid ¬ valid + tBits; ENDLOOP; PutFieldInline[dwp, dShift, tw, xBits, df]; IF rem = xBits THEN EXIT; shift ¬ shift + xBits; WHILE shift >= tBits DO shift ¬ shift - tBits; ENDLOOP; dwp ¬ dwp + upw; dShift ¬ 0; rem ¬ rem - xBits; xBits ¬ bpw; IF rem < bpw THEN xBits ¬ rem; ENDLOOP; }; GetSrc[]; SELECT df FROM null => DoFastLine2[null]; and => DoFastLine2[and]; or => DoFastLine2[or]; ENDCASE => DoFastLine2[xor]; IF sSize = 1 THEN EXIT; sSize ¬ sSize - 1; BumpSrc[]; BumpDst[]; ENDLOOP; }; }; Fast3: PUBLIC PROC [arg: Arg] = { < bpw.>> BumpDst: PROC = INLINE { <> next: NAT = dstBit + arg.dstBpl; dstBit ¬ next MOD bpw; dst ¬ dst + NAT[next-dstBit] / bpu; }; BumpSrc: PROC = INLINE { <> next: NAT = srcBit + arg.srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit] / bpu; tileLine ¬ tileLine+1; IF tileLine = arg.sSizeTile THEN { phase: NAT = arg.phase; IF firstBit < phase THEN firstBit ¬ firstBit + (fSizeTile-phase) ELSE firstBit ¬ firstBit - phase; tileLine ¬ 0; srcBit ¬ arg.srcBit; src ¬ arg.srcWord; }; }; tileLine: NAT ¬ arg.firstLine; firstBit: NAT ¬ arg.firstBit; srcBit: BitOffset ¬ arg.srcBit; src: WordPtr ¬ arg.srcWord; dst: WordPtr ¬ arg.dstWord; dstBit: BitOffset ¬ arg.dstBit; fSizeTile: NAT = arg.fSizeTile; sSize: NAT ¬ arg.sSize; IF sSize # 0 AND arg.fSize # 0 THEN { IF tileLine # 0 THEN { <> next: NAT = srcBit + tileLine*arg.srcBpl; srcBit ¬ next MOD bpw; src ¬ src + NAT[next-srcBit]/bpu; }; DO <> DoLine[arg, dst, dstBit, src, srcBit, firstBit]; IF sSize = 1 THEN EXIT; sSize ¬ sSize - 1; BumpSrc[]; BumpDst[]; ENDLOOP; }; }; DoLine: PROC [arg: Arg, dwp: WordPtr, dstPos: BitOffset, src: WordPtr, srcBit: BitOffset, firstBit: NAT] = { <> invert: WORD = arg.srcInvert; dstRem: NAT ¬ arg.fSize; fSizeTile: NAT = arg.fSizeTile; srcRem: NAT ¬ fSizeTile-firstBit; srcPos: BitOffset ¬ (firstBit+srcBit) MOD bpw; swp: WordPtr ¬ src + NAT[(firstBit+srcBit) - srcPos] / bpu; WithFunction: PROC [df: DstFunc] = --INLINE-- { DO next: NAT; sw: WORD ¬ BITXOR[swp­, invert]; xBits: BitCount ¬ bpw-dstPos; IF dstRem < xBits THEN xBits ¬ dstRem; IF srcRem < xBits THEN { <> IF srcPos # 0 THEN { <> sw ¬ BITLSHIFT[sw, srcPos]; IF srcPos+srcRem > bpw THEN sw ¬ sw + BITRSHIFT[BITXOR[(swp+upw)­, invert], bpw-srcPos]; }; sw ¬ BITAND[sw, BITLSHIFT[WORD.LAST, bpw-srcRem]] + BITRSHIFT[BITLSHIFT[BITXOR[src­, invert], srcBit], srcRem]; next ¬ bpw-srcBit; IF fSizeTile < next THEN next ¬ fSizeTile; <> next ¬ srcRem + next; <> IF next < xBits THEN xBits ¬ next; <> } ELSE { <> IF srcPos # 0 THEN { <> sw ¬ BITLSHIFT[sw, srcPos]; IF srcPos+xBits > bpw THEN sw ¬ sw + BITRSHIFT[BITXOR[(swp+upw)­, invert], bpw-srcPos]; }; }; IF xBits = bpw THEN { <> SELECT df FROM null => dwp­ ¬ sw; and => dwp­ ¬ BITAND[dwp­, sw]; or => dwp­ ¬ BITOR[dwp­, sw]; ENDCASE => dwp­ ¬ BITXOR[dwp­, sw]; IF xBits = dstRem THEN EXIT; dwp ¬ dwp + upw; dstRem ¬ dstRem - xBits; IF srcRem > xBits THEN { swp ¬ swp + upw; srcRem ¬ srcRem - xBits; LOOP; }; } ELSE { <> PutFieldInline[dwp, dstPos, sw, xBits, df]; IF xBits = dstRem THEN EXIT; <> next ¬ dstPos+xBits; dstPos ¬ next MOD bpw; dwp ¬ dwp + NAT[next - dstPos] / bpu; dstRem ¬ dstRem - xBits; <> IF srcRem > xBits THEN { next ¬ srcPos+xBits; srcPos ¬ next MOD bpw; swp ¬ swp + NAT[next - srcPos] / bpu; srcRem ¬ srcRem - xBits; LOOP; }; }; IF srcRem < xBits THEN { <> next ¬ xBits - srcRem; srcRem ¬ fSizeTile - next; next ¬ srcBit + next; srcPos ¬ next MOD bpw; swp ¬ src + (next-srcPos) / bpu; IF srcRem # 0 THEN LOOP; }; <> swp ¬ src; srcPos ¬ srcBit; srcRem ¬ fSizeTile; ENDLOOP; }; SELECT arg.dstFunc FROM null => WithFunction[null]; and => WithFunction[and]; or => WithFunction[or]; ENDCASE => WithFunction[xor]; }; PutWordInline: PROC [dst: WordPtr, sw: WORD, df: DstFunc] = INLINE { SELECT df FROM null => dst­ ¬ sw; and => dst­ ¬ BITAND[dst­, sw]; or => dst­ ¬ BITOR[dst­, sw]; ENDCASE => dst­ ¬ BITXOR[dst­, sw]; }; PutFieldInline: PROC [dst: WordPtr, dstMod: BitOffset, w: WORD, bits: BitCount, df: DstFunc] = INLINE { SELECT TRUE FROM dstMod # 0 => { <> dstLim: NAT = dstMod + bits; mask: WORD ¬ BITRSHIFT[WORD.LAST, dstMod]; dstW: WORD ¬ dst­; tw: WORD ¬ BITRSHIFT[w, dstMod]; IF dstLim < bpw THEN mask ¬ mask - BITRSHIFT[mask, bits]; SELECT df FROM null => {}; and => tw ¬ BITAND[dstW, tw]; or => tw ¬ BITOR[dstW, tw]; ENDCASE => tw ¬ BITXOR[dstW, tw]; dst­ ¬ BITAND[dstW, BITNOT[mask]] + BITAND[tw, mask]; IF dstLim > bpw THEN { <> mask ¬ BITRSHIFT[WORD.LAST, dstLim MOD bpw]; dstW ¬ (dst+upw)­; tw ¬ BITLSHIFT[w, bpw-dstMod]; SELECT df FROM null => {}; and => tw ¬ BITAND[dstW, tw]; or => tw ¬ BITOR[dstW, tw]; ENDCASE => tw ¬ BITXOR[dstW, tw]; (dst+upw)­ ¬ BITAND[tw, BITNOT[mask]] + BITAND[dstW, mask]; }; }; bits # bpw => { <> mask: WORD = BITRSHIFT[WORD.LAST, bits]; dstW: WORD = dst­; tw: WORD ¬ w; SELECT df FROM null => {}; and => tw ¬ BITAND[dstW, tw]; or => tw ¬ BITOR[dstW, tw]; ENDCASE => tw ¬ BITXOR[dstW, tw]; dst­ ¬ BITAND[dstW, mask] + BITAND[tw, BITNOT[mask]]; }; ENDCASE => <> SELECT df FROM null => dst­ ¬ w; and => dst­ ¬ BITAND[dst­, w]; or => dst­ ¬ BITOR[dst­, w]; ENDCASE => dst­ ¬ BITXOR[dst­, w]; }; DumbOp: PUBLIC UNSAFE PROC [arg: Arg] = UNCHECKED { <> tileLine: NAT ¬ arg.firstLine; adjustedFirstBit: NAT ¬ arg.firstBit; src: WordPtr = LOOPHOLE[arg.srcWord]; dst: BitsPtr = LOOPHOLE[arg.dstWord]; dstBpl: NAT = arg.dstBpl; dstBit: NAT ¬ arg.dstBit; srcBpl: NAT = arg.srcBpl; phase: NAT = arg.phase; fSize: NAT = arg.fSize; fSizeTile: NAT = arg.fSizeTile; sSizeTile: NAT = arg.sSizeTile; sSize: NAT ¬ arg.sSize; srcBit: NAT ¬ arg.srcBit+srcBpl*tileLine; invert: WORD = arg.srcInvert; df: DstFunc = arg.dstFunc; IF checking THEN { <> IF arg.firstBit >= fSizeTile THEN BadAssertion[]; IF arg.phase >= fSizeTile THEN BadAssertion[]; IF arg.firstLine >= arg.sSizeTile THEN BadAssertion[]; }; IF arg.fSize = 0 OR arg.sSize = 0 THEN RETURN; FOR s: NAT IN [0..arg.sSize) DO dstLim: NAT = dstBit+fSize; tileBit: NAT ¬ adjustedFirstBit; dBit: NAT ¬ dstBit; DO sBit: NAT ¬ srcBit+tileBit; mod: BitOffset ¬ sBit MOD bpw; sw: WORD ¬ BITXOR[(src+(sBit - mod) / bpu)­, invert]; sb: BIT ¬ BITRSHIFT[BITLSHIFT[sw, mod], bpw - 1]; SELECT df FROM null => dst[dBit] ¬ sb; and => dst[dBit] ¬ BITAND[dst[dBit], sb]; or => dst[dBit] ¬ BITOR[dst[dBit], sb]; xor => dst[dBit] ¬ BITXOR[dst[dBit], sb]; ENDCASE => BadAssertion[]; dBit ¬ dBit + 1; IF dBit = dstLim THEN EXIT; tileBit ¬ tileBit + 1; IF tileBit >= fSizeTile THEN tileBit ¬ 0; ENDLOOP; dstBit ¬ dstBit + dstBpl; srcBit ¬ srcBit + srcBpl; tileLine ¬ tileLine+1; IF tileLine = sSizeTile THEN { IF adjustedFirstBit < phase THEN adjustedFirstBit ¬ adjustedFirstBit + (fSizeTile-phase) ELSE adjustedFirstBit ¬ adjustedFirstBit - phase; tileLine ¬ 0; srcBit ¬ arg.srcBit; }; ENDLOOP; }; <> FunnyOp: PROC [dw: WORD, sw: WORD, op: DstFunc] RETURNS [WORD] = { <> <> <> <> <> m1: WORD ¬ IF op = and OR op = or THEN WORD.LAST ELSE 0; <> m2: WORD ¬ IF op # and THEN WORD.LAST ELSE 0; <> m3: WORD ¬ IF op = or OR op = xor THEN WORD.LAST ELSE 0; <> <> w1: WORD = BITAND[sw, m1]; <> w2: WORD = BITAND[sw, m2]; <> w3: WORD = BITAND[dw, m3]; <> w4: WORD = BITXOR[w2, w3]; <> w5: WORD = BITAND[dw, w1]; <> w6: WORD = BITOR[w4, w5]; <> RETURN [w6]; }; FunWithMasks: PROC [dw, sw, m1, m2, m3: WORD] RETURNS [WORD] = INLINE { RETURN [BITOR[BITXOR[BITAND[sw, m2], BITAND[dw, m3]], BITAND[dw, BITAND[sw, m1]]]]; }; <> mask1Array: ARRAY DstFunc OF WORD = [ null: 0, and: WORD.LAST, or: WORD.LAST, xor: 0]; mask2Array: ARRAY DstFunc OF WORD = [ null: WORD.LAST, and: 0, or: WORD.LAST, xor: WORD.LAST]; mask3Array: ARRAY DstFunc OF WORD = [ null: 0, and: 0, or: WORD.LAST, xor: WORD.LAST]; replicatorMultArray: ReplicatorArray ¬ ALL[0]; replicatorBitsArray: ReplicatorArray ¬ ALL[0]; ReplicatorArray: TYPE = ARRAY [0..bpw] OF WORD; BadAssertion: PROC = { ERROR AssertionFailed; }; AssertionFailed: ERROR = CODE; InitReplicatorArray: PROC = { replicatorMultArray[0] ¬ 0; replicatorBitsArray[0] ¬ 0; replicatorMultArray[1] ¬ WORD.LAST; replicatorBitsArray[1] ¬ bpw; replicatorMultArray[bpw] ¬ 1; replicatorBitsArray[bpw] ¬ 1; FOR i: NAT IN [2..bpw) DO t: WORD ¬ BITRSHIFT[WORD.LAST, i-1]-BITRSHIFT[WORD.LAST, i]; tt: WORD ¬ 0; WHILE t # 0 DO tt ¬ tt + t; t ¬ BITRSHIFT[t, i]; ENDLOOP; replicatorMultArray[i] ¬ tt; replicatorBitsArray[i] ¬ bpw - (bpw MOD i); ENDLOOP; }; InitReplicatorArray[]; END.