KipperSupportImpl.mesa December 6, 1985 9:35:33 am PST
Copyright Ó 1985, 1986, 1987, 1992 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
Willie-s, April 9, 1992 10:03 am PDT
DIRECTORY
Basics USING [ Card16FromH, Card32FromF, FFromCard32, FFromInt32, FWORD, HFromCard16, HFromInt16, HWORD, Int16FromH, Int32FromF, LongNumber, LowHalf, RawBytes ],
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, Concat, 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;
SwapHalves: PROC[ln: Basics.LongNumber] RETURNS[swp: Basics.LongNumber] ~ TRUSTED INLINE {
swp.hi ¬ ln.lo;
swp.lo ¬ ln.hi;
};
IF ( u.stream.UnsafeGetBlock[[RawBytes[@dword32], 0, 4]] # 4 ) THEN ERROR;
LOOPHOLE[ptr, POINTER TO Basics.LongNumber]­ ¬ 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.Concat[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]­]];
};
}.