KipperSupportImpl: CEDAR PROGRAM IMPORTS Basics, IO, HashTable, RefText, Rope EXPORTS KipperSupport =
Error: PUBLIC ERROR[reason: Reason] = CODE;
KipperKey: LONG CARDINAL = 4207557320B;
KipperVersion: CARDINAL = 1;
CreateKipperer: PUBLIC PROC[s: IO.STREAM] RETURNS[Kipperer] =
BEGIN
kipperer: Kipperer ← NEW[KippererBody←[s, 1, NIL]];
KipperLongCardinal[kipperer, KipperKey];
KipperCardinal[kipperer, KipperVersion];
RETURN[kipperer];
END;
CreateUnKipperer: PUBLIC PROC[s: IO.STREAM] RETURNS[UnKipperer] =
BEGIN
unKipperer: UnKipperer ← NEW[UnKippererBody←[s, 1, NIL]];
key: LONG CARDINAL ← UnKipperLongCardinal[unKipperer];
version: CARDINAL;
IF key # KipperKey THEN Error[notAKipperStream];
version ← UnKipperCardinal[unKipperer];
IF version # KipperVersion THEN Error[wrongKipperVersion];
RETURN[unKipperer];
END;
KipperBoolean: PUBLIC PROC[kipperer: Kipperer, boolean: BOOLEAN] =
{KipperCardinal[kipperer, IF boolean THEN 1 ELSE 0]};
UnKipperBoolean: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[BOOLEAN] =
{RETURN[UnKipperCardinal[unKipperer] = 1]};
KipperCardinal: PUBLIC PROC[kipperer: Kipperer, cardinal: CARDINAL] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@cardinal], LONG POINTER TO Basics.RawBytes], 0, 2]]};
UnKipperCardinal: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: CARDINAL] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR};
KipperCharacter: PUBLIC PROC[kipperer: Kipperer, character: CHARACTER] =
{KipperCardinal[kipperer, ORD[character]]};
UnKipperCharacter: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[CHARACTER] =
{RETURN[VAL[UnKipperCardinal[unKipperer]]]};
KipperInt: PUBLIC PROC[kipperer: Kipperer, int: INT] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@int], LONG POINTER TO Basics.RawBytes], 0, 4]]};
UnKipperInt: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: INT] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 4]] # 4 THEN ERROR};
KipperInteger: PUBLIC PROC[kipperer: Kipperer, integer: INTEGER] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@integer], LONG POINTER TO Basics.RawBytes], 0, 2]]};
UnKipperInteger: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: INTEGER] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR};
KipperLongCardinal: PUBLIC PROC[kipperer: Kipperer, longCardinal: LONG CARDINAL] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@longCardinal], LONG POINTER TO Basics.RawBytes], 0, 4]]};
UnKipperLongCardinal: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: LONG CARDINAL] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 4]] # 4 THEN ERROR};
KipperNat: PUBLIC PROC[kipperer: Kipperer, nat: NAT] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@nat], LONG POINTER TO Basics.RawBytes], 0, 4]]};
UnKipperNat: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[NAT] = TRUSTED
BEGIN
result: LONG CARDINAL;
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 4]] # 4 THEN ERROR;
RETURN[result];
END;
KipperReal: PUBLIC PROC[kipperer: Kipperer, real: REAL] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@real], LONG POINTER TO Basics.RawBytes], 0, 4]]};
UnKipperReal: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: REAL] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 4]] # 4 THEN ERROR};
KipperRefText: PUBLIC PROC[kipperer: Kipperer, refText: REF TEXT] =
{KipperRope[kipperer, Rope.FromRefText[refText]]};
UnKipperRefText: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[REF TEXT] =
{RETURN[Rope.ToRefText[UnKipperRope[unKipperer]]]};
RopeBundleSize: CARDINAL ← 100;
KipperRope: PUBLIC PROC[kipperer: Kipperer, rope: Rope.ROPE] = TRUSTED
BEGIN
IF KipperRef[kipperer, rope] THEN
BEGIN
textBuffer: REF TEXT ← RefText.ObtainScratch[RopeBundleSize];
BEGIN ENABLE UNWIND => RefText.ReleaseScratch[textBuffer];
position: INT ← 0;
remaining: INT ← Rope.Length[rope];
thisBundleSize: CARDINAL;
thisByteCount: CARDINAL;
WHILE remaining > 0 DO
thisBundleSize ← Rope.AppendChars[textBuffer, rope, position, RopeBundleSize];
thisByteCount ← ((thisBundleSize+1)/2)*2;
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@thisBundleSize], LONG POINTER TO Basics.RawBytes], 0, 2]];
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[BASE[DESCRIPTOR[textBuffer^]], LONG POINTER TO Basics.RawBytes], 0, thisByteCount]];
textBuffer.length ← 0;
position ← position+thisBundleSize;
remaining ← remaining-thisBundleSize;
ENDLOOP;
thisBundleSize ← 0;
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@thisBundleSize], LONG POINTER TO Basics.RawBytes], 0, 2]];
END;
RefText.ReleaseScratch[textBuffer];
END;
END;
UnKipperRope: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[Rope.ROPE] = TRUSTED
BEGIN
flag: BOOLEAN; ref: REF ANY;
[flag, ref] ← UnKipperRef[unKipperer];
IF NOT flag THEN RETURN[NARROW[ref]] ELSE
BEGIN
textBuffer: REF TEXT ← RefText.ObtainScratch[RopeBundleSize];
result: Rope.ROPE ← NIL;
BEGIN ENABLE UNWIND => RefText.ReleaseScratch[textBuffer];
thisBundleSize: CARDINAL;
thisByteCount: CARDINAL;
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@thisBundleSize], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR;
WHILE thisBundleSize > 0 DO
thisByteCount ← ((thisBundleSize+1)/2)*2;
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[BASE[DESCRIPTOR[textBuffer^]], LONG POINTER TO Basics.RawBytes], 0, thisByteCount]] # thisByteCount THEN ERROR;
textBuffer.length ← thisBundleSize;
result ← Rope.Cat[result, Rope.FromRefText[textBuffer]];
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@thisBundleSize], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR;
ENDLOOP;
END;
RefText.ReleaseScratch[textBuffer];
RecordUnKipperedRef[unKipperer, result];
RETURN[result];
END;
END;
KipperWord: PUBLIC PROC[kipperer: Kipperer, word: WORD] = TRUSTED
{IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@word], LONG POINTER TO Basics.RawBytes], 0, 2]]};
UnKipperWord: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[result: WORD] = TRUSTED
{IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@result], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR};
KipperRef: PUBLIC PROC[kipperer: Kipperer, r: REF ANY] RETURNS[kipperTheBody: BOOLEAN] = TRUSTED
BEGIN
first a one word flag, perhaps followed by more data
0 for body follows -- this agrees with Lupine "ref=NIL", when ref is non NIL.
1 for NIL -- this agrees with Lupine "ref=NIL", when ref is NIL.
2 for encoding as INT follows, assumes same ref was seen earlier
IF r = NIL THEN
BEGIN
one: CARDINAL ← 1;
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@one], LONG POINTER TO Basics.RawBytes], 0, 2]];
RETURN[FALSE];
END
ELSE
BEGIN
refEncoding: LONG CARDINAL ← LookUpPossiblyKipperedRef[kipperer, r, kipperer.refCounter];
IF refEncoding # 0 THEN
BEGIN
two: CARDINAL ← 2;
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@two], LONG POINTER TO Basics.RawBytes], 0, 2]];
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@refEncoding], LONG POINTER TO Basics.RawBytes], 0, 4]];
RETURN[FALSE];
END
ELSE
BEGIN
zero: CARDINAL ← 0;
IO.UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@zero], LONG POINTER TO Basics.RawBytes], 0, 2]];
kipperer.refCounter ← kipperer.refCounter+1;
RETURN[TRUE];
END;
END;
END;
UnKipperRef: PUBLIC PROC[unKipperer: UnKipperer] RETURNS[kipperTheBody: BOOLEAN, ref: REF ANY] = TRUSTED
BEGIN
flag: CARDINAL;
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@flag], LONG POINTER TO Basics.RawBytes], 0, 2]] # 2 THEN ERROR;
SELECT flag FROM
0 => RETURN[TRUE, NIL];
1 => RETURN[FALSE, NIL];
2 =>
BEGIN
code: LONG CARDINAL;
IF IO.UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@code], LONG POINTER TO Basics.RawBytes], 0, 4]] # 4 THEN ERROR;
RETURN[FALSE, LookUpPreviouslyUnKipperedRef[unKipperer.refTable, code]];
END;
ENDCASE => ERROR;
END;
RecordUnKipperedRef: PUBLIC PROC[unKipperer: UnKipperer, r: REF ANY] =
BEGIN
IF unKipperer.refTable = NIL THEN
{unKipperer.refTable ← HashTable.Create[equal: EqualCode, hash: HashCode]};
IF NOT HashTable.Insert[unKipperer.refTable, NEW[LONG CARDINAL ← unKipperer.refCounter], r] THEN ERROR;
unKipperer.refCounter ← unKipperer.refCounter + 1;
END;
LookUpPreviouslyUnKipperedRef: PROC[t: HashTable.Table, code: LONG CARDINAL] RETURNS[REF ANY] =
BEGIN
found: BOOLEAN; ref: REF ANY;
[found, ref] ← HashTable.Fetch[t, NEW[LONG CARDINAL ← code]];
IF NOT found THEN ERROR;
RETURN[ref];
END;
LookUpPossiblyKipperedRef: PROC[kipperer: Kipperer, r: REF ANY, c: LONG CARDINAL] RETURNS[LONG CARDINAL] =
BEGIN
found: BOOLEAN; indexRef: REF ANY;
codedRef: REF LONG CARDINAL;
IF kipperer.refTable = NIL THEN
{kipperer.refTable ← HashTable.Create[equal: EqualRef, hash: HashRef]};
[found, indexRef] ← HashTable.Fetch[kipperer.refTable, r];
IF found THEN RETURN[NARROW[indexRef, REF LONG CARDINAL]^];
codedRef ← NEW[LONG CARDINAL ← c];
IF NOT HashTable.Insert[kipperer.refTable, r, codedRef] THEN ERROR;
RETURN[0];
END;
EqualRef: SAFE PROC[a: HashTable.Key, b: HashTable.Key] RETURNS[BOOLEAN] = CHECKED
{RETURN[a=b]};
HashRef: SAFE PROC[a: REF ANY] RETURNS[CARDINAL] = CHECKED
{RETURN[Basics.LowHalf[LOOPHOLE[a]]]};
EqualCode: SAFE PROC[a: HashTable.Key, b: HashTable.Key] RETURNS[BOOLEAN] = CHECKED
{RETURN[NARROW[a, REF LONG CARDINAL]^ = NARROW[b, REF LONG CARDINAL]^]};
HashCode: SAFE PROC[a: REF ANY] RETURNS[CARDINAL] = CHECKED
{RETURN[Basics.LowHalf[NARROW[a, REF LONG CARDINAL]^]]};