RCMapEncodeImpl.mesa
Copyright Ó 1987, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) July 25, 1988 11:05:23 pm PDT
Willie-s, September 24, 1991 1:46 pm PDT
DIRECTORY
Basics,
RCMap,
RCMapEncode,
RefText;
RCMapEncodeImpl: MONITOR
IMPORTS RefText
EXPORTS RCMapEncode
= {
Stack: TYPE = REF StackRep;
StackRep: TYPE = RECORD [
len: NAT,
elems: SEQUENCE max: NAT OF RCMap.Index];
indirectCode: NAT = RCMap.ObjectKind.LAST.ORD.SUCC;
encodeMod: NAT = 64;
MapToDesc: PUBLIC PROC [base: RCMap.Base, first: RCMap.Index, text: REF TEXT]
RETURNS [REF TEXT] = {
stack: Stack ¬ AllocStack[];
appendByte: PROC [byte: BYTE] = {
text ¬ RefText.InlineAppendChar[text, VAL[byte]];
};
append: PROC [int: INT] = {
ln: Basics.LongNumber ¬ [int[int]];
SELECT ln.card FROM
< encodeMod =>
appendByte[ln.ll];
< encodeMod*256 => {
appendByte[encodeMod*1+ln.lh];
appendByte[ln.ll];
};
< encodeMod*LONG[256]*256 => {
appendByte[encodeMod*2+ln.hl];
appendByte[ln.lh];
appendByte[ln.ll];
};
ENDCASE => {
prefix: NAT ¬ encodeMod*3;
IF ln.int < 0 AND ln.int > - encodeMod THEN {
Special case for small negative numbers
appendByte[prefix-ln.int];
RETURN;
};
appendByte[prefix];
appendByte[ln.hh];
appendByte[ln.hl];
appendByte[ln.lh];
appendByte[ln.ll];
};
};
inner: PROC [rcmi: RCMap.Index] = {
DO
rp: LONG POINTER TO RCMap.Object = @base[rcmi];
kind: RCMap.ObjectKind ¬ rp.type;
WITH rpe: rp­ SELECT FROM
null, ref, controlLink => appendByte[kind.ORD];
ENDCASE => {
len: NAT ¬ stack.len;
First, look through the current stack for a previous entry for this index
FOR i: NAT IN [0..len) DO
IF stack[i] = rcmi THEN {
Found it!
append[indirectCode+i];
RETURN;
};
ENDLOOP;
Well, we have to add this index onto the stack
stack ¬ PushStack[stack, rcmi];
appendByte[kind.ORD];
WITH rpe: rp­ SELECT FROM
oneRef => {
append[rpe.offset];
};
simple => {
code: CARD16 ¬ 0;
refs: PACKED ARRAY [0..RCMap.simpleLength) OF BOOL ¬ rpe.refs;
FOR i: NAT DECREASING IN [0..RCMap.simpleLength) DO
code ¬ code + code + ORD[refs[i]];
ENDLOOP;
append[code];
};
linked => {
append[rpe.first];
rcmi ¬ rpe.rest;
LOOP;
};
nonVariant => {
n: NAT ¬ rpe.nComponents;
IF NOT rpe.complete THEN ERROR;
append[n];
FOR i: NAT IN [0..n) DO
rcf: RCMap.RCField ¬ rpe[i];
append[rcf.unitOffset];
inner[rcf.rcmi];
ENDLOOP;
};
variant => {
n: NAT ¬ rpe.nVariants;
IF NOT rpe.complete THEN ERROR;
append[rpe.fdTag.bitOffset];
append[rpe.fdTag.bitCount];
append[n];
FOR i: NAT IN [0..n) DO
inner[rpe[i]];
ENDLOOP;
};
array => {
append[rpe.offset];
append[rpe.unitsPerElement];
append[rpe.nElements];
rcmi ¬ rpe.rcmi;
LOOP;
};
sequence => {
append[rpe.offset];
append[rpe.unitsPerElement];
append[rpe.fdLength.bitOffset];
append[rpe.fdLength.bitCount];
inner[rpe.commonPart];
append[rpe.dataOffset];
rcmi ¬ rpe.rcmi;
LOOP;
};
ENDCASE => ERROR;
};
RETURN;
ENDLOOP;
};
inner[first];
FreeStack[stack];
RETURN [text];
};
LookupProc: TYPE = PROC [rp: LONG POINTER TO RCMap.Object]
RETURNS [index: RCMap.Index, found: BOOL];
DescToIndex: PUBLIC PROC [text: REF TEXT, uz: UNCOUNTED ZONE, lookup: LookupProc]
RETURNS [RCMap.Index] = {
stack: Stack ¬ AllocStack[];
getNext: PROC RETURNS [INT] = {
b: BYTE = text[pos].ORD;
mod: BYTE = b MOD encodeMod;
ln: Basics.LongNumber ¬ [card[0]];
SELECT (b / encodeMod) FROM
0 => {
ln.ll ¬ mod;
pos ¬ pos + 1;
};
1 => {
ln.lh ¬ mod;
ln.ll ¬ text[pos+1].ORD;
pos ¬ pos + 2;
};
2 => {
ln.hl ¬ mod;
ln.lh ¬ text[pos+1].ORD;
ln.ll ¬ text[pos+2].ORD;
pos ¬ pos + 3;
};
3 => {
pos ¬ pos + 1;
IF mod # 0 THEN RETURN [-mod];
ln.hh ¬ text[pos+0].ORD;
ln.hl ¬ text[pos+1].ORD;
ln.lh ¬ text[pos+2].ORD;
ln.ll ¬ text[pos+3].ORD;
pos ¬ pos + 4;
};
ENDCASE => ERROR;
RETURN [ln.int];
};
inner: PROC RETURNS [RCMap.Index] = {
first: INT ¬ getNext[];
IF first >= indirectCode
THEN {
Indirect into the stack
RETURN [stack[first-indirectCode]];
}
ELSE {
Have to look it up
kind: RCMap.ObjectKind ¬ VAL[BYTE[first]];
rp: LONG POINTER TO RCMap.Object ¬ NIL;
index: RCMap.Index;
found: BOOL;
SELECT kind FROM
null => RETURN [RCMap.nullIndex];
ref => RETURN [RCMap.refIndex];
controlLink => RETURN [RCMap.controlLinkIndex];
oneRef => {
rp ¬ uz.NEW[RCMap.Object ¬ [oneRef[offset: getNext[]]]];
};
simple => {
code: CARD16 ¬ getNext[];
len: CARD16 ¬ 0;
rpp: LONG POINTER TO RCMap.Object.simple ¬ uz.NEW[RCMap.Object.simple ¬ [simple[]]];
needs more work here
rp ¬ rpp;
};
linked => {
first: INT ¬ getNext[];
rest: RCMap.Index ¬ inner[];
rpp: LONG POINTER TO RCMap.Object.linked ¬ uz.NEW[RCMap.Object.linked ¬ [linked[first: first, rest: rest]]];
rp ¬ rpp;
};
nonVariant => {
n: NAT ¬ getNext[];
rpp: LONG POINTER TO RCMap.Object.nonVariant ¬ uz.NEW[RCMap.Object.nonVariant[n]];
FOR i: NAT IN [0..n) DO
offset: INT ¬ getNext[];
index: RCMap.Index ¬ inner[];
rpp­[i] ¬ [offset, index];
ENDLOOP;
rp ¬ rpp;
};
variant => {
tagOffset: INT ¬ getNext[];
tagCount: INT ¬ getNext[];
n: NAT ¬ getNext[];
rpp: LONG POINTER TO RCMap.Object.variant ¬ uz.NEW[RCMap.Object.variant[n]];
rpp.fdTag ¬ [bitOffset: tagOffset, bitCount: tagCount];
FOR i: NAT IN [0..n) DO
index: RCMap.Index ¬ inner[];
rpp­[i] ¬ index;
ENDLOOP;
rp ¬ rpp;
};
array => {
unitsPerElement: INT ¬ getNext[];
nElements: INT ¬ getNext[];
index: RCMap.Index ¬ inner[];
rpp: LONG POINTER TO RCMap.Object.array
¬ uz.NEW[RCMap.Object.array ¬ [array[
unitsPerElement: unitsPerElement,
nElements: nElements,
rcmi: index]]];
rp ¬ rpp;
};
array => {
offset: INT ¬ getNext[];
unitsPerElement: INT ¬ getNext[];
tagOffset: INT ¬ getNext[];
tagCount: INT ¬ getNext[];
common: RCMap.Index ¬ inner[];
dataOffset: INT ¬ getNext[];
index: RCMap.Index ¬ inner[];
rpp: LONG POINTER TO RCMap.Object.sequence
¬ uz.NEW[RCMap.Object.sequence ¬ [sequence[
offset: offset,
unitsPerElement: unitsPerElement,
fdLength: [tagOffset, tagCount],
commonPart: common,
dataOffset: dataOffset,
rcmi: index]]];
rp ¬ rpp;
};
ENDCASE;
[index, found] ¬ lookup[rp];
IF found THEN uz.FREE[@rp] ELSE stack ¬ PushStack[stack, index];
RETURN [index];
};
};
pos: NAT ¬ 0;
result: RCMap.Index ¬ inner[];
FreeStack[stack];
RETURN [result];
};
stackCache: Stack ¬ NIL;
AllocStack: ENTRY PROC RETURNS [Stack] = {
stack: Stack ¬ stackCache;
IF stack = NIL THEN stack ¬ NEW[StackRep[24]];
stack.len ¬ 0;
stackCache ¬ NIL;
RETURN [stack];
};
FreeStack: ENTRY PROC [stack: Stack] = {
IF stack # NIL THEN {
IF stackCache # NIL THEN FREE[@stackCache];
stackCache ¬ stack;
};
};
PushStack: PROC [stack: Stack, index: RCMap.Index] RETURNS [Stack] = {
len: NAT ¬ stack.len;
IF len = stack.max THEN {
In this case the stack needs extension
old: Stack ¬ stack;
oldLen: NAT ¬ old.len;
newLen: NAT ¬ MAX[oldLen, 24] + MIN[oldLen, 256];
new: Stack ¬ NEW[StackRep[newLen]];
FOR i: NAT IN [0..oldLen) DO
new[i] ¬ old[i];
ENDLOOP;
new.len ¬ oldLen;
FreeStack[old];
stack ¬ new;
};
stack[len] ¬ index;
stack.len ¬ len+1;
RETURN [stack];
};
}.