PixelArrayCCITTG4Impl.mesa
Copyright Ó 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Michael Plass, November 9, 1992 2:07 pm PST
Russ Atkinson (RRA) May 31, 1993 1:16 pm PDT
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];
Only fetch if we have less than this amount, so the resulting count will fit in a BitCount variable.
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
Hackery
ClipZero: PROC [x: INTEGER] RETURNS [NAT] = INLINE {
Equivalent to MAX[x, 0]
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;
};
PixelArrayCCITTG4Private support
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 {
NOTE: this entry is NOT MONITORED
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 => {
This is a literal run of bits
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;
We have a stored transition array, so use it
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 {
Need to make this pixel array into an immutable form
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 {
It is best to turn this line into a literal
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 {
We can save away the transitions simply by copying them over
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;
};
};
General support
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
};
PixelArray support
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 {
This is the fastest case; we can move the bits directly into the destination buffer without having to go through an intermediate scan-line buffer.
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
Explicit bounds check, so we can be compiled with bounds checks turned off and still be trustworthy.
Basics.RaiseBoundsFault[];
IF copyData # NIL THEN {
This is a bit special
FOR sSrc: INT IN [s..s+size.s) DO
WITH data.copyData[s] SELECT FROM
literal: REF Basics.RawBits =>
This is a literal run of bits
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 => {
We have a stored transition array, so use it
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 {
To copy the pixel array we first make the data pure, then we can set the immutable bit
WithData[MakePure, pa.data];
pa.immutable ¬ TRUE;
RETURN [pa];
};
Basic Decompression
transitionCountEstimate: NAT ¬ 400;
Start out with a smallish buffer; expand to maximum possible size (based on scanLength) if this is exceeded.
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 {
Take care of the trailing bits
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 {
Load w with the initial bits
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 {
Take care of the trailing bits
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] ~ {
Called on end-of-stream, which should never happen with valid 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]] ];
};
};
goodBitsIn: REF ARRAY [0..32] OF INT ¬ NEW[ARRAY [0..32] OF INT]; -- Stat
goodBitsOut: REF ARRAY [0..32] OF INT ¬ NEW[ARRAY [0..32] OF INT]; -- Stat
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] ~ {
NOTE: Reset must be called before the first call to Advance
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 {
This is an indication that we have fetched off the end of the world
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;
Refresh everything that might have changed
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 => {
Special cases for uncompressed and eoi
PullBits[6];
SELECT TRUE FROM
Peek[6] = 1 => {
eoi, test for end-of-line vs. end-of-data
SetTag: PROC = INLINE {
SELECT data.k FROM
< 0 => {};
0 => data.oneDimTag ¬ TRUE;
ENDCASE => {
For G3 data with K > 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;
};
We got an end-of-line code here, so exit if we are not at the start of a line (since we can see EOL codes at the start).
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 => {
uncompressed, defaults already set
EatBits[4];
state ¬ unc;
};
data.oneDimTag AND Peek[6] = 15 => {
uncompressed, defaults already set
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];
Refresh everything that might have changed
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 {
In this case the uncompressed data spans the scan line boundary; the original draft CCITT standard was ambiguous about whether this was legal, so the RES standard specified it as illegal. However, the final CCITT standard says it's OK, so we should handle it despite what the RES standard says.
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 {
Continue uncompressed data to next scan line.
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;
When examining x, the value of the current 13 leading bits, if the leading 4 bits are zeros (=> 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;
Less than this length is a terminal node
Greater than or equal to this length is a makeup code
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];
Scan 0
>= 48 => e ¬ [3, 1, scan];
>= 32 => e ¬ [3, -1, scan];
Scan +/- 1
>= 16 => e ¬ [3, 0, horiz];
Horizontal, 001
>= 8 => e ¬ [4, 0, pass];
Pass, 0001
6, 7 => e ¬ [6, 2, scan];
4, 5 => e ¬ [6, -2, scan];
Scan +/- 2
3 => e ¬ [7, 3, scan];
2 => e ¬ [7, -3, scan];
Scan +/- 3
ENDCASE;
Other non-simple cases
new[i] ¬ e;
ENDLOOP;
RETURN [new];
};
MyGetBytes: SAFE PROC [data: Data, gb: BitCount] RETURNS [WORD]
= TRUSTED <<INLINE>> {
Returns the next n bytes from the stream, LEFT-justified in the word
st: IO.STREAM = data.stream;
w: WORD ¬ 0;
tab: REF ByteArray = IF data.reverseBits THEN NIL ELSE reverseBitsTab;
Note: "reversed" means reversed from normal PC world order. Adobe behavior is reverseBits = true! firstBitLowOrder means that the first bit is the low-order bit in the byte.
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] ~ {
Assert: data.useFastScan AND j # scanLength
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 {
Fast Case, can pull the bits quickly without lots of checking
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;
Check for a non-run
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] ~ {
Assert: data.useFastScan AND j # scanLength
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 {
Fast Case, can pull the bits quickly without lots of checking
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 => {
This is a very common case, so we code it carefully. There is a specialized version of Scan at the front which takes advantage of some predicates (like j < scanLength).
ref: REF IndexSequenceRep ~ data.referenceTransitions;
WHILE GetTransition[ref, i] > j+1 DO i ¬ i - 1; ENDLOOP;
i ¬ i + (1 + color + i) MOD 2;
IF color = (i MOD 2) THEN i ¬ i + 1;
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 => {
A specialized version of Scan that goes forward 2 transitions is here. We do a Fill but leave the assumed color the same.
ref: REF IndexSequenceRep ~ data.referenceTransitions;
WHILE GetTransition[ref, i] > j+1 DO i ¬ i - 1; ENDLOOP;
i ¬ i + (1 + color + i) MOD 2;
IF color = (i MOD 2) THEN i ¬ i + 1;
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];
};
Table Building
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] ~ {
Call with data~dummy. Builds trees the first time they are needed.
IF data.roots = NIL THEN { data.roots ¬ BuildTrees[] };
RETURN [data.roots]
};
BuildTrees: PROC RETURNS [REF ARRAY State OF Node] ~ {
This builds trees with a fanout of two, i.e., all TreeNodes have bitCount=1, and then Optimizes them.
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] ~ {
Call with data~dummy.
old ¬ sparsity;
sparsity ¬ new;
data.roots ¬ NIL;
};
SetSparsity: PROC [new: CARD] RETURNS [CARD] ~ {
For experimenting with differently optimized tables.
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]};
Vertical mode codes
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]};
White run terminating codes
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]};
Black run terminating codes
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]};
White makeup codes
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]};
Black makeup codes
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]};
Common makeup codes
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;
{
These states are used to pick up when uncompressed data spans a scanline boundary.
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.