<<>> <> <> <> <> <<>> DIRECTORY Basics, ImagerError, ImagerPixelArray, ImagerPixelArrayPrivate, ImagerSample, IO, PixelArrayCCITTG4, PixelArrayCCITTG4Private, RasterBasics, RasterOp, Rope, SafeStorage, SF; PixelArrayCCITTG4Impl: MONITOR LOCKS data USING data: Data IMPORTS Basics, ImagerError, ImagerPixelArrayPrivate, ImagerSample, IO, RasterOp, SafeStorage EXPORTS ImagerPixelArray, PixelArrayCCITTG4, PixelArrayCCITTG4Private ~ BEGIN OPEN PixelArrayCCITTG4Private; PixelArrayClassRep: PUBLIC TYPE ~ ImagerPixelArrayPrivate.PixelArrayClassRep; bpw: NAT = BITS[WORD]; maxNeed: NAT = bpw-BITS[BYTE]; <> BitCount: TYPE = [0..bpw); BytesPtr: TYPE = POINTER TO Basics.RawBytes; IntPtr: TYPE = POINTER TO RECORD [SEQUENCE COMPUTED CARD OF INT]; CardPtr: TYPE = POINTER TO RECORD [SEQUENCE COMPUTED CARD OF CARD]; WordsPtr: TYPE = POINTER TO Basics.RawWords; ROPE: TYPE ~ Rope.ROPE; keepCounts: BOOL = TRUE; useDebug: BOOL = TRUE; pureDebug: BOOL = TRUE; defaultFastScan: BOOL ¬ TRUE; useFastDebug: BOOL = FALSE; keepFastCounts: BOOL = FALSE; fastScanEntries: CARD ¬ 0; fastScanLoops: CARD ¬ 0; fastScanScans: CARD ¬ 0; fastScanPass: CARD ¬ 0; fastScanHoriz: CARD ¬ 0; makePureCalls: CARD ¬ 0; advanceCalls: CARD ¬ 0; resetCalls: CARD ¬ 0; orBltCalls: CARD ¬ 0; moveLineCalls: CARD ¬ 0; sparsity: NAT ¬ 16; colorNames: ARRAY BIT OF ROPE = ["white", "black"]; dummy: Data ~ NEW[DataRep]; -- Used as lock for BuildRoots, holder for scratch stream <> ClipZero: PROC [x: INTEGER] RETURNS [NAT] = INLINE { <> RETURN [LOOPHOLE[Basics.BITAND[LOOPHOLE[x, WORD], Basics.BITRSHIFT[LOOPHOLE[x, WORD], bpw-1]-1], NAT]] }; ColorFromState: PROC [state: State] RETURNS [[0..1]] ~ INLINE { RETURN [ORD[state] MOD 2]; }; GetRunEntry: PROC [color: BIT, x: WORD] RETURNS [RunTabEntry] ~ INLINE { RETURN [runTabRef[(color * (2*runTableMod) + x) MOD (RunTabIndex.LAST+1)]]; }; GetTransition: PROC [lineTransitions: REF IndexSequenceRep, i: CARDINAL] RETURNS [INTEGER] ~ TRUSTED INLINE { RETURN [(LOOPHOLE[lineTransitions, IntPtr]+SIZE[IndexSequenceRep[0]])[i]]; }; SetTransition: PROC [lineTransitions: REF IndexSequenceRep, i: CARDINAL, j: INT] ~ TRUSTED INLINE { (LOOPHOLE[lineTransitions, IntPtr]+SIZE[IndexSequenceRep[0]])[i] ¬ j; }; <> FromStream: PUBLIC SAFE PROC [st: IO.STREAM, bitsPerLine: CARDINAL] RETURNS [Data] = CHECKED { data: Data ¬ NEW[DataRep ¬ []]; data.scanLength ¬ bitsPerLine; data.stream ¬ st; data.initIndex ¬ -1; -- means not known! data.useFastScan ¬ defaultFastScan; RETURN [data]; }; FillLineBuffer: PUBLIC SAFE PROC [data: Data, s: INTEGER, invert: BOOL ¬ FALSE] = TRUSTED { <> lineBuffer: ImagerSample.RasterSampleMap ¬ data.lineBuffer; IF lineBuffer # NIL THEN { copyData: CopyData ¬ data.copyData; IF copyData # NIL THEN { IF s >= data.sSize THEN data.end ¬ TRUE; data.sCurrent ¬ s; data.lineBufferValid ¬ FALSE; } ELSE { IF data.roots = NIL OR data.sCurrent > s THEN Reset[data]; UNTIL data.end OR data.sCurrent = s DO Advance[data] ENDLOOP; }; IF NOT data.lineBufferValid THEN { scanLength: NAT ~ data.scanLength; base: ImagerSample.BitAddress; linePtr: POINTER TO Basics.RawBits; base ¬ ImagerSample.GetBase[lineBuffer]; linePtr ¬ LOOPHOLE[base.word]; IF data.copyData # NIL THEN WITH data.copyData[data.sCurrent] SELECT FROM literal: REF Basics.RawBits => { <> IF invert THEN RasterOp.forwardOp[null][complement] [ dst: base, src: [LOOPHOLE[literal], 0], dstBpl: scanLength, srcBpl: scanLength, sSize: 1, fSize: scanLength] ELSE Basics.MoveBits[ dstBase: linePtr, dstStart: base.bit, srcBase: LOOPHOLE[literal], srcStart: 0, count: scanLength]; GO TO nowValid; }; trans: REF IndexSequenceRep => data.referenceTransitions ¬ trans; <> ENDCASE => ERROR; MoveLine[data: data, dstBase: linePtr, dstBitIndex: base.bit, min: 0, max: scanLength, invert: invert]; GO TO nowValid; EXITS nowValid => data.lineBufferValid ¬ TRUE; }; }; }; Close: PUBLIC ENTRY SAFE PROC [data: Data] = TRUSTED { data.stream ¬ NIL; }; MakePure: PUBLIC ENTRY SAFE PROC [data: Data] = TRUSTED { ENABLE { IO.EndOfStream => { ErrorEOF[data]; CONTINUE }; UNWIND => NULL; }; InternalPure[data]; }; InternalPure: PROC [data: Data] = { copyData: CopyData ¬ data.copyData; IF copyData = NIL THEN { <> fSize: NAT = data.scanLength; untracedZone: ZONE ~ SafeStorage.GetUntracedZone[]; copyLen: NAT ¬ 0; lim: NAT = IF data.sSize < 0 THEN NAT.LAST ELSE data.sSize; nextS: NAT ¬ 0; makePureCalls ¬ makePureCalls + 1; IF pureDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "InternalPure, fSize = %g\n", [integer[fSize]]]; FOR s: NAT IN [0..lim) WHILE NOT data.end DO line: REF ¬ NIL; end: CARDINAL ¬ 0; IF pureDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "InternalPure, s = %g\n", [integer[s]]]; IF data.roots = NIL OR data.sCurrent > s THEN Reset[data]; UNTIL data.end OR data.sCurrent = s DO Advance[data] ENDLOOP; IF data.end THEN EXIT; IF data.referenceTransitions = NIL THEN ERROR; end ¬ data.referenceTransitions.end; IF BITS[IndexSequenceRep[end]] >= fSize THEN { <> line ¬ untracedZone.NEW[Basics.RawBits[fSize]]; IF pureDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "InternalPure, bits %g\n", [integer[fSize]]]; MoveLine[data: data, dstBase: LOOPHOLE[line], dstBitIndex: 0, min: 0, max: fSize]; } ELSE { <> new: REF IndexSequenceRep ¬ untracedZone.NEW[IndexSequenceRep[end]]; IF pureDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "InternalPure, runs %g\n", [integer[end]]]; Basics.MoveWords[ dst: LOOPHOLE[@new[0]], src: LOOPHOLE[@data.referenceTransitions[0]], count: WORDS[IndexSequenceRep[end]]-WORDS[IndexSequenceRep[0]]]; new.end ¬ end; line ¬ new; }; IF s > lim THEN ERROR; IF s >= copyLen THEN { rLen: NAT = IF lim < NAT.LAST THEN lim ELSE copyLen+copyLen/2+8; revised: CopyData ¬ NEW[CopyDataRep[rLen]]; IF copyLen # 0 THEN Basics.MoveWords[ dst: LOOPHOLE[@revised[0]], src: LOOPHOLE[@copyData[0]], count: WORDS[CopyDataRep[copyLen]]-WORDS[CopyDataRep[0]]]; copyLen ¬ rLen; copyData ¬ revised; }; copyData[s] ¬ line; nextS ¬ s+1; ENDLOOP; IF pureDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "InternalPure, sSize = %g\n", [integer[nextS]]]; data.sSize ¬ nextS; data.copyData ¬ copyData; data.end ¬ FALSE; }; }; <> FormatErrorDesc: ENTRY PROC [data: Data] RETURNS [ImagerError.ErrorDesc] ~ { error: ATOM = data.error; errorIndex: CARD = data.errorIndex; IF error = NIL THEN RETURN [[ok, NIL, NIL]]; data.error ¬ NIL; data.errorIndex ¬ 0; data.errorCount ¬ data.errorCount + 1; RETURN [[ $invalidCompressedSequence, IO.PutFLR["Error in CCITT-G4 encoding %g near bit index %g", LIST[[atom[error]], [cardinal[errorIndex]]]], LIST[[$ccittg4error, error], [$bitIndex, NEW[CARD ¬ errorIndex]]] ]]; }; WithData: PROC [proc: PROC [data: Data], ref: REF] ~ { WITH ref SELECT FROM data: Data => { proc[data]; IF data.error # NIL THEN { desc: ImagerError.ErrorDesc ~ FormatErrorDesc[data]; IF desc.code # ok THEN { IF data.errorCount >= 20 THEN ERROR ImagerError.Error[desc]; SIGNAL ImagerError.Warning[desc]; }; }; }; ENDCASE => ERROR; -- can't happen }; <> G4PixelArrayFromStream: PUBLIC SAFE PROC [st: IO.STREAM, lines: CARDINAL, bitsPerLine: CARDINAL] RETURNS [ImagerPixelArray.PixelArray] ~ CHECKED { data: Data = FromStream[st, bitsPerLine]; RETURN [G4PixelArrayFromData[data, lines, bitsPerLine]]; }; G4PixelArrayFromData: PUBLIC SAFE PROC [data: Data, lines: CARDINAL, bitsPerLine: CARDINAL] RETURNS [ImagerPixelArray.PixelArray] ~ TRUSTED { pa: ImagerPixelArray.PixelArray ¬ NEW [ImagerPixelArray.PixelArrayRep ¬ [ immutable: FALSE, samplesPerPixel: 1, sSize: lines, fSize: bitsPerLine, m: NIL, -- caller fills this in class: classCCITT4PixelArray, data: data ]]; RETURN [pa]; }; classCCITT4PixelArray: ImagerPixelArrayPrivate.PixelArrayClass ~ ImagerPixelArrayPrivate.NewClass[ type: $XeroxCCITT4, MaxSampleValue: XeroxCCITT4MaxSampleValue, Get: NIL, GetSamples: XeroxCCITT4GetSamples, Transfer: XeroxCCITT4Transfer, Copy: XeroxCCITT4Copy ]; XeroxCCITT4MaxSampleValue: SAFE PROC [pa: ImagerPixelArray.PixelArray, i: NAT] RETURNS [ImagerPixelArray.Sample] ~ CHECKED {RETURN [1]}; XeroxCCITT4GetSamples: SAFE PROC [pa: ImagerPixelArray.PixelArray, i: NAT, s, f: INT, buffer: ImagerSample.SampleBuffer, start: NAT, count: NAT] ~ TRUSTED { Inner: ENTRY PROC [data: Data] ~ { ENABLE { IO.EndOfStream => { ErrorEOF[data]; CONTINUE }; UNWIND => NULL; }; FillLineBuffer[data, s]; ImagerSample.GetSamples[map: data.lineBuffer, initIndex: [0, f], buffer: buffer, start: start, count: count]; }; WithData[Inner, pa.data]; }; XeroxCCITT4Transfer: SAFE PROC [pa: ImagerPixelArray.PixelArray, i: NAT, s, f: INT, dst: ImagerSample.SampleMap, dstMin: SF.Vec, size: SF.Vec, function: ImagerSample.Function] ~ TRUSTED { Inner: ENTRY PROC [data: Data] ~ { ENABLE { IO.EndOfStream => { ErrorEOF[data]; CONTINUE }; UNWIND => NULL; }; dstRaster: ImagerSample.RasterSampleMap ~ WITH dst SELECT FROM d: ImagerSample.RasterSampleMap => d ENDCASE => NIL; sSize: NAT ~ size.s; fSize: NAT ~ size.f; copyData: CopyData = data.copyData; IF copyData # NIL THEN { IF s >= data.sSize THEN {data.end ¬ TRUE; GO TO endErr}; data.sCurrent ¬ s; data.lineBufferValid ¬ FALSE; } ELSE { IF data.roots = NIL OR data.sCurrent > s THEN Reset[data]; UNTIL data.end OR data.sCurrent = s DO Advance[data] ENDLOOP; }; IF (function = [or, null] OR function = [null, null]) AND dstRaster # NIL AND ImagerSample.GetBitsPerSample[dstRaster] = 1 THEN { <> box: SF.Box ~ ImagerSample.GetBox[dstRaster]; base: RasterBasics.BitAddress ~ ImagerSample.GetBase[dstRaster]; bpl: NAT ~ ImagerSample.GetBitsPerLine[dstRaster]; dstBase: POINTER TO Basics.RawBits ~ LOOPHOLE[base.word]; lineIndex: CARD ~ dstMin.s-box.min.s; pixelIndex: CARD ~ dstMin.f-box.min.f; dmaxs: INT ~ dstMin.s+sSize; sSpace: CARD ~ box.max.s-dmaxs; -- for bounds check below. dmaxf: INT ~ dstMin.f+fSize; fSpace: CARD ~ box.max.f-dmaxf; -- for bounds check below. endf: NAT = f+fSize; fSpaceSrc: CARD ~ data.scanLength - endf; -- for bounds check below. bitIndex: CARD ¬ lineIndex * bpl + pixelIndex + base.bit; IF Basics.BITOR[Basics.BITOR[Basics.BITOR[Basics.BITOR[Basics.BITOR[ lineIndex, pixelIndex], sSpace], fSpace], fSpaceSrc], f] > NAT.LAST THEN <> Basics.RaiseBoundsFault[]; IF copyData # NIL THEN { <> FOR sSrc: INT IN [s..s+size.s) DO WITH data.copyData[s] SELECT FROM literal: REF Basics.RawBits => <> RasterOp.forwardOp[function.dstFunc][null] [ dst: [LOOPHOLE[dstBase], bitIndex], src: [LOOPHOLE[literal], 0], dstBpl: BITS[WORD], srcBpl: BITS[WORD], sSize: 1, fSize: fSize]; trans: REF IndexSequenceRep => { <> data.referenceTransitions ¬ trans; IF function = [or, null] THEN OrBltLine[data: data, dstBase: dstBase, dstBitIndex: bitIndex, min: f, max: endf] ELSE MoveLine[data: data, dstBase: dstBase, dstBitIndex: bitIndex, min: f, max: endf]; }; ENDCASE => GO TO endErr; bitIndex ¬ bitIndex + bpl; ENDLOOP; GO TO free; }; FOR sSrc: INT IN [s..s+size.s) DO UNTIL data.end OR data.sCurrent = sSrc DO Advance[data] ENDLOOP; IF data.end THEN GO TO endErr; IF function = [or, null] THEN OrBltLine[data: data, dstBase: dstBase, dstBitIndex: bitIndex, min: f, max: endf] ELSE MoveLine[data: data, dstBase: dstBase, dstBitIndex: bitIndex, min: f, max: endf]; bitIndex ¬ bitIndex + bpl; ENDLOOP; } ELSE { IF data.lineBuffer = NIL THEN { data.lineBuffer ¬ ImagerSample.ObtainScratchMap[[max: [1, data.scanLength]]]; needFree ¬ TRUE; }; FOR sSrc: INT IN [s..s+size.s) DO FillLineBuffer[data, sSrc]; IF data.end THEN GO TO endErr; ImagerSample.BasicTransfer[dst: dst, src: data.lineBuffer, dstMin: [dstMin.s+(sSrc-s), dstMin.f], srcMin: [0, f], size: [1, size.f], function: function]; ENDLOOP; }; GO TO free; EXITS endErr => {LogError[data, $eoi, 0]; IF needFree THEN FreeLineBuffer[data]}; free => IF needFree THEN FreeLineBuffer[data]; }; needFree: BOOL ¬ FALSE; WithData[Inner, pa.data]; }; XeroxCCITT4Copy: ImagerPixelArrayPrivate.CopyProc = TRUSTED { <> WithData[MakePure, pa.data]; pa.immutable ¬ TRUE; RETURN [pa]; }; <> transitionCountEstimate: NAT ¬ 400; <> <<>> Reset: PUBLIC PROC [data: Data] ~ { scanLength: INT ~ data.scanLength; tSize: NAT ~ MIN[transitionCountEstimate, scanLength] + 3; untracedZone: ZONE ~ SafeStorage.GetUntracedZone[]; IF keepCounts THEN resetCalls ¬ resetCalls + 1; data.nextLineState ¬ white; data.bitBuffer ¬ 0; data.goodBits ¬ 0; data.end ¬ FALSE; IF data.copyData # NIL THEN RETURN; IF data.roots = NIL THEN data.roots ¬ BuildRoots[dummy]; data.sCurrent ¬ -1; data.lineBufferValid ¬ FALSE; IF data.referenceTransitions = NIL THEN data.referenceTransitions ¬ untracedZone.NEW[IndexSequenceRep[tSize]]; data.referenceTransitions[0] ¬ -1; data.referenceTransitions[1] ¬ scanLength; data.referenceTransitions[2] ¬ scanLength; data.referenceTransitions.end ¬ 3; IF data.lineTransitions = NIL THEN data.lineTransitions ¬ untracedZone.NEW[IndexSequenceRep[tSize]]; IF data.stream = NIL THEN {data.end ¬ TRUE; RETURN}; IF data.initIndex < 0 THEN data.initIndex ¬ IO.GetIndex[data.stream ! IO.Error => CONTINUE] ELSE IO.SetIndex[data.stream, data.initIndex]; }; OrBltLine: PROC [data: Data, dstBase: POINTER TO Basics.RawBits, dstBitIndex: CARD, min: CARD, max: CARD] ~ { IF keepCounts THEN orBltCalls ¬ orBltCalls + 1; IF min < max THEN { rp: CardPtr ¬ LOOPHOLE[data.referenceTransitions, CardPtr] + SIZE[IndexSequenceRep[1]]; start: CARDINAL; fill: WORD ¬ WORD.LAST; p0: WordsPtr ¬ LOOPHOLE[dstBase, WordsPtr] + (dstBitIndex / bpw)*SIZE[WORD]; c0: BitCount ¬ dstBitIndex MOD bpw; WHILE rp[1] <= min DO rp ¬ rp + SIZE[WORD]*2; ENDLOOP; -- toss leading runs start ¬ MAX[rp[0], min]; -- clip leading visible run WHILE start < max DO lim: CARDINAL ¬ MIN[rp[1], max]; IF lim > start THEN { dstStart: CARD = (start-min) + c0; p: WordsPtr ¬ p0 + (dstStart / bpw)*SIZE[WORD]; dstMod: BitCount = dstStart MOD bpw; dstLim: CARD = dstMod + (lim - start); w: WORD ¬ Basics.BITRSHIFT[fill, dstMod]; words: CARDINAL ¬ dstLim / bpw; IF words # 0 THEN { p[0] ¬ Basics.BITOR[p[0], w]; p ¬ p + SIZE[WORD]; w ¬ fill; IF words > 1 THEN { words ¬ words - 1; WHILE words >= 4 DO p[0] ¬ w; p[1] ¬ w; p[2] ¬ w; p[3] ¬ w; p ¬ p + SIZE[WORD]*4; words ¬ words - 4; ENDLOOP; IF words = 0 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 1 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 2 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; EXITS wordless => {}; }; IF (dstLim MOD bpw) = 0 THEN GO TO noRem; }; w ¬ w - Basics.BITRSHIFT[fill, dstLim MOD bpw]; p[0] ¬ Basics.BITOR[p[0], w]; EXITS noRem => {}; }; rp ¬ rp + SIZE[WORD]*2; start ¬ rp[0]; ENDLOOP; }; }; altOrBltLine: PROC [data: Data, dstBase: POINTER TO Basics.RawBits, dstBitIndex: CARD, min: CARD, max: CARD] ~ { IF keepCounts THEN orBltCalls ¬ orBltCalls + 1; IF min < max THEN { rp: CardPtr ¬ LOOPHOLE[data.referenceTransitions, CardPtr] + SIZE[IndexSequenceRep[1]]; shift: BitCount ¬ dstBitIndex MOD bpw; p: WordsPtr ¬ LOOPHOLE[dstBase, WordsPtr] + (dstBitIndex/bpw)*SIZE[WORD]; w: WORD ¬ 0; fill: WORD ¬ 0; WHILE rp[0] <= min DO rp ¬ rp+SIZE[WORD]; fill ¬ Basics.BITNOT[fill]; ENDLOOP; WHILE min < max DO newMin: CARD = MIN[max, rp[0]]; outLim: CARD = (newMin - min) + shift; words: CARDINAL ¬ outLim / bpw; IF fill = 0 THEN { IF words # 0 THEN { IF w # 0 THEN {p[0] ¬ Basics.BITOR[p[0], w]; w ¬ 0}; p ¬ p + SIZE[WORD]*words; }; shift ¬ outLim MOD bpw; } ELSE { w ¬ w + Basics.BITRSHIFT[fill, shift]; IF words # 0 THEN { p[0] ¬ Basics.BITOR[p[0], w]; p ¬ p + SIZE[WORD]; w ¬ fill; IF words > 1 THEN { words ¬ words - 1; WHILE words >= 4 DO p[0] ¬ w; p[1] ¬ w; p[2] ¬ w; p[3] ¬ w; p ¬ p + SIZE[WORD]*4; words ¬ words - 4; ENDLOOP; IF words = 0 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 1 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 2 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; EXITS wordless => {}; }; }; shift ¬ outLim MOD bpw; w ¬ w - Basics.BITRSHIFT[fill, shift]; }; rp ¬ rp+SIZE[WORD]; min ¬ newMin; fill ¬ Basics.BITNOT[fill]; ENDLOOP; IF w # 0 AND shift # 0 THEN { <> mask: WORD = Basics.BITRSHIFT[WORD.LAST, shift]; w ¬ w - Basics.BITAND[w, mask]; p[0] ¬ Basics.BITOR[w, p[0]]; }; }; }; MoveLine: PROC [data: Data, dstBase: POINTER TO Basics.RawBits, dstBitIndex: CARD, min: CARD, max: CARD, invert: BOOL ¬ FALSE] ~ { IF keepCounts THEN moveLineCalls ¬ moveLineCalls + 1; IF min < max THEN { rp: CardPtr ¬ LOOPHOLE[data.referenceTransitions, CardPtr] + SIZE[IndexSequenceRep[1]]; shift: BitCount ¬ dstBitIndex MOD bpw; p: WordsPtr ¬ LOOPHOLE[dstBase, WordsPtr] + (dstBitIndex/bpw)*SIZE[WORD]; w: WORD ¬ 0; fill: WORD ¬ IF invert THEN WORD.LAST ELSE 0; WHILE rp[0] <= min DO rp ¬ rp+SIZE[WORD]; fill ¬ Basics.BITNOT[fill]; ENDLOOP; IF shift # 0 THEN { <> w ¬ p[0]; w ¬ w - Basics.BITRSHIFT[Basics.BITLSHIFT[w, shift], shift]; }; WHILE min < max DO newMin: CARD = MIN[max, rp[0]]; outLim: CARD = (newMin - min) + shift; words: CARDINAL ¬ outLim / bpw; w ¬ w + Basics.BITRSHIFT[fill, shift]; IF words # 0 THEN { p[0] ¬ w; p ¬ p + SIZE[WORD]; w ¬ fill; IF words > 1 THEN { words ¬ words - 1; WHILE words >= 4 DO p[0] ¬ w; p[1] ¬ w; p[2] ¬ w; p[3] ¬ w; p ¬ p + SIZE[WORD]*4; words ¬ words - 4; ENDLOOP; IF words = 0 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 1 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; IF words = 2 THEN GO TO wordless; p[0] ¬ w; p ¬ p + SIZE[WORD]; EXITS wordless => {}; }; }; shift ¬ outLim MOD bpw; w ¬ w - Basics.BITRSHIFT[fill, shift]; rp ¬ rp+SIZE[WORD]; min ¬ newMin; fill ¬ Basics.BITNOT[fill]; ENDLOOP; IF shift # 0 THEN { <> mask: WORD = Basics.BITRSHIFT[WORD.LAST, shift]; w ¬ w - Basics.BITAND[w, mask]; p[0] ¬ w + Basics.BITAND[p[0], mask]; }; }; }; FreeLineBuffer: PROC [data: Data] ~ { lineBuffer: ImagerSample.RasterSampleMap ¬ data.lineBuffer; data.lineBufferValid ¬ FALSE; data.lineBuffer ¬ NIL; IF lineBuffer # NIL THEN ImagerSample.ReleaseScratchMap[lineBuffer]; }; ErrorEOF: PROC [data: Data] ~ { <> IF data.error = NIL THEN { data.error ¬ $eof }; data.end ¬ TRUE; data.errorIndex ¬ GetBitIndex[data]; }; GetBitIndex: PROC [data: Data] RETURNS [INT] = { init: INT = MAX[0, data.initIndex]; RETURN [(IO.GetIndex[data.stream]-init) * 8]; }; ByteArray: TYPE = PACKED ARRAY BYTE OF BYTE; reverseBitsTab: REF ByteArray = InitReverseBits[]; InitReverseBits: PROC RETURNS [REF ByteArray] = { new: REF ByteArray = NEW[ByteArray]; FOR b: BYTE IN BYTE DO w: WORD ¬ Basics.BITAND[b, 0AAH]/2 + Basics.BITAND[b, 055H]*2; w ¬ Basics.BITAND[w, 0CCH]/4 + Basics.BITAND[w, 033H]*4; w ¬ Basics.BITAND[w, 0F0H]/10H + Basics.BITAND[w, 00FH]*10H; new[b] ¬ w MOD 100H; ENDLOOP; RETURN [new]; }; Scan: PROC [j: INT, bit: [0..1], data: Data] RETURNS [INT] ~ TRUSTED { ref: REF IndexSequenceRep ~ data.referenceTransitions; min: INT ¬ MIN[j+1, LOOPHOLE[data.scanLength, NAT]]; i: CARDINAL ¬ data.referenceIndex; refi: INT ¬ 0; WHILE ref[i] > min DO i ¬ i - 1; ENDLOOP; IF bit # (i MOD 2) THEN i ¬ i + 1; WHILE (refi ¬ ref[i]) < min DO i ¬ i + 2 ENDLOOP; i ¬ MIN[i, ref.end-2]; data.referenceIndex ¬ i; IF useDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "scan: %g\n", [integer[refi]]]; RETURN [refi-ClipZero[j]] }; LogError: PROC [data: Data, error: ATOM, bufferedBits: NAT] ~ { IF data.error = NIL THEN { data.error ¬ error; data.errorIndex ¬ GetBitIndex[data] - bufferedBits; IF data.debug # NIL THEN IO.PutF[data.debug, "LogError: %g, near bit index %g\n", [atom[error]], [integer[data.errorIndex]] ]; }; }; <> <> <<>> ExpandLineTransitions: PROC [data: Data] RETURNS [REF IndexSequenceRep] ~ { old: REF IndexSequenceRep ~ data.lineTransitions; oldSize: CARDINAL = old.size; newSize: CARDINAL = oldSize+oldSize/2+32; new: REF IndexSequenceRep ~ SafeStorage.GetUntracedZone[].NEW[IndexSequenceRep[newSize]]; FOR i: CARDINAL IN [0..oldSize) DO new[i] ¬ old[i]; ENDLOOP; new.end ¬ old.end; data.lineTransitions ¬ new; RETURN [new]; }; Advance: PUBLIC PROC [data: Data] ~ { <> scanLength: INT ~ data.scanLength; bitBuffer: CARD ¬ data.bitBuffer; -- buffered input bits goodBits: BitCount ¬ data.goodBits; -- number of good bits, left justified in bitBuffer Peek: PROC [n: BitCount] RETURNS [CARD] ~ INLINE { RETURN [Basics.BITRSHIFT[bitBuffer, LOOPHOLE[bpw-n, BitCount]]] }; EatBits: PROC [n: BitCount] ~ INLINE { goodBits ¬ LOOPHOLE[goodBits - n, BitCount]; bitBuffer ¬ Basics.BITLSHIFT[bitBuffer, n]; }; state: State ¬ data.nextLineState; current: Node ¬ data.roots[state]; val: INT ¬ 0; j: INT ¬ -1; lineTransitions: REF IndexSequenceRep ¬ data.lineTransitions; Fill: PROC [j0: INT, count: INT, bit: [0..1]] RETURNS [INT] ~ INLINE { j: INT = ClipZero[j0]; nj: INT ¬ j + count; IF nj > scanLength THEN { LogError[data, $longscan, goodBits]; nj ¬ scanLength; }; IF nj > j THEN { end: CARDINAL = lineTransitions.end; IF bit = (end MOD 2) THEN { IF useDebug AND debug # NIL THEN IO.PutF[debug, "fill: %g, bit: %g\n", [integer[j]], [rope[colorNames[bit]]] ]; IF end >= lineTransitions.size THEN lineTransitions ¬ ExpandLineTransitions[data]; SetTransition[lineTransitions, end, j]; lineTransitions.end ¬ end+1; }; }; RETURN [nj]; }; PullBits: PROC [needBits: [0..maxNeed] ¬ maxNeed] ~ INLINE { IF goodBits < needBits THEN { bitBuffer ¬ bitBuffer + MyGetBytes[data, goodBits]; goodBits ¬ data.goodBits; }; }; debug: IO.STREAM = data.debug; IF keepCounts THEN advanceCalls ¬ advanceCalls + 1; IF useDebug AND debug # NIL THEN { IF data.sCurrent < 0 THEN { IO.PutF1[debug, "Advance, [k: %g, ", [integer[data.k]] ]; IO.PutF1[debug, "sSize: %g, ", [integer[data.sSize]] ]; IO.PutF1[debug, "useFastScan: %g, ", [boolean[data.useFastScan]] ]; IO.PutF1[debug, "bitBuffer: %g, ", [cardinal[data.bitBuffer]] ]; IO.PutF1[debug, "goodBits: %g]\n", [cardinal[data.goodBits]] ]; }; IO.PutF[debug, "(begin: %g, bitindex: %g\n", [cardinal[data.sCurrent+1]], [cardinal[ClipZero[GetBitIndex[data] - goodBits]]]]; }; data.nextLineState ¬ white; data.referenceIndex ¬ 0; IF data.end THEN RETURN; SetTransition[lineTransitions, 0, -1]; lineTransitions.end ¬ 1; PullBits[]; IF bitBuffer = 0 AND IO.InlineEndOf[data.stream] THEN { <> IF useDebug AND debug # NIL THEN IO.PutRope[debug, "eod(0):\n"]; data.end ¬ TRUE; RETURN; }; SELECT TRUE FROM Basics.BITRSHIFT[bitBuffer, bpw-6] = 0 => {}; state NOT IN [white..black] => {}; ENDCASE => { SELECT TRUE FROM data.oneDimTag => j ¬ OneDimScan[data, j, bitBuffer, goodBits, 0]; data.useFastScan => j ¬ FastScan[data, j, bitBuffer, goodBits, 0]; ENDCASE => GO TO noChange; <> lineTransitions ¬ data.lineTransitions; goodBits ¬ data.goodBits; bitBuffer ¬ data.bitBuffer; state ¬ data.nextScanState; current ¬ data.roots[state]; EXITS noChange => {}; }; DO IF j >= scanLength THEN IF state NOT IN [hhwhite..unc] THEN EXIT; WITH current SELECT FROM tree: TreeNode => { needBits: BitCount ¬ tree.bitCount; branch: Branch; IF keepCounts THEN tree.count ¬ tree.count + 1; PullBits[needBits]; branch ¬ tree[Peek[needBits]]; needBits ¬ needBits - branch.reserveBits; IF useDebug AND debug # NIL THEN { IO.PutRope[debug, "tree: "]; PutB[debug, Peek[needBits], needBits, TRUE]; }; EatBits[needBits]; current ¬ branch.node; }; leaf: LeafNode => { val ¬ val + leaf.length; IF keepCounts THEN leaf.count ¬ leaf.count + 1; IF useDebug THEN { st: IO.STREAM = debug; IF st # NIL THEN { IO.PutRope[st, "action: "]; PutAction[st, leaf.action]; IO.PutF1[st, ", j: %g, state: ", [integer[j]] ]; PutState[st, state]; IO.PutF1[st, ", val: %g\n", [integer[val]] ]; }; }; SELECT leaf.action FROM null => NULL; utest => { <> PullBits[6]; SELECT TRUE FROM Peek[6] = 1 => { <> SetTag: PROC = INLINE { SELECT data.k FROM < 0 => {}; 0 => data.oneDimTag ¬ TRUE; ENDCASE => { < 0 there is an extra bit>> <<0 => 2-D mode>> <<1 => 1-D mode>> PullBits[1]; data.oneDimTag ¬ VAL[Peek[1]]; EatBits[1]; }; }; EatBits[6]; SetTag[]; IF useDebug THEN { st: IO.STREAM = debug; IF st # NIL THEN { IO.PutRope[st, "eol: 000001"]; IF data.k > 0 THEN IO.PutRope[st, IF data.oneDimTag THEN "+1-D" ELSE "+2-D"]; IO.PutChar[st, '\n]; }; }; PullBits[12]; IF j > 0 AND data.k < 0 THEN LogError[data, $truncatedline, goodBits]; IF Basics.BITRSHIFT[bitBuffer, bpw-12] = 1 THEN { <<2 EOL => EODF; for G3, eat 4 more EOL+b codes>> repeat: INTEGER ¬ IF data.k >= 0 THEN 6 ELSE 2; DO EatBits[12]; SetTag[]; repeat ¬ repeat - 1; IF repeat <= 1 THEN EXIT; PullBits[12]; IF Basics.BITRSHIFT[bitBuffer, bpw-12] # 1 THEN { LogError[data, $coding, goodBits]; EXIT; }; ENDLOOP; IF useDebug AND debug # NIL THEN IO.PutRope[debug, "eod:\n"]; data.end ¬ TRUE; RETURN; }; <> state ¬ white; SELECT TRUE FROM j >= 0 => EXIT; data.oneDimTag => j ¬ OneDimScan[data, j, bitBuffer, goodBits, 0]; data.useFastScan => j ¬ FastScan[data, j, bitBuffer, goodBits, 0]; ENDCASE => GO TO getCurrent; GO TO refresh; }; NOT data.oneDimTag AND Peek[4] = 15 => { <> EatBits[4]; state ¬ unc; }; data.oneDimTag AND Peek[6] = 15 => { <> EatBits[6]; state ¬ unc; }; ENDCASE => { LogError[data, $coding, goodBits]; EXIT }; GO TO getCurrent; }; emit => { j ¬ Fill[j, val, ColorFromState[state]]; val ¬ 0; }; scan => { bit: BIT ¬ ColorFromState[state]; scan: INT ¬ Scan[j, 1-bit, data] + val; IF scan < 0 THEN { LogError[data, $backup, goodBits]; scan ¬ 0; }; j ¬ Fill[j, scan, bit]; IF data.useFastScan AND NOT data.oneDimTag AND j < scanLength THEN { j ¬ FastScan[data, j, bitBuffer, goodBits, 1-bit]; <> GO TO refresh; }; val ¬ 0; }; pass => { bit: BIT ~ ColorFromState[state]; j ¬ Fill[j, Scan[j, 1-bit, data], bit]; j ¬ Fill[j, Scan[j, bit, data], bit]; val ¬ 0; }; one => { IF (j + val) > scanLength THEN { <> leftover: INT ~ val - (scanLength-j); j ¬ Fill[j, (scanLength-j), 0]; data.nextLineState ¬ VAL[ORD[State.uncb1]+leftover-1]; EXIT; } ELSE { j ¬ Fill[j, val-1, 0]; j ¬ Fill[j, 1, 1]; }; val ¬ 0; }; zeros => { IF (j + val) > scanLength THEN { <> leftover: INT ~ val - (scanLength-j); j ¬ Fill[j, (scanLength-j), 0]; data.nextLineState ¬ VAL[ORD[State.uncw1]+leftover-1]; EXIT; } ELSE { j ¬ Fill[j, val, 0]; }; val ¬ 0; }; ENDCASE; state ¬ leaf.new; IF data.oneDimTag THEN { state ¬ leaf.new; SELECT state FROM white => state ¬ hwhite; black => state ¬ hblack; ENDCASE; }; GO TO getCurrent; EXITS getCurrent => current ¬ data.roots[state]; refresh => { lineTransitions ¬ data.lineTransitions; goodBits ¬ data.goodBits; bitBuffer ¬ data.bitBuffer; state ¬ data.nextScanState; current ¬ data.roots[state]; data.nextLineState ¬ white; val ¬ 0; }; }; ENDCASE => { LogError[data, $coding, goodBits]; EXIT }; ENDLOOP; data.bitBuffer ¬ bitBuffer; data.goodBits ¬ goodBits; data.sCurrent ¬ data.sCurrent + 1; data.lineBufferValid ¬ FALSE; { end: CARDINAL = lineTransitions.end; IF end+1 >= lineTransitions.size THEN lineTransitions ¬ ExpandLineTransitions[data]; SetTransition[lineTransitions, end, scanLength]; SetTransition[lineTransitions, end+1, scanLength]; lineTransitions.end ¬ end + 2; }; IF useDebug AND debug # NIL THEN { IO.PutF1[debug, "end: %g transitions:", [cardinal[data.sCurrent]]]; FOR i: NAT IN [1..lineTransitions.end-1) DO IO.PutF1[debug, " %g", [integer[lineTransitions[i]]]]; ENDLOOP; IO.PutRope[debug, ")\n"]; }; data.lineTransitions ¬ data.referenceTransitions; data.referenceTransitions ¬ lineTransitions; }; runTabRef: REF RunTab ¬ InitRunTab[]; RunTab: TYPE = PACKED ARRAY RunTabIndex OF RunTabEntry; RunTabIndex: TYPE = [0..4*runTableMod); RunTabEntry: TYPE = MACHINE DEPENDENT RECORD [ val (0: 0..11): RunTabLen, bits (0: 12..15): RunTabBitCount ]; RunTabLen: TYPE = [0..4096); RunTabBitCount: TYPE = [0..runTableBits]; runTableBits: NAT = 13; runTableZeros: NAT = 4; < x >= 512) then we use the index directly into the "long" table. Otherwise we divide by 2**4 (= 16), add the mod, and index the short table.>> runTableMod: NAT = 2**(runTableBits-runTableZeros); runTableDiv: NAT = 2**runTableZeros; runTableSplit: NAT = 64; <> <> InitRunTab: PROC RETURNS [REF RunTab] = { entries: NAT = 4*runTableMod; untracedZone: ZONE ~ SafeStorage.GetUntracedZone[]; tab: REF RunTab ¬ untracedZone.NEW[RunTab ¬ ALL [[0, 0]] ]; each: TransitionTableEntryProc ~ { base: CARDINAL ¬ 0; SELECT old FROM hwhite, hhwhite => {}; hblack, hhblack => base ¬ 2*runTableMod; ENDCASE => RETURN; { bits: RunTabBitCount = BitstringSize[bitstring]; e: RunTabEntry = [val: length, bits: bits]; shift: BitCount = runTableBits-bits; bv: WORD = Basics.BITLSHIFT[BitstringVal[bitstring], shift]; nx: CARDINAL ¬ Basics.BITLSHIFT[1, shift]; x: WORD ¬ bv; IF bv >= runTableMod THEN { nx ¬ nx / runTableDiv; x ¬ x / runTableDiv; base ¬ base + runTableMod; }; FOR i: CARDINAL IN [0..nx) DO tab[base+x+i] ¬ e; ENDLOOP; }; }; EnumerateTransitions[each]; RETURN [tab]; }; fastScanTab: REF FastScanTab = BuildFastScanTab[]; FastScanTab: TYPE = PACKED ARRAY FastScanTabIndex OF FastScanEntry; fastScanBits: NAT = 7; FastScanTabIndex: TYPE = [0..2**fastScanBits); FastScanEntry: TYPE = MACHINE DEPENDENT RECORD [ gb (0: 0..2): [0..fastScanBits] ¬ 0, delta (0: 3..5): [-3..3] ¬ 0, kind (0: 6..7): FastScanKind ¬ other]; FastScanKind: TYPE = {scan, pass, horiz, other}; BuildFastScanTab: PROC RETURNS [REF FastScanTab] = { untracedZone: ZONE ~ SafeStorage.GetUntracedZone[]; new: REF FastScanTab ¬ untracedZone.NEW[FastScanTab ¬ ALL[ [] ]]; FOR i: FastScanTabIndex IN FastScanTabIndex DO e: FastScanEntry ¬ [0, 0, other]; SELECT i FROM >= 64 => e ¬ [1, 0, scan]; <> >= 48 => e ¬ [3, 1, scan]; >= 32 => e ¬ [3, -1, scan]; <> >= 16 => e ¬ [3, 0, horiz]; <> >= 8 => e ¬ [4, 0, pass]; <> 6, 7 => e ¬ [6, 2, scan]; 4, 5 => e ¬ [6, -2, scan]; <> 3 => e ¬ [7, 3, scan]; 2 => e ¬ [7, -3, scan]; <> ENDCASE; <> new[i] ¬ e; ENDLOOP; RETURN [new]; }; MyGetBytes: SAFE PROC [data: Data, gb: BitCount] RETURNS [WORD] = TRUSTED <> { <> st: IO.STREAM = data.stream; w: WORD ¬ 0; tab: REF ByteArray = IF data.reverseBits THEN NIL ELSE reverseBitsTab; <> i: NAT ¬ st.bufferIndex; len: NAT ¬ st.bufferInputLength; WHILE gb < maxNeed DO b: BYTE; SELECT TRUE FROM i < len => {b ¬ st.buffer[i].ORD; st.bufferIndex ¬ i ¬ i+1}; IO.InlineEndOf[st] => b ¬ 0; ENDCASE => {b ¬ IO.InlineGetByte[st]; i ¬ st.bufferIndex; len ¬ st.bufferInputLength}; IF tab # NIL THEN b ¬ tab[b]; gb ¬ gb + BITS[BYTE]; w ¬ w + Basics.BITLSHIFT[b, bpw-gb]; ENDLOOP; data.goodBits ¬ gb; RETURN [w]; }; PutGoodBits: PROC [st: IO.STREAM, w: WORD, bits: NAT] = { THROUGH [0..MIN[bits, bpw]) DO IO.PutChar[st, '0+Basics.BITRSHIFT[w, bpw-1]]; w ¬ w + w; ENDLOOP; }; OneDimScan: PROC [data: Data, j: INT, bitBuffer: CARD, goodBits: BitCount, color: BIT] RETURNS [INT] ~ { <> nj: INT ¬ 0; i: CARDINAL ¬ data.referenceIndex; needBits: [0..maxNeed] ¬ maxNeed; scanLength: INTEGER = data.scanLength; EatBits: PROC ~ INLINE { IF useFastDebug AND data.debug # NIL THEN { IO.PutF1[data.debug, "Fast scan eat bits: %g, ", [integer[j]] ]; PutGoodBits[data.debug, bitBuffer, needBits]; IO.PutChar[data.debug, '\n]; }; goodBits ¬ LOOPHOLE[goodBits - needBits, BitCount]; bitBuffer ¬ Basics.BITLSHIFT[bitBuffer, needBits]; }; PullBits: PROC ~ INLINE { st: IO.STREAM = data.stream; index: CARDINAL ¬ st.bufferIndex; IF (index+3) < st.bufferInputLength AND data.reverseBits THEN { <> bp: BytesPtr = LOOPHOLE[st.buffer, BytesPtr] + SIZE[TEXT[0]]; DO goodBits ¬ LOOPHOLE[goodBits + 8, BitCount]; bitBuffer ¬ bitBuffer + Basics.BITLSHIFT[bp[index], LOOPHOLE[bpw-goodBits, BitCount]]; index ¬ index + 1; IF goodBits >= maxNeed THEN {st.bufferIndex ¬ index; GO TO done}; ENDLOOP; }; bitBuffer ¬ bitBuffer + MyGetBytes[data, goodBits]; goodBits ¬ data.goodBits; EXITS done => {}; }; Fill: PROC ~ INLINE { jb: NAT = ClipZero[j]; lineTransitions: REF IndexSequenceRep ¬ data.lineTransitions; end: CARDINAL = lineTransitions.end; IF nj > jb AND color = (end MOD 2) THEN { IF end >= lineTransitions.size THEN lineTransitions ¬ ExpandLineTransitions[data]; IF useFastDebug AND data.debug # NIL THEN { IO.PutF1[data.debug, "Fast scan emit transition: %g, ", [integer[jb]] ]; IO.PutRope[data.debug, colorNames[color]]; IO.PutChar[data.debug, '\n]; }; SetTransition[lineTransitions, end, jb]; lineTransitions.end ¬ end+1; }; j ¬ nj; }; IF data.debug # NIL THEN { IO.PutRope[data.debug, "OneDimScan entry\n"]; }; WHILE j < scanLength DO IF goodBits < runTableBits THEN PullBits[]; IF Basics.BITRSHIFT[bitBuffer, bpw-8] = 0 THEN EXIT; <> nj ¬ ClipZero[j]; DO x: WORD ¬ Basics.BITRSHIFT[bitBuffer, bpw-runTableBits]; IF x >= runTableMod THEN x ¬ runTableMod + x / runTableDiv; { e: RunTabEntry = GetRunEntry[color, x]; v: INT = e.val; needBits ¬ e.bits; IF needBits = 0 THEN EXIT; EatBits[]; nj ¬ nj + v; IF v < runTableSplit THEN EXIT; }; IF goodBits < runTableBits THEN PullBits[]; ENDLOOP; IF nj > scanLength THEN { LogError[data, $longscan, goodBits]; nj ¬ scanLength; }; IF data.debug # NIL THEN { IO.PutF1[data.debug, "OneDimScan fill: %g, ", [integer[nj]] ]; IO.PutRope[data.debug, colorNames[color]]; IO.PutChar[data.debug, '\n]; }; Fill[]; -- nj, color; j ¬ nj color ¬ 1 - color; ENDLOOP; IF j > scanLength THEN { LogError[data, $longscan, goodBits]; j ¬ scanLength; }; data.nextScanState ¬ VAL[color]; IF data.debug # NIL THEN { IO.PutF1[data.debug, "OneDimScan exit: %g, ", [integer[j]] ]; PutGoodBits[data.debug, bitBuffer, goodBits]; IO.PutChar[data.debug, '\n]; }; data.referenceIndex ¬ i; data.bitBuffer ¬ bitBuffer; data.goodBits ¬ goodBits; RETURN [j]; }; FastScan: PROC [data: Data, j: INT, bitBuffer: CARD, goodBits: BitCount, color: BIT] RETURNS [INT] ~ { <> nj: INT ¬ 0; i: CARDINAL ¬ data.referenceIndex; needBits: [0..maxNeed] ¬ maxNeed; scanLength: INTEGER = LOOPHOLE[data.scanLength, INTEGER]; EatBits: PROC ~ INLINE { IF useFastDebug AND data.debug # NIL THEN { IO.PutF1[data.debug, "Fast scan eat bits: %g, ", [integer[j]] ]; PutGoodBits[data.debug, bitBuffer, needBits]; IO.PutChar[data.debug, '\n]; }; goodBits ¬ LOOPHOLE[goodBits - needBits, BitCount]; bitBuffer ¬ Basics.BITLSHIFT[bitBuffer, needBits]; }; PullBits: PROC ~ INLINE { st: IO.STREAM = data.stream; index: CARDINAL ¬ st.bufferIndex; IF (index+3) < st.bufferInputLength AND data.reverseBits THEN { <> bp: BytesPtr = LOOPHOLE[st.buffer, BytesPtr] + SIZE[TEXT[0]]; DO goodBits ¬ LOOPHOLE[goodBits + 8, BitCount]; bitBuffer ¬ bitBuffer + Basics.BITLSHIFT[bp[index], LOOPHOLE[bpw-goodBits, BitCount]]; index ¬ index + 1; IF goodBits >= maxNeed THEN {st.bufferIndex ¬ LOOPHOLE[index, INT]; GO TO done}; ENDLOOP; }; bitBuffer ¬ bitBuffer + MyGetBytes[data, goodBits]; goodBits ¬ data.goodBits; EXITS done => {}; }; Fill: PROC ~ INLINE { jb: NAT = ClipZero[j]; lineTransitions: REF IndexSequenceRep ¬ data.lineTransitions; end: CARDINAL = lineTransitions.end; IF nj > jb AND color = (end MOD 2) THEN { IF end >= lineTransitions.size THEN lineTransitions ¬ ExpandLineTransitions[data]; IF useFastDebug AND data.debug # NIL THEN { IO.PutF1[data.debug, "Fast scan emit transition: %g, ", [integer[jb]] ]; IO.PutRope[data.debug, colorNames[color]]; IO.PutChar[data.debug, '\n]; }; SetTransition[lineTransitions, end, jb]; lineTransitions.end ¬ end+1; }; j ¬ nj; }; IF keepFastCounts THEN fastScanEntries ¬ fastScanEntries + 1; IF useFastDebug AND data.debug # NIL THEN IO.PutF1[data.debug, "Fast scan entry: %g\n", [integer[j]] ]; WHILE j < scanLength DO IF keepFastCounts THEN fastScanLoops ¬ fastScanLoops + 1; IF goodBits < fastScanBits THEN PullBits[]; { b: FastScanTabIndex = LOOPHOLE[ Basics.BITRSHIFT[bitBuffer, bpw-fastScanBits], FastScanTabIndex]; e: FastScanEntry = fastScanTab[b]; SELECT e.kind FROM scan => { <> ref: REF IndexSequenceRep ~ data.referenceTransitions; WHILE GetTransition[ref, i] > j+1 DO i ¬ i - 1; ENDLOOP; i ¬ i + (1 + color + i) MOD 2; <> WHILE (nj ¬ GetTransition[ref, i]) <= j DO i ¬ i + 2; ENDLOOP; nj ¬ e.delta + nj; { end: CARDINAL = ref.end-2; IF i > end THEN i ¬ end}; IF nj < j THEN GO TO backup; IF keepFastCounts THEN fastScanScans ¬ fastScanScans + 1; needBits ¬ e.gb; EatBits[]; Fill[]; -- nj, color; j ¬ nj color ¬ 1 - color; }; horiz => { IF keepFastCounts THEN fastScanHoriz ¬ fastScanHoriz + 1; needBits ¬ 3; EatBits[]; -- 001 is the horizontal code THROUGH [0..1] DO nj ¬ ClipZero[j]; DO IF goodBits < runTableBits THEN PullBits[]; { x: WORD ¬ Basics.BITRSHIFT[bitBuffer, bpw-runTableBits]; IF x >= runTableMod THEN x ¬ runTableMod + x / runTableDiv; { e: RunTabEntry = GetRunEntry[color, x]; v: INT = e.val; needBits ¬ e.bits; IF needBits = 0 THEN GO TO coding; EatBits[]; nj ¬ nj + v; IF v < runTableSplit THEN EXIT; }; }; ENDLOOP; IF nj > scanLength THEN { LogError[data, $longscan, goodBits]; nj ¬ scanLength; }; Fill[]; -- nj, color; j ¬ nj color ¬ 1 - color; ENDLOOP; }; pass => { <> ref: REF IndexSequenceRep ~ data.referenceTransitions; WHILE GetTransition[ref, i] > j+1 DO i ¬ i - 1; ENDLOOP; i ¬ i + (1 + color + i) MOD 2; <> WHILE (nj ¬ GetTransition[ref, i]) <= j DO i ¬ i + 2; ENDLOOP; i ¬ i + 1; { end: CARDINAL = ref.end-2; IF i > end THEN i ¬ end}; nj ¬ GetTransition[ref, i]; IF keepFastCounts THEN fastScanPass ¬ fastScanPass + 1; needBits ¬ 4; EatBits[]; -- 0001 Fill[]; -- nj, color; j ¬ nj }; ENDCASE => EXIT; EXITS backup => {LogError[data, $backup, goodBits]; EXIT}; coding => {LogError[data, $coding, goodBits]; EXIT}; }; ENDLOOP; IF j > scanLength THEN { LogError[data, $longscan, goodBits]; j ¬ scanLength; }; data.nextScanState ¬ VAL[color]; IF useFastDebug AND data.debug # NIL THEN { IO.PutF1[data.debug, "Fast scan exit: %g, ", [integer[j]] ]; PutGoodBits[data.debug, bitBuffer, goodBits]; IO.PutChar[data.debug, '\n]; }; data.referenceIndex ¬ i; data.bitBuffer ¬ bitBuffer; data.goodBits ¬ goodBits; RETURN [j]; }; <> Bitstring: TYPE ~ PACKED ARRAY BitCount OF BIT; L: PROC [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20,a21,a22,a23,a24: BIT ¬ 0] RETURNS [Bitstring] ~ INLINE { RETURN [[ a0,a1,a2,a3,a4,a5,a6,a7,a8,a9, a10,a11,a12,a13,a14,a15,a16,a17,a18,a19, a20,a21,a22,a23,a24,0,0,0,0,0,0,0 ]] }; Z: BIT ~ 1; -- terminator for Bitstring data BitstringSize: PROC [b: Bitstring] RETURNS [BitCount] ~ { FOR i: NAT DECREASING IN BitCount DO IF b[i] = Z THEN RETURN [i] ENDLOOP; ERROR; }; BitstringFetch: PROC [b: Bitstring, i: INT] RETURNS [BIT] ~ { RETURN[b[i]]; }; BitstringVal: PROC [b: Bitstring] RETURNS [CARDINAL] ~ { c: CARDINAL ¬ LOOPHOLE[b]; IF c # 0 THEN WHILE c MOD 2 # Z DO c ¬ c / 2; ENDLOOP; RETURN [c / 2]; }; TransitionTableEntryProc: TYPE ~ PROC [ old: State, bitstring: Bitstring, new: State, action: Action, length: INT ]; NewTreeNode: PROC [bitCount: BitCount ¬ 1] RETURNS [TreeNode] ~ { new: TreeNode ~ NEW[NodeRep.internal[2**bitCount]]; new.bitCount ¬ bitCount; RETURN [new] }; MakeBranch: PROC [reserveBits: BitCount, node: Node] RETURNS [Branch] ~ { RETURN[[reserveBits, node]]; }; DumpRoots: PUBLIC SAFE PROC [st: IO.STREAM, clear: BOOL] ~ TRUSTED { IF st # NIL THEN { roots: REF ARRAY State OF Node ¬ BuildRoots[dummy]; IF makePureCalls # 0 THEN IO.PutF1[st, "makePureCalls: %g\n", [cardinal[makePureCalls]] ]; IF (advanceCalls + resetCalls + orBltCalls + moveLineCalls) # 0 THEN { IO.PutF1[st, "advanceCalls: %g\n", [cardinal[advanceCalls]] ]; IO.PutF1[st, "resetCalls: %g\n", [cardinal[resetCalls]] ]; IO.PutF1[st, "orBltCalls: %g\n", [cardinal[orBltCalls]] ]; IO.PutF1[st, "moveLineCalls: %g\n", [cardinal[moveLineCalls]] ]; IF clear THEN advanceCalls ¬ resetCalls ¬ orBltCalls ¬ moveLineCalls ¬ 0; }; IF fastScanEntries # 0 THEN { IO.PutF1[st, "fastScanEntries: %g\n", [cardinal[fastScanEntries]] ]; IO.PutF1[st, "fastScanLoops: %g\n", [cardinal[fastScanLoops]] ]; IO.PutF1[st, "fastScanScans: %g\n", [cardinal[fastScanScans]] ]; IO.PutF1[st, "fastScanPass: %g\n", [cardinal[fastScanPass]] ]; IO.PutF1[st, "fastScanHoriz: %g\n", [cardinal[fastScanHoriz]] ]; IF clear THEN fastScanEntries ¬ fastScanLoops ¬ fastScanScans ¬ fastScanPass ¬ fastScanHoriz ¬ 0; }; IO.PutRope[st, "\n(case state"]; FOR s: State IN State DO n: Node = roots[s]; IF n # NIL THEN { IO.PutRope[st, "\n (("]; PutState[st, s]; IO.PutRope[st, ") "]; DumpTree[st, n, 2, clear]; IO.PutRope[st, ")"]; }; ENDLOOP; IO.PutRope[st, ")\n"]; }; }; BuildRoots: ENTRY PROC [data: Data] RETURNS [REF ARRAY State OF Node] ~ { <> IF data.roots = NIL THEN { data.roots ¬ BuildTrees[] }; RETURN [data.roots] }; BuildTrees: PROC RETURNS [REF ARRAY State OF Node] ~ { <> roots: REF ARRAY State OF Node ¬ NEW[ARRAY State OF Node]; Each: TransitionTableEntryProc ~ { size: INT ~ BitstringSize[bitstring]; IF size = 0 THEN { roots[old] ¬ NEW[NodeRep.leaf ¬ [0, leaf[new, action, length]]]; } ELSE { s: TreeNode ¬ NARROW[roots[old]]; FOR i: INT IN [0..size-1) DO c: BIT ~ BitstringFetch[bitstring, i]; IF s.d[c].node = NIL THEN s.d[c] ¬ MakeBranch[0, NewTreeNode[]]; s ¬ NARROW[s.d[c].node]; ENDLOOP; s.d[BitstringFetch[bitstring, size-1]] ¬ MakeBranch[0, NEW[NodeRep.leaf ¬ [0, leaf[new, action, length]]]]; }; }; FOR s: State IN State DO roots[s] ¬ NewTreeNode[]; ENDLOOP; EnumerateTransitions[Each]; FOR s: State IN State DO roots[s] ¬ OptimizeTree[roots[s]]; ENDLOOP; RETURN [roots] }; PutB: PROC [st: IO.STREAM, i: CARD, bitCount: NAT, nl: BOOL ¬ FALSE] ~ { IF st # NIL THEN { FOR k: CARD ¬ 2**(bitCount-1), k/2 UNTIL k=0 DO IO.PutChar[st, IF Basics.BITAND[i, k] = 0 THEN '0 ELSE '1]; ENDLOOP; IF nl THEN IO.PutChar[st, '\n]; }; }; Indent: PROC [st: IO.STREAM, i: NAT] ~ { IF st # NIL THEN { IO.PutRope[st, "\n"]; THROUGH [0..i) DO IO.PutRope[st, " "] ENDLOOP; }; }; PutAction: PROC [st: IO.STREAM, action: Action] ~ { IF st # NIL THEN IO.PutRope[st, SELECT action FROM null=>"null", utest=>"utest", emit=>"emit", scan=>"scan", pass=>"pass", one=>"one", zeros=>"zeros" ENDCASE=>"??"]; }; PutState: PROC [st: IO.STREAM, state: State] ~ { IF st # NIL THEN { IO.PutRope[st, SELECT state FROM white=>"white", black=>"black", hwhite=>"hwhite", hblack=>"hblack", hhwhite=>"hhwhite", hhblack=>"hhblack", unc=>"unc", uncb1=>"uncb1", uncb2=>"uncb2", uncb3=>"uncb3", uncb4=>"uncb4", uncb5=>"uncb5", uncw1=>"uncw1", uncw2=>"uncw2", uncw3=>"uncw3", uncw4=>"uncw4", uncw5=>"uncw5", eoi=>"eoi" ENDCASE=>"??"]; }; }; DumpTree: PROC [st: IO.STREAM, node: Node, nest: NAT, clear: BOOL] ~ { IF node = NIL THEN {IO.PutRope[st, "(NIL)"]; RETURN}; WITH node SELECT FROM tree: TreeNode => { i: NAT ¬ 0; size: NAT = tree.size; Indent[st, nest]; IF tree.count # 0 THEN IO.PutF1[st, "[%g] ", [cardinal[tree.count]]]; tree.count ¬ 0; IO.PutF1[st, "(case (peek %g)", [integer[tree.bitCount]]]; WHILE i < size DO sep: ROPE ¬ NIL; elem: Branch ¬ tree[i]; i0: NAT = i; Indent[st, nest+1]; IO.PutRope[st, "((#b"]; PutB[st, i, tree.bitCount]; WHILE i+1 < size AND tree[i+1] = elem DO i ¬ i+1; elem ¬ tree[i]; ENDLOOP; IF i # i0 THEN { IO.PutRope[st, "..#b"]; PutB[st, i, tree.bitCount]; }; IO.PutRope[st, ") "]; IF elem.node = NIL THEN IO.PutRope[st, "NIL"] ELSE { IO.PutF1[st, "(accept %g) ", [integer[tree.bitCount-elem.reserveBits]]]; DumpTree[st, elem.node, nest+2, clear]; }; IO.PutRope[st, ")"]; i ¬ i + 1; ENDLOOP; IO.PutRope[st, ")"]; }; leaf: LeafNode => { IF leaf.count # 0 THEN IO.PutF1[st, "[%g] ", [cardinal[leaf.count]]]; leaf.count ¬ 0; IO.PutRope[st, "("]; PutAction[st, leaf.action]; IO.PutF1[st, " %g ", [integer[leaf.length]]]; PutState[st, leaf.new]; IO.PutRope[st, ")"]; }; ENDCASE => ERROR; }; Punt: ERROR ~ CODE; -- prevent optimizer from looking beyond eoi. CountLive: PROC [node: Node, depth: NAT] RETURNS [NAT] ~ { IF node = NIL THEN RETURN [0]; IF depth = 0 THEN RETURN [1]; WITH node SELECT FROM tree: TreeNode => { count: NAT ¬ 0; FOR i: NAT IN [0..tree.size) DO branch: Branch ~ tree[i]; child: Node ~ branch.node; IF child # NIL THEN count ¬ count + CountLive[child, depth-1]; ENDLOOP; RETURN [count] }; leaf: LeafNode => { IF leaf.new = eoi THEN ERROR Punt[]; RETURN [1]; }; ENDCASE => RETURN [1]; }; EnumerateLive: PROC [node: Node, depth: NAT, index: CARD, visit: PROC [CARD, Branch]] ~ { IF depth = 0 THEN { visit[index, MakeBranch[depth, OptimizeTree[node]]] } ELSE { WITH node SELECT FROM tree: TreeNode => { IF tree.size # 2 THEN ERROR; FOR i: NAT IN [0..2) DO branch: Branch ~ tree[i]; child: Node ~ branch.node; IF child # NIL THEN EnumerateLive[child, depth-1, index*2+i, visit]; ENDLOOP; }; ENDCASE => { ix: CARD ~ index*2**depth; branch: Branch ~ MakeBranch[depth, OptimizeTree[node]]; FOR j: CARD IN [0..2**depth) DO visit[ix + j, branch]; ENDLOOP; }; }; }; SetSparsityInner: ENTRY PROC [data: Data, new: NAT] RETURNS [old: NAT] ~ { <> old ¬ sparsity; sparsity ¬ new; data.roots ¬ NIL; }; SetSparsity: PROC [new: CARD] RETURNS [CARD] ~ { <> IF new IN [1..256] THEN RETURN [SetSparsityInner[dummy, new]] ELSE RETURN [0]; }; OptimizeTree: PROC [node: Node] RETURNS [Node] ~ { WITH node SELECT FROM tree: TreeNode => { bitCount: CARD ¬ 1; { ENABLE Punt => GO TO punt; DO trialCount: CARD ¬ bitCount+1; x: NAT ¬ CountLive[tree, trialCount]; -- number of distinct paths at trial fanout IF sparsity*x >= 2**trialCount THEN { bitCount ¬ trialCount } ELSE EXIT; ENDLOOP; EXITS punt => {}; }; IF bitCount = tree.bitCount THEN RETURN [tree] ELSE { new: TreeNode ~ NewTreeNode[bitCount]; Plug: PROC [i: CARD, branch: Branch] ~ { new[i] ¬ branch }; EnumerateLive[tree, bitCount, 0, Plug]; RETURN [new]; }; }; ENDCASE => RETURN [node]; }; EnumerateTransitions: PROC [T: TransitionTableEntryProc] ~ { {V: PROC [length: INT, bitstring: Bitstring] ~ { T[white, bitstring, black, scan, length]; T[black, bitstring, white, scan, length]}; <> V[0, L[1,Z]]; V[1, L[0,1,1,Z]]; V[2, L[0,0,0,0,1,1,Z]]; V[3, L[0,0,0,0,0,1,1,Z]]; V[-1, L[0,1,0,Z]]; V[-2, L[0,0,0,0,1,0,Z]]; V[-3, L[0,0,0,0,0,1,0,Z]]; }; T[white, L[0,0,1,Z], hwhite, null, 0]; T[black, L[0,0,1,Z], hblack, null, 0]; FOR s: State IN [white..black] DO T[s, L[0,0,0,1,Z], s, pass, 0]; T[s, L[0,0,0,0,0,0,Z], unc, utest, 0]; ENDLOOP; {W: PROC [length: INT, bitstring: Bitstring] ~ { T[hwhite, bitstring, hhblack, emit, length]; T[hhwhite, bitstring, black, emit, length]}; <> W[00, L[0,0,1,1,0,1,0,1,Z]]; W[01, L[0,0,0,1,1,1,Z]]; W[02, L[0,1,1,1,Z]]; W[03, L[1,0,0,0,Z]]; W[04, L[1,0,1,1,Z]]; W[05, L[1,1,0,0,Z]]; W[06, L[1,1,1,0,Z]]; W[07, L[1,1,1,1,Z]]; W[08, L[1,0,0,1,1,Z]]; W[09, L[1,0,1,0,0,Z]]; W[10, L[0,0,1,1,1,Z]]; W[11, L[0,1,0,0,0,Z]]; W[12, L[0,0,1,0,0,0,Z]]; W[13, L[0,0,0,0,1,1,Z]]; W[14, L[1,1,0,1,0,0,Z]]; W[15, L[1,1,0,1,0,1,Z]]; W[16, L[1,0,1,0,1,0,Z]]; W[17, L[1,0,1,0,1,1,Z]]; W[18, L[0,1,0,0,1,1,1,Z]]; W[19, L[0,0,0,1,1,0,0,Z]]; W[20, L[0,0,0,1,0,0,0,Z]]; W[21, L[0,0,1,0,1,1,1,Z]]; W[22, L[0,0,0,0,0,1,1,Z]]; W[23, L[0,0,0,0,1,0,0,Z]]; W[24, L[0,1,0,1,0,0,0,Z]]; W[25, L[0,1,0,1,0,1,1,Z]]; W[26, L[0,0,1,0,0,1,1,Z]]; W[27, L[0,1,0,0,1,0,0,Z]]; W[28, L[0,0,1,1,0,0,0,Z]]; W[29, L[0,0,0,0,0,0,1,0,Z]]; W[30, L[0,0,0,0,0,0,1,1,Z]]; W[31, L[0,0,0,1,1,0,1,0,Z]]; W[32, L[0,0,0,1,1,0,1,1,Z]]; W[33, L[0,0,0,1,0,0,1,0,Z]]; W[34, L[0,0,0,1,0,0,1,1,Z]]; W[35, L[0,0,0,1,0,1,0,0,Z]]; W[36, L[0,0,0,1,0,1,0,1,Z]]; W[37, L[0,0,0,1,0,1,1,0,Z]]; W[38, L[0,0,0,1,0,1,1,1,Z]]; W[39, L[0,0,1,0,1,0,0,0,Z]]; W[40, L[0,0,1,0,1,0,0,1,Z]]; W[41, L[0,0,1,0,1,0,1,0,Z]]; W[42, L[0,0,1,0,1,0,1,1,Z]]; W[43, L[0,0,1,0,1,1,0,0,Z]]; W[44, L[0,0,1,0,1,1,0,1,Z]]; W[45, L[0,0,0,0,0,1,0,0,Z]]; W[46, L[0,0,0,0,0,1,0,1,Z]]; W[47, L[0,0,0,0,1,0,1,0,Z]]; W[48, L[0,0,0,0,1,0,1,1,Z]]; W[49, L[0,1,0,1,0,0,1,0,Z]]; W[50, L[0,1,0,1,0,0,1,1,Z]]; W[51, L[0,1,0,1,0,1,0,0,Z]]; W[52, L[0,1,0,1,0,1,0,1,Z]]; W[53, L[0,0,1,0,0,1,0,0,Z]]; W[54, L[0,0,1,0,0,1,0,1,Z]]; W[55, L[0,1,0,1,1,0,0,0,Z]]; W[56, L[0,1,0,1,1,0,0,1,Z]]; W[57, L[0,1,0,1,1,0,1,0,Z]]; W[58, L[0,1,0,1,1,0,1,1,Z]]; W[59, L[0,1,0,0,1,0,1,0,Z]]; W[60, L[0,1,0,0,1,0,1,1,Z]]; W[61, L[0,0,1,1,0,0,1,0,Z]]; W[62, L[0,0,1,1,0,0,1,1,Z]]; W[63, L[0,0,1,1,0,1,0,0,Z]]; }; {B: PROC [length: INT, bitstring: Bitstring] ~ { T[hhblack, bitstring, white, emit, length]; T[hblack, bitstring, hhwhite, emit, length]}; <> B[00, L[0,0,0,0,1,1,0,1,1,1,Z]]; B[01, L[0,1,0,Z]]; B[02, L[1,1,Z]]; B[03, L[1,0,Z]]; B[04, L[0,1,1,Z]]; B[05, L[0,0,1,1,Z]]; B[06, L[0,0,1,0,Z]]; B[07, L[0,0,0,1,1,Z]]; B[08, L[0,0,0,1,0,1,Z]]; B[09, L[0,0,0,1,0,0,Z]]; B[10, L[0,0,0,0,1,0,0,Z]]; B[11, L[0,0,0,0,1,0,1,Z]]; B[12, L[0,0,0,0,1,1,1,Z]]; B[13, L[0,0,0,0,0,1,0,0,Z]]; B[14, L[0,0,0,0,0,1,1,1,Z]]; B[15, L[0,0,0,0,1,1,0,0,0,Z]]; B[16, L[0,0,0,0,0,1,0,1,1,1,Z]]; B[17, L[0,0,0,0,0,1,1,0,0,0,Z]]; B[18, L[0,0,0,0,0,0,1,0,0,0,Z]]; B[19, L[0,0,0,0,1,1,0,0,1,1,1,Z]]; B[20, L[0,0,0,0,1,1,0,1,0,0,0,Z]]; B[21, L[0,0,0,0,1,1,0,1,1,0,0,Z]]; B[22, L[0,0,0,0,0,1,1,0,1,1,1,Z]]; B[23, L[0,0,0,0,0,1,0,1,0,0,0,Z]]; B[24, L[0,0,0,0,0,0,1,0,1,1,1,Z]]; B[25, L[0,0,0,0,0,0,1,1,0,0,0,Z]]; B[26, L[0,0,0,0,1,1,0,0,1,0,1,0,Z]]; B[27, L[0,0,0,0,1,1,0,0,1,0,1,1,Z]]; B[28, L[0,0,0,0,1,1,0,0,1,1,0,0,Z]]; B[29, L[0,0,0,0,1,1,0,0,1,1,0,1,Z]]; B[30, L[0,0,0,0,0,1,1,0,1,0,0,0,Z]]; B[31, L[0,0,0,0,0,1,1,0,1,0,0,1,Z]]; B[32, L[0,0,0,0,0,1,1,0,1,0,1,0,Z]]; B[33, L[0,0,0,0,0,1,1,0,1,0,1,1,Z]]; B[34, L[0,0,0,0,1,1,0,1,0,0,1,0,Z]]; B[35, L[0,0,0,0,1,1,0,1,0,0,1,1,Z]]; B[36, L[0,0,0,0,1,1,0,1,0,1,0,0,Z]]; B[37, L[0,0,0,0,1,1,0,1,0,1,0,1,Z]]; B[38, L[0,0,0,0,1,1,0,1,0,1,1,0,Z]]; B[39, L[0,0,0,0,1,1,0,1,0,1,1,1,Z]]; B[40, L[0,0,0,0,0,1,1,0,1,1,0,0,Z]]; B[41, L[0,0,0,0,0,1,1,0,1,1,0,1,Z]]; B[42, L[0,0,0,0,1,1,0,1,1,0,1,0,Z]]; B[43, L[0,0,0,0,1,1,0,1,1,0,1,1,Z]]; B[44, L[0,0,0,0,0,1,0,1,0,1,0,0,Z]]; B[45, L[0,0,0,0,0,1,0,1,0,1,0,1,Z]]; B[46, L[0,0,0,0,0,1,0,1,0,1,1,0,Z]]; B[47, L[0,0,0,0,0,1,0,1,0,1,1,1,Z]]; B[48, L[0,0,0,0,0,1,1,0,0,1,0,0,Z]]; B[49, L[0,0,0,0,0,1,1,0,0,1,0,1,Z]]; B[50, L[0,0,0,0,0,1,0,1,0,0,1,0,Z]]; B[51, L[0,0,0,0,0,1,0,1,0,0,1,1,Z]]; B[52, L[0,0,0,0,0,0,1,0,0,1,0,0,Z]]; B[53, L[0,0,0,0,0,0,1,1,0,1,1,1,Z]]; B[54, L[0,0,0,0,0,0,1,1,1,0,0,0,Z]]; B[55, L[0,0,0,0,0,0,1,0,0,1,1,1,Z]]; B[56, L[0,0,0,0,0,0,1,0,1,0,0,0,Z]]; B[57, L[0,0,0,0,0,1,0,1,1,0,0,0,Z]]; B[58, L[0,0,0,0,0,1,0,1,1,0,0,1,Z]]; B[59, L[0,0,0,0,0,0,1,0,1,0,1,1,Z]]; B[60, L[0,0,0,0,0,0,1,0,1,1,0,0,Z]]; B[61, L[0,0,0,0,0,1,0,1,1,0,1,0,Z]]; B[62, L[0,0,0,0,0,1,1,0,0,1,1,0,Z]]; B[63, L[0,0,0,0,0,1,1,0,0,1,1,1,Z]]; }; {MW: PROC [length: INT, bitstring: Bitstring] ~ { T[hwhite, bitstring, hwhite, null, length]; T[hhwhite, bitstring, hhwhite, null, length]}; <> MW[0064, L[1,1,0,1,1,Z]]; MW[0128, L[1,0,0,1,0,Z]]; MW[0192, L[0,1,0,1,1,1,Z]]; MW[0256, L[0,1,1,0,1,1,1,Z]]; MW[0320, L[0,0,1,1,0,1,1,0,Z]]; MW[0384, L[0,0,1,1,0,1,1,1,Z]]; MW[0448, L[0,1,1,0,0,1,0,0,Z]]; MW[0512, L[0,1,1,0,0,1,0,1,Z]]; MW[0576, L[0,1,1,0,1,0,0,0,Z]]; MW[0640, L[0,1,1,0,0,1,1,1,Z]]; MW[0704, L[0,1,1,0,0,1,1,0,0,Z]]; MW[0768, L[0,1,1,0,0,1,1,0,1,Z]]; MW[0832, L[0,1,1,0,1,0,0,1,0,Z]]; MW[0896, L[0,1,1,0,1,0,0,1,1,Z]]; MW[0960, L[0,1,1,0,1,0,1,0,0,Z]]; MW[1024, L[0,1,1,0,1,0,1,0,1,Z]]; MW[1088, L[0,1,1,0,1,0,1,1,0,Z]]; MW[1152, L[0,1,1,0,1,0,1,1,1,Z]]; MW[1216, L[0,1,1,0,1,1,0,0,0,Z]]; MW[1280, L[0,1,1,0,1,1,0,0,1,Z]]; MW[1344, L[0,1,1,0,1,1,0,1,0,Z]]; MW[1408, L[0,1,1,0,1,1,0,1,1,Z]]; MW[1472, L[0,1,0,0,1,1,0,0,0,Z]]; MW[1536, L[0,1,0,0,1,1,0,0,1,Z]]; MW[1600, L[0,1,0,0,1,1,0,1,0,Z]]; MW[1664, L[0,1,1,0,0,0,Z]]; MW[1728, L[0,1,0,0,1,1,0,1,1,Z]]; }; {MB: PROC [length: INT, bitstring: Bitstring] ~ { T[hblack, bitstring, hblack, null, length]; T[hhblack, bitstring, hhblack, null, length]}; <> MB[0064, L[0,0,0,0,0,0,1,1,1,1,Z]]; MB[0128, L[0,0,0,0,1,1,0,0,1,0,0,0,Z]]; MB[0192, L[0,0,0,0,1,1,0,0,1,0,0,1,Z]]; MB[0256, L[0,0,0,0,0,1,0,1,1,0,1,1,Z]]; MB[0320, L[0,0,0,0,0,0,1,1,0,0,1,1,Z]]; MB[0384, L[0,0,0,0,0,0,1,1,0,1,0,0,Z]]; MB[0448, L[0,0,0,0,0,0,1,1,0,1,0,1,Z]]; MB[0512, L[0,0,0,0,0,0,1,1,0,1,1,0,0,Z]]; MB[0576, L[0,0,0,0,0,0,1,1,0,1,1,0,1,Z]]; MB[0640, L[0,0,0,0,0,0,1,0,0,1,0,1,0,Z]]; MB[0704, L[0,0,0,0,0,0,1,0,0,1,0,1,1,Z]]; MB[0768, L[0,0,0,0,0,0,1,0,0,1,1,0,0,Z]]; MB[0832, L[0,0,0,0,0,0,1,0,0,1,1,0,1,Z]]; MB[0896, L[0,0,0,0,0,0,1,1,1,0,0,1,0,Z]]; MB[0960, L[0,0,0,0,0,0,1,1,1,0,0,1,1,Z]]; MB[1024, L[0,0,0,0,0,0,1,1,1,0,1,0,0,Z]]; MB[1088, L[0,0,0,0,0,0,1,1,1,0,1,0,1,Z]]; MB[1152, L[0,0,0,0,0,0,1,1,1,0,1,1,0,Z]]; MB[1216, L[0,0,0,0,0,0,1,1,1,0,1,1,1,Z]]; MB[1280, L[0,0,0,0,0,0,1,0,1,0,0,1,0,Z]]; MB[1344, L[0,0,0,0,0,0,1,0,1,0,0,1,1,Z]]; MB[1408, L[0,0,0,0,0,0,1,0,1,0,1,0,0,Z]]; MB[1472, L[0,0,0,0,0,0,1,0,1,0,1,0,1,Z]]; MB[1536, L[0,0,0,0,0,0,1,0,1,1,0,1,0,Z]]; MB[1600, L[0,0,0,0,0,0,1,0,1,1,0,1,1,Z]]; MB[1664, L[0,0,0,0,0,0,1,1,0,0,1,0,0,Z]]; MB[1728, L[0,0,0,0,0,0,1,1,0,0,1,0,1,Z]]; }; {M: PROC [length: INT, bitstring: Bitstring] ~ { T[hwhite, bitstring, hwhite, null, length]; T[hhwhite, bitstring, hhwhite, null, length]; T[hblack, bitstring, hblack, null, length]; T[hhblack, bitstring, hhblack, null, length]}; <> M[1792, L[0,0,0,0,0,0,0,1,0,0,0,Z]]; M[1856, L[0,0,0,0,0,0,0,1,1,0,0,Z]]; M[1920, L[0,0,0,0,0,0,0,1,1,0,1,Z]]; M[1984, L[0,0,0,0,0,0,0,1,0,0,1,0,Z]]; M[2048, L[0,0,0,0,0,0,0,1,0,0,1,1,Z]]; M[2112, L[0,0,0,0,0,0,0,1,0,1,0,0,Z]]; M[2176, L[0,0,0,0,0,0,0,1,0,1,0,1,Z]]; M[2240, L[0,0,0,0,0,0,0,1,0,1,1,0,Z]]; M[2304, L[0,0,0,0,0,0,0,1,0,1,1,1,Z]]; M[2368, L[0,0,0,0,0,0,0,1,1,1,0,0,Z]]; M[2432, L[0,0,0,0,0,0,0,1,1,1,0,1,Z]]; M[2496, L[0,0,0,0,0,0,0,1,1,1,1,0,Z]]; M[2560, L[0,0,0,0,0,0,0,1,1,1,1,1,Z]]; }; {U: PROC [length: INT, bitstring: Bitstring] ~ { T[unc, bitstring, unc, one, length]}; U[1, L[1,Z]]; U[2, L[0,1,Z]]; U[3, L[0,0,1,Z]]; U[4, L[0,0,0,1,Z]]; U[5, L[0,0,0,0,1,Z]]; T[unc, L[0,0,0,0,0,1,Z], unc, zeros, 5]; }; FOR length: [0..4] IN [0..4] DO -- Patterns like 060n1T b: Bitstring ¬ ALL[0]; b[length+6] ¬ 1; b[length+7] ¬ 0; b[length+8] ¬ Z; T[unc, b, white, zeros, length]; b[length+7] ¬ 1; T[unc, b, black, zeros, length]; ENDLOOP; { <> T[uncb1, L[Z], unc, one, 1]; T[uncb2, L[Z], unc, one, 2]; T[uncb3, L[Z], unc, one, 3]; T[uncb4, L[Z], unc, one, 4]; T[uncb5, L[Z], unc, one, 5]; T[uncw1, L[Z], unc, zeros, 1]; T[uncw2, L[Z], unc, zeros, 2]; T[uncw3, L[Z], unc, zeros, 3]; T[uncw4, L[Z], unc, zeros, 4]; T[uncw5, L[Z], unc, zeros, 5]; }; }; END.