KipperSupportImpl.mesa December 6, 1985 9:35:33 am PST
Copyright Ó 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Sturgis, January 6, 1986 1:26:43 pm PST
Bill Jackson (bj) October 19, 1988 3:32:45 pm PDT
DIRECTORY
Basics USING [ Card16FromH, Card32FromF, FFromCard32, FFromInt32, FWORD, HFromCard16, HFromInt16, HWORD, Int16FromH, Int32FromF, LongNumber, LowHalf, RawBytes, SwapHalves ],
IO USING [ STREAM, UnsafeGetBlock, UnsafePutBlock ],
KipperSupport USING [ Kipperer, KippererBody, KipperCard16, KipperCard32, KipperRef, KipperRope, Reason, UnKipperCard16, UnKipperCard32, UnKipperRef, UnKipperRope, UnKipperer, UnKippererBody ],
RefTab USING [ Create, EqualProc, Fetch, HashProc, Insert, Ref ],
RefText USING [ ObtainScratch, ReleaseScratch ],
Rope USING [ AppendChars, Cat, FromRefText, Length, ROPE, ToRefText ];
KipperSupportImpl:
CEDAR
PROGRAM
IMPORTS Basics, IO, KipperSupport, RefTab, RefText, Rope
EXPORTS KipperSupport ~ {
OPEN KipperSupport;
Creation procedures
Error: PUBLIC ERROR [ reason: Reason ] ~ CODE;
KipperKey: CARD32 ~ 4207557320B; -- 221EDED0h, 572448464
KipperKeyFSwapped: CARD32 ~ 33664021036B; -- 0DED0221Eh, -556785122
KipperVersion: TYPE ~ MACHINE DEPENDENT { unknown(0), dMachine(1), fword(2), adaptive(3) };
CreateKipperer:
PUBLIC
PROC [ s:
IO.
STREAM ]
RETURNS [ k: Kipperer ] ~ {
context: Context ~ NEW[ContextObject ← [version: fword] ];
k ← NEW [KippererBody ← [s, 1, NIL, context]];
k.KipperCard32[KipperKey];
k.KipperCard16[KipperVersion.fword.ORD];
RETURN [k];
};
Context: TYPE ~ REF ContextObject;
ContextObject:
TYPE ~
RECORD [
version: KipperVersion
];
CreateUnKipperer:
PUBLIC
PROC [ s:
IO.
STREAM ]
RETURNS [ u: UnKipperer ] ~ {
key: CARD32;
version: CARD16;
context: Context ~ NEW[ContextObject ← [version: unknown] ];
u ← NEW [UnKippererBody ← [s, 1, NIL, context]];
key ← u.UnKipperCard32[];
SELECT
TRUE
FROM
( key = KipperKey ) => { NULL };
( key = KipperKeyFSwapped ) => { NULL };
ENDCASE => { Error[notAKipperStream] };
version ← u.UnKipperCard16[];
SELECT version
FROM
( KipperVersion.dMachine.ORD ) => { NULL };
( KipperVersion.fword.ORD ) => { NULL };
( KipperVersion.adaptive.ORD ) => { Error[unsupportedVersion] };
ENDCASE => { Error[wrongKipperVersion] };
context.version ← VAL[version];
RETURN [u];
};
Internal procedures
fzero: Basics.FWORD ~ [[0, 0], [0, 0]];
RawBytes: PROC [ local: POINTER ] RETURNS [ raw: LONG POINTER TO Basics.RawBytes ] ~
TRUSTED INLINE { raw ← LOOPHOLE[LONG[local], LONG POINTER TO Basics.RawBytes] };
InternalPut16:
PROC [ k: Kipperer, ptr:
POINTER ] ~
TRUSTED
INLINE {
k.stream.UnsafePutBlock[[RawBytes[ptr], 2, 2]]; -- magic here: dorado: 0, sparc: 2!
};
InternalGet16:
PROC [ u: UnKipperer, ptr:
POINTER ] ~
TRUSTED
INLINE {
IF ( u.stream.UnsafeGetBlock[[RawBytes[ptr], 2, 2]] # 2 ) THEN ERROR;
};
InternalPut32:
PROC [ k: Kipperer, ptr:
POINTER ] ~
TRUSTED
INLINE {
k.stream.UnsafePutBlock[[RawBytes[ptr], 0, 4]];
};
InternalGet32:
PROC [ u: UnKipperer, ptr:
POINTER ] ~
TRUSTED
INLINE {
context: Context ~ NARROW[u.private];
IF ( context.version = dMachine )
THEN {
dword32: Basics.LongNumber;
IF ( u.stream.UnsafeGetBlock[[RawBytes[@dword32], 0, 4]] # 4 ) THEN ERROR;
LOOPHOLE[ptr, POINTER TO Basics.LongNumber]^ ← Basics.SwapHalves[dword32];
}
ELSE {
IF ( u.stream.UnsafeGetBlock[[RawBytes[ptr], 0, 4]] # 4 ) THEN ERROR;
};
};
InternalPutBytes:
PROC [ k: Kipperer, ptr:
POINTER, bytes:
CARD16 ] ~
TRUSTED
INLINE {
k.stream.UnsafePutBlock[[RawBytes[ptr], 0, bytes]];
};
InternalGetBytes:
PROC [ u: UnKipperer, ptr:
POINTER, bytes:
CARD16 ] ~
TRUSTED
INLINE {
IF ( u.stream.UnsafeGetBlock[[RawBytes[ptr], 0, bytes]] # bytes ) THEN ERROR;
};
Client callable procedures
KipperBool:
PUBLIC
PROC [ k: Kipperer, bool:
BOOL ] ~ {
k.KipperCard16[IF ( bool ) THEN 1 ELSE 0];
};
UnKipperBool:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [
BOOL ] ~ {
RETURN [( u.UnKipperCard16[] = 1 )];
};
KipperCard16:
PUBLIC
PROC [ k: Kipperer, card16:
CARD16 ] ~
TRUSTED {
hword: Basics.HWORD ← Basics.HFromCard16[card16];
InternalPut16[k, @hword];
};
UnKipperCard16:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ card16:
CARD16 ] ~
TRUSTED {
fword: Basics.FWORD ← fzero; -- so we don't get trash
InternalGet16[u, @fword];
card16 ← Basics.Card16FromH[fword.lo];
};
KipperCard32:
PUBLIC
PROC [ k: Kipperer, card32:
CARD32 ] ~
TRUSTED {
fword: Basics.FWORD ← Basics.FFromCard32[card32];
InternalPut32[k, @fword];
};
UnKipperCard32:
PUBLIC
PROC [u: UnKipperer]
RETURNS [ card32:
CARD32 ] ~
TRUSTED {
fword: Basics.FWORD;
InternalGet32[u, @fword];
card32 ← Basics.Card32FromF[fword];
};
KipperChar:
PUBLIC
PROC [ k: Kipperer, char:
CHAR ] ~ {
k.KipperCard16[char.ORD];
};
UnKipperChar:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ char:
CHAR ] ~ {
RETURN [VAL[u.UnKipperCard16[]]];
};
KipperInt16:
PUBLIC
PROC [ k: Kipperer, int16:
INT16 ] ~
TRUSTED {
hword: Basics.HWORD ← Basics.HFromInt16[int16];
InternalPut16[k, @hword];
};
UnKipperInt16:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ int16:
INT16 ] ~
TRUSTED {
fword: Basics.FWORD ← fzero; -- so we don't get trash
InternalGet16[u, @fword];
int16 ← Basics.Int16FromH[fword.lo];
};
KipperInt32:
PUBLIC
PROC [ k: Kipperer, int32:
INT32 ] ~
TRUSTED {
fword: Basics.FWORD ← Basics.FFromInt32[int32];
InternalPut32[k, @fword];
};
UnKipperInt32:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ int32:
INT32 ] ~
TRUSTED {
fword: Basics.FWORD;
InternalGet32[u, @fword];
int32 ← Basics.Int32FromF[fword];
};
KipperNat31:
PUBLIC
PROC [ k: Kipperer, nat:
NAT ] ~
TRUSTED {
fword: Basics.FWORD ← Basics.FFromCard32[nat];
InternalPut32[k, @fword];
};
UnKipperNat31:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ nat:
NAT ] ~
TRUSTED {
fword: Basics.FWORD;
InternalGet32[u, @fword];
nat ← Basics.Card32FromF[fword];
};
FFromReal:
PROC [n:
REAL]
RETURNS [Basics.
FWORD]
= INLINE { RETURN[LOOPHOLE[n]] };
RealFromF:
PROC [f: Basics.
FWORD]
RETURNS [
REAL]
= INLINE { RETURN[LOOPHOLE[f]] };
KipperReal:
PUBLIC
PROC [ k: Kipperer, real:
REAL ] ~
TRUSTED {
fword: Basics.FWORD ← --Basics.--FFromReal[real];
InternalPut32[k, @fword];
};
UnKipperReal:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ real:
REAL ] ~
TRUSTED {
fword: Basics.FWORD;
InternalGet32[u, @fword];
real ← --Basics.--RealFromF[fword];
};
KipperRefText:
PUBLIC
PROC [ k: Kipperer, refText:
REF
TEXT ] ~ {
k.KipperRope[Rope.FromRefText[refText]];
};
UnKipperRefText:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ refText:
REF
TEXT ] ~ {
refText ← Rope.ToRefText[u.UnKipperRope[]];
};
RopeBundleSize: CARD16 ← 100;
KipperRope:
PUBLIC
PROC [ k: Kipperer, rope: Rope.
ROPE ] ~
TRUSTED {
IF ( k.KipperRef[rope] )
THEN {
textBuffer: REF TEXT ← RefText.ObtainScratch[RopeBundleSize];
{
ENABLE { UNWIND => RefText.ReleaseScratch[textBuffer] };
position: INT ← 0;
remaining: INT ← rope.Length[];
thisBundleSize: CARD16;
thisByteCount: CARD16;
WHILE ( remaining > 0 )
DO
thisBundleSize ← Rope.AppendChars[textBuffer, rope, position, RopeBundleSize];
thisByteCount ← ( ( thisBundleSize + 1 ) / 2 ) * 2;
InternalPut16[k, @thisBundleSize];
InternalPutBytes[k, BASE[DESCRIPTOR[textBuffer^]], thisByteCount];
textBuffer.length ← 0;
position ← position + thisBundleSize;
remaining ← remaining - thisBundleSize;
ENDLOOP;
thisBundleSize ← 0;
InternalPut16[k, @thisBundleSize];
};
RefText.ReleaseScratch[textBuffer];
};
};
UnKipperRope:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ rope: Rope.
ROPE ←
NIL ] ~
TRUSTED {
flag: BOOL; ref: REF ANY;
[flag, ref] ← u.UnKipperRef[];
IF (
NOT flag )
THEN {
rope ← NARROW[ref];
RETURN;
}
ELSE {
textBuffer: REF TEXT ← RefText.ObtainScratch[RopeBundleSize];
{
ENABLE { UNWIND => RefText.ReleaseScratch[textBuffer] };
thisBundleSize:
CARD16 ← u.UnKipperCard16[];
InternalGet16[u, @thisBundleSize]; - could be more efficient
WHILE ( thisBundleSize > 0 )
DO
thisByteCount: CARD16 ~ ( ( thisBundleSize + 1 ) / 2 ) * 2;
InternalGetBytes[u, BASE[DESCRIPTOR[textBuffer^]], thisByteCount];
textBuffer.length ← thisBundleSize;
rope ← rope.Cat[Rope.FromRefText[textBuffer]];
thisBundleSize ← u.UnKipperCard16[];
InternalGet16[u, @thisBundleSize]; - could be more efficient
ENDLOOP;
};
RefText.ReleaseScratch[textBuffer];
RecordUnKipperedRef[u, rope];
RETURN;
};
};
KipperWord:
PUBLIC
PROC [ k: Kipperer, word:
WORD ] ~
TRUSTED {
hword: Basics.HWORD ← Basics.HFromCard16[word];
InternalPut16[k, @hword];
};
UnKipperWord:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ word:
WORD ] ~
TRUSTED {
fword: Basics.FWORD ← fzero; -- so we don't get trash
InternalGet16[u, @fword];
word ← Basics.Card16FromH[fword.lo];
};
Private Procedures called by generated stubs
KipperRef:
PUBLIC
PROC [ k: Kipperer, r:
REF
ANY ]
RETURNS [ kipperTheBody:
BOOL ] ~
TRUSTED {
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 {
one: CARD16 ← 1;
InternalPut16[k, @one];
kipperTheBody ← FALSE;
RETURN;
}
ELSE {
refEncoding: CARD32 ← LookUpPossiblyKipperedRef[k, r, k.refCounter];
IF ( refEncoding # 0 )
THEN {
two: CARD16 ← 2;
InternalPut16[k, @two];
InternalPut32[k, @refEncoding];
kipperTheBody ← FALSE;
RETURN;
}
ELSE {
zero: CARD16 ← 0;
InternalPut16[k, @zero];
k.refCounter ← k.refCounter.SUCC;
kipperTheBody ← TRUE;
RETURN;
};
};
};
UnKipperRef:
PUBLIC
PROC [ u: UnKipperer ]
RETURNS [ kipperTheBody:
BOOL, ref:
REF
ANY ] ~
TRUSTED {
flag:
CARD16 ← u.UnKipperCard16[];
InternalGet16[u, @flag]; - could be more efficient
SELECT flag
FROM
0 => { RETURN [TRUE, NIL] };
1 => { RETURN [FALSE, NIL] };
2 => {
code: CARD32;
InternalGet32[u, @code];
RETURN [FALSE, LookUpPreviouslyUnKipperedRef[u.refTable, code]];
};
ENDCASE => { ERROR };
};
RecordUnKipperedRef:
PUBLIC
PROC [ u: UnKipperer, r:
REF
ANY ] ~ {
IF ( u.refTable =
NIL )
THEN {
u.refTable ← RefTab.Create[equal: EqualCode, hash: HashCode];
};
IF ( NOT u.refTable.Insert[NEW [CARD32 ← u.refCounter], r] ) THEN ERROR;
u.refCounter ← u.refCounter.SUCC;
};
LookUpPreviouslyUnKipperedRef:
PROC [ t: RefTab.Ref, code:
CARD32 ]
RETURNS [ ref:
REF
ANY ] ~ {
found: BOOL;
[found, ref] ← t.Fetch[NEW [CARD32 ← code]];
IF ( NOT found ) THEN ERROR;
RETURN;
};
LookUpPossiblyKipperedRef:
PROC [ k: Kipperer, r:
REF
ANY, c:
CARD32 ]
RETURNS [ card32:
CARD32 ← 0 ] ~ {
IF ( k.refTable =
NIL )
THEN {
k.refTable ← RefTab.Create[equal: EqualRef, hash: HashRef];
};
{
found: BOOL; indexRef: REF ANY;
[found, indexRef] ← k.refTable.Fetch[r];
IF ( found ) THEN { card32 ← NARROW[indexRef, REF CARD32]^; RETURN};
};
{
codedRef: REF CARD32;
codedRef ← NEW [CARD32 ← c];
IF ( NOT k.refTable.Insert[r, codedRef] ) THEN ERROR;
};
RETURN;
};
EqualRef: RefTab.EqualProc ~
CHECKED {
RETURN [( key1 = key2 )];
};
HashRef: RefTab.HashProc ~
CHECKED {
RETURN [Basics.LowHalf[LOOPHOLE[key]]];
};
EqualCode: RefTab.EqualProc ~
CHECKED {
RETURN [NARROW[key1, REF CARD32]^ = NARROW[key2, REF CARD32]^];
};
HashCode: RefTab.HashProc ~
CHECKED {
RETURN [Basics.LowHalf[NARROW[key, REF CARD32]^]];
};
}.