-- KipperSupportImpl.mesa December 6, 1985 9:35:33 am PST
-- Sturgis, January 6, 1986 1:26:43 pm PST

DIRECTORY
Basics USING[LowHalf, RawBytes],
HashTable USING[Create, Fetch, Insert, Key, Table],
IO USING[STREAM, UnsafeGetBlock, UnsafePutBlock],
KipperSupport USING[Kipperer, KippererBody, Reason, UnKipperer, UnKippererBody],
RefText USING[ObtainScratch, ReleaseScratch],
Rope USING[AppendChars, Cat, FromRefText, Length, ROPE, ToRefText];

KipperSupportImpl: CEDAR PROGRAM IMPORTS Basics, IO, HashTable, RefText, Rope EXPORTS KipperSupport =
BEGIN OPEN 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

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


END..

jCreation procedures
Client callable procedures


Private Procedures called by generated stubs
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
�ÊÁ˜Jš
œ9˜9J˜*J˜˜	J˜ J˜3J˜1Jš
œP˜PJ˜-J˜CJ˜—š
œe˜eJš
œ˜J˜J™˜JšÏbœ&˜+J˜'J˜J˜š�œ/˜=Jš
œ˜Jš
œ3˜3Jš
œ(˜(Jš
œ(˜(Jš
œ˜J˜—J˜š�œ1˜AJš
œ˜Jš
œ9˜9J˜6J˜Jš
œ0˜0J˜'Jš
œ:˜:Jš
œ˜J˜—J˜—J˜J™™š�
œ5˜BJ˜5J˜—š�œ8˜GJ˜+—J˜š�œ?˜MJš
œi˜iJ˜—š�œI˜YJš
œ{˜{—J˜š�œ9˜HJš
œ+˜+J˜—š�œ:˜KJ˜,—J˜š�	œ5˜>Jš
œd˜dJ˜—š�œD˜OJš
œ{˜{—J˜š�
œ=˜JJš
œh˜hJ˜—š�œH˜WJš
œ{˜{—J˜š�œH˜ZJš
œm˜m—J˜š�œN˜bJš
œ{˜{—J˜š�	œ5˜>Jš
œd˜dJ˜—š�œ=˜HJš
œ˜J˜Jš
œy˜yJ˜J˜—J˜š�
œ7˜AJš
œe˜eJ˜—š�œE˜QJš
œ{˜{J˜—š�
œ6˜CJš
œ2˜2—J˜š�œ9˜HJš
œ3˜3——˜J˜J˜J˜š�
œ<˜FJ˜˜!J˜˜=J˜:J˜J˜#J˜J˜˜J˜NJ˜)J˜mJ˜�
J˜J˜#J˜%J˜—J˜J˜mJ˜—J˜#J˜—J˜—J˜š�œB˜NJ˜J˜Jš
œ&˜&˜)J˜J˜=˜J˜:J˜J˜Jš
œ�
˜�
˜J˜)Jš
œ¡
˜¡
J˜#J˜8Jš
œ�
˜�
J˜—J˜—J˜#J˜(J˜J˜—J˜—J˜š�
œ7˜AJš
œe˜e—J˜š�œE˜QJš
œ{˜{—J˜J˜J˜J™—™,J˜—˜š�	œW˜`J˜™4J™MJ™@J™@—J˜˜J˜J˜J˜bJ˜J˜—˜J˜Jš
œY˜Y˜J˜J˜J˜bJ˜jJ˜J˜—˜J˜J˜J˜cJ˜,J˜
J˜—J˜—J˜—J˜š�œ]˜hJ˜J˜Jš
œw˜w˜J˜J˜˜J˜J˜Jš
œw˜wJš
œH˜HJ˜—J˜—J˜—J˜š�œ3˜FJ˜š
œ!˜!Jš
œK˜K—Jš
œg˜gJš
œ2˜2J˜—J˜š
œ_˜_J˜J˜J˜=J˜J˜J˜—J˜š
œj˜jJ˜J˜"J˜˜J˜G—J˜:J˜;J˜"J˜CJ˜
J˜—J˜˜RJ˜—J˜˜:J˜&—J˜˜SJ˜H—J˜˜;J˜8——J˜J˜J˜——…—&È,ó