RCMapBuilderImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Satterthwaite On March 23, 1983 10:18 am
Russ Atkinson (RRA) June 2, 1986 2:52:11 pm PDT
DIRECTORY
Basics USING [BITSHIFT, bitsPerWord],
Symbols USING [Base, Limit, SERecord, Type, CSEIndex, ArraySEIndex, RecordSEIndex, ISEIndex, CSENull, ISENull, CTXRecord, CTXIndex, CTXNull, nullName, BitAddress, MDIndex],
SymbolTable USING [Base],
PrincOps USING [wordsPerPage],
PrincOpsUtils USING [LongCopy],
RCMap USING [AIndex, Base, componentMaxIndex, controlLinkIndex, FieldDescriptor, Index, invalidIndex, nullIndex, NVIndex, Object, OneRefIndex, RCField, RefIndex, refIndex, SeqIndex, SimpIndex, simpleMaxIndex, VIndex],
RCMapOps USING [MapMapItem, MapMapObj, MapMap],
VM USING [AddressForPageNumber, Free, PageNumberForAddress, PagesForWords, SimpleAllocate];
RCMapBuilderImpl: MONITOR -- protects the current RCMap Base
IMPORTS Basics, PrincOpsUtils, VM
EXPORTS RCMapOps = {
OPEN Symbols, RCMap;
bitsPerWord: CARDINAL = Basics.bitsPerWord;
Types
UnionSEIndex: TYPE = Symbols.Base RELATIVE POINTER [0..Symbols.Limit)
TO SERecord.cons.union;
SequenceSEIndex: TYPE = Symbols.Base RELATIVE POINTER [0..Symbols.Limit)
TO SERecord.cons.sequence;
Handle: TYPE = RECORD[base: Base, index: Index];
MapMapItem: TYPE = RCMapOps.MapMapItem;
MapMapObj: TYPE = RCMapOps.MapMapObj;
MapMap: TYPE = RCMapOps.MapMap;
Variables that define the current RCMap Base
rcmb: Base ← NIL;
rcmbPages: INT ← 0;
rcmbLimit: INT ← 0;
rcmbx: INT ← 0; -- number of words in the base
hashTab: LONG POINTER TO HashTab ← NIL;
HashTab: TYPE = ARRAY HashTabIndex OF HashEntry;
HashTabIndex: TYPE = [0..HashMod);
HashMod: NAT = 127; -- prime is better hash
HashEntry: TYPE = ARRAY HashEntryIndex OF RCMap.Index;
HashEntryIndex: TYPE = [0..7];
HashTabPages: NAT = VM.PagesForWords[SIZE[HashTab]];
hashEntryCounts: ARRAY HashEntryIndex OF CARDINALALL[0];
otherHashEntries: CARDINAL ← 0;
totalEntries: CARDINAL ← 0;
expansionAllowed: BOOLFALSE;
outer: PROC [stb: SymbolTable.Base, mdi: MDIndex, inner: PROC [base: SymbolTable.Base]]
NIL;
Errors
TooManyRCMaps: ERROR = CODE;
NIY: ERROR[msg: STRING] = CODE;
PROCs
Initialize: PUBLIC ENTRY PROC [
ptr: Base, nPages: CARDINAL, expansionOK: BOOLFALSE] = {
ENABLE UNWIND => NULL;
expansionAllowed ← expansionOK;
rcmb ← ptr--ASSUME allocated by VM.Allocate--; rcmbx ← 0;
rcmbPages ← nPages;
rcmbLimit ← nPages*PrincOps.wordsPerPage;
IF rcmbLimit < 3 THEN ExpandRCMSpace[];
make standard entries
rcmb[nullIndex] ← [null[]];
rcmb[refIndex] ← [ref[]];
rcmb[controlLinkIndex] ← [controlLink[]];
rcmbx ← 3;
IF hashTab = NIL THEN {
hashTab ← VM.AddressForPageNumber[VM.SimpleAllocate[HashTabPages].page];
hashTab^ ← ALL[ALL[RCMap.nullIndex]];
};
};
EstablishOuter: PUBLIC ENTRY PROC [
outerProc: PROC [
stb: SymbolTable.Base,
mdi: Symbols.MDIndex,
inner: PROC [base: SymbolTable.Base]]] = {
ENABLE UNWIND => NULL;
outer ← outerProc;
};
Finalize: PUBLIC ENTRY PROC = {
ENABLE UNWIND => NULL;
IF rcmb # NIL THEN {
VM.Free[[page: VM.PageNumberForAddress[rcmb], count: rcmbPages]];
rcmb ← NIL;
rcmbPages ← 0;
rcmbLimit ← 0;
rcmbx ← 0;
};
IF hashTab # NIL THEN {
VM.Free[[page: VM.PageNumberForAddress[hashTab], count: HashTabPages]];
hashTab ← NIL;
};
};
GetBase: PUBLIC ENTRY PROC RETURNS [base: Base, nWords: CARDINAL] = {
ENABLE UNWIND => NULL;
RETURN [rcmb, rcmbx];
};
Acquire: PUBLIC ENTRY PROC [stb: SymbolTable.Base, sei: Type] RETURNS [rcmx: Index] = {
ENABLE UNWIND => NULL;
RETURN [DoAcquire[stb, stb.UnderType[sei]]];
};
DoAcquire: INTERNAL PROC
[stb: SymbolTable.Base, csei: CSEIndex] RETURNS [rcmx: Index] = {
RETURN [WITH cse: stb.seb[csei] SELECT FROM
record => MakeRCMapForRecord[stb, LOOPHOLE[csei, RecordSEIndex]],
array => MakeRCMapForArray[stb, LOOPHOLE[csei, ArraySEIndex]],
sequence => MakeRCMapForSequence[stb, LOOPHOLE[csei, SequenceSEIndex]],
union => MakeRCMapForUnion[stb, LOOPHOLE[csei, UnionSEIndex]],
zone => (IF cse.counted THEN refIndex ELSE nullIndex),
long => (IF (WITH rse: stb.seb[stb.UnderType[cse.rangeType] ] SELECT FROM
ref => rse.counted,
ENDCASE => FALSE)
THEN refIndex ELSE nullIndex),
ENDCASE => nullIndex];
};
Include: PUBLIC ENTRY PROC
[rcmb: Base, nWords: CARDINAL, zone: UNCOUNTED ZONENIL]
RETURNS
[mm: MapMap ← NIL] = {
ENABLE UNWIND => NULL;
count: INTERNAL PROC [Index] RETURNS [stop: BOOLFALSE] = {
mmEntries ← mmEntries + 1};
include: INTERNAL PROC [index: Index] RETURNS [stop: BOOLFALSE] = {
mmi: MapMapItem = [old: index, new: MapRCMIndex[[rcmb, index]]];
IF mm # NIL THEN mm[nextMMX] ← mmi;
nextMMX ← nextMMX + 1};
mmEntries: CARDINAL ← 0;
nextMMX: CARDINAL ← 0;
IF zone # NIL THEN {
[] ← DoEnumerate[rcmb, nWords, count];
mm ← zone.NEW[MapMapObj[mmEntries]]};
[] ← DoEnumerate[rcmb, nWords, include];
};
FindMapMapEntry: PUBLIC PROC [mapMap: MapMap, oldIndex: Index] RETURNS [Index] = {
FOR i: CARDINAL IN [0..mapMap.length) DO
IF mapMap[i].old = oldIndex THEN RETURN [mapMap[i].new];
ENDLOOP;
RETURN [invalidIndex];
};
Enumerate: PUBLIC ENTRY PROC [base: RCMap.Base, nWords: CARDINAL, proc: PROC [Index] RETURNS [stop: BOOL]] RETURNS [stopped: BOOL] = {
ENABLE UNWIND => NULL;
RETURN [DoEnumerate[base, nWords, proc]];
};
DoEnumerate: INTERNAL PROC [base: RCMap.Base, nWords: CARDINAL, proc: PROC [Index] RETURNS [stop: BOOL]] RETURNS [stopped: BOOLFALSE] = {
FOR rcmx: Index ← Index.FIRST, rcmx + InlineSize[[base, rcmx]]
UNTIL
LOOPHOLE[rcmx, CARDINAL] >= nWords DO
IF Complete[[base, rcmx]] AND proc[rcmx] THEN RETURN [TRUE];
ENDLOOP;
};
FOR DEBUGGING
NextRCMap: SIGNAL = CODE;
ListRCMaps: ENTRY PROC = {
ENABLE UNWIND => NULL;
p: PROC [index: Index] RETURNS [stop: BOOL] = {SIGNAL NextRCMap; RETURN [FALSE]};
[] ← DoEnumerate[rcmb, rcmbx, p];
};
Complete: INTERNAL PROC [h: Handle] RETURNS [BOOL] = INLINE {
RETURN [WITH rcmr: h.base[h.index] SELECT FROM
nonVariant => rcmr.complete,
variant => rcmr.complete,
ENDCASE => TRUE];
};
InnerHash: PROC [h: Handle] RETURNS [hash: CARDINAL ← 0] = {
DO
ptr: LONG POINTER TO RCMap.Object = @h.base[h.index];
hash ← Basics.BITSHIFT[hash, 7] + Basics.BITSHIFT[hash, 7-16] + hash + LOOPHOLE[ptr.type, CARDINAL]*64;
WITH rcmr: ptr^ SELECT FROM
oneRef =>
hash ← hash + rcmr.offset;
simple =>
hash ← hash + LOOPHOLE[rcmr.refs, CARDINAL];
nonVariant => {
hash ← hash + rcmr.nComponents;
FOR i: NAT IN [0..rcmr.nComponents) DO
field: RCMap.RCField = rcmr.components[0];
hash ← Basics.BITSHIFT[hash, 9] + Basics.BITSHIFT[hash, 9-16] + hash + i + field.wordOffset + Hash[[h.base, field.rcmi]];
ENDLOOP;
};
variant => {
hash ← hash + rcmr.nVariants + rcmr.fdTag.bitCount + rcmr.fdTag.wordOffset;
FOR i: NAT IN [0..rcmr.nVariants) DO
hash ← Basics.BITSHIFT[hash, 9] + Basics.BITSHIFT[hash, 9-16] + hash + i + Hash[[h.base, rcmr.variants[0]]];
ENDLOOP;
};
array => {
hash ← hash + rcmr.wordsPerElement + rcmr.nElements;
h.index ← rcmr.rcmi;
LOOP;
};
sequence => {
hash ← hash + rcmr.wordsPerElement + rcmr.dataOffset;
hash ← Basics.BITSHIFT[hash, 11] + Basics.BITSHIFT[hash, 11-16] + hash + Hash[[h.base, rcmr.commonPart]];
h.index ← rcmr.rcmi;
LOOP;
}
ENDCASE;
EXIT;
ENDLOOP;
};
Hash: PROC [h: Handle] RETURNS [[0..HashMod)] = INLINE {
hash: CARDINAL ← InnerHash[h];
RETURN [hash MOD HashMod];
};
first level utility PROCs for constructing RCMap Objects
NewARCM: INTERNAL PROC RETURNS [ans: AIndex] = {
ans ← LOOPHOLE[AllocRCMap[Object.array.SIZE]];
rcmb[ans] ← [array[]];
};
NewNVRCM: INTERNAL PROC [nComponents: [0..componentMaxIndex]]
RETURNS
[ans: NVIndex] = {
ans ← LOOPHOLE[AllocRCMap[Object.nonVariant.SIZE + nComponents*RCField.SIZE]];
rcmb[ans] ← [nonVariant[nComponents: nComponents, components: TRASH]];
FOR i: CARDINAL IN [0..nComponents) DO rcmb[ans].components[i] ← []; ENDLOOP;
};
NewVRCM: INTERNAL PROC [nVariants: [0..componentMaxIndex], fdTag: FieldDescriptor]
RETURNS
[ans: VIndex] = {
ans ← LOOPHOLE[AllocRCMap[Object.variant.SIZE + nVariants*Index.SIZE]];
rcmb[ans] ← [variant[fdTag: fdTag, nVariants: nVariants, variants: TRASH]];
FOR i: CARDINAL IN [0..nVariants) DO rcmb[ans].variants[i] ← nullIndex; ENDLOOP;
};
NewSeqRCM: INTERNAL PROC RETURNS [ans: SeqIndex] = {
ans ← LOOPHOLE[AllocRCMap[Object.sequence.SIZE]];
rcmb[ans] ← [sequence[]];
};
PopRCMX: INTERNAL PROC [x: CARDINAL] = {rcmbx ← x};
InstallSimplifiedRCM: INTERNAL PROC [srcm: UNSPECIFIED] RETURNS [ans: Index] = {
proc: INTERNAL PROC [index: Index] RETURNS [stop: BOOL] = {
stop ← (rcmb[index].type = simple AND srcm = rcmb[LOOPHOLE[index, SimpIndex]])
OR
(rcmb[index].type = oneRef AND srcm = rcmb[LOOPHOLE[index, OneRefIndex]]);
IF stop THEN ans ← index;
};
IF LOOPHOLE[srcm, Object.null].type = null THEN RETURN [nullIndex];
IF LOOPHOLE[srcm, Object.ref].type = ref THEN RETURN [refIndex];
IF DoEnumerate[rcmb, rcmbx, proc].stopped THEN RETURN [ans];
ans ← AllocRCMap[Object.simple.SIZE];
rcmb[LOOPHOLE[ans, RefIndex]] ← srcm;
};
MakeRCMapForRecord: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex]
RETURNS
[Index] = {
IF ~stb.seb[rsei].hints.refField THEN RETURN [nullIndex];
IF stb.seb[rsei].hints.variant THEN RETURN [MakeRCMapForVRecord[stb, rsei]];
RETURN [MakeRCMapForNVRecord[stb, rsei]];
};
MakeRCMapForArray: INTERNAL PROC [stb: SymbolTable.Base, asei: ArraySEIndex]
RETURNS
[Index] = {
compSEI: CSEIndex = stb.UnderType[stb.seb[asei].componentType];
IF IsRC[stb, compSEI]
THEN {
oldrcmbx: CARDINAL = rcmbx;
ercmx: Index ← DoAcquire[stb, compSEI];
arcmx: AIndex ← NewARCM[];
simpRCM: UNSPECIFIED;
simplified: BOOL;
rcmb[arcmx] ← [array[wordsPerElement: stb.WordsForType[compSEI],
nElements: stb.Cardinality[stb.seb[asei].indexType],
rcmi: ercmx]];
[simpRCM, simplified] ← SimplifyRCM[arcmx];
IF simplified
THEN {PopRCMX[oldrcmbx]; RETURN [InstallSimplifiedRCM[simpRCM]]}
ELSE {
x: Index;
found: BOOL;
[found, x] ← FindRCMap[[rcmb, arcmx], oldrcmbx];
IF found THEN {PopRCMX[oldrcmbx]; RETURN [x]} ELSE RETURN [arcmx]};
}
ELSE RETURN [nullIndex];
};
MakeRCMapForSequence: INTERNAL PROC [stb: SymbolTable.Base, seqsei: SequenceSEIndex] RETURNS [ans: Index] = {
tagSEI: ISEIndex = stb.seb[seqsei].tagSei;
componentSEI: Type = stb.seb[seqsei].componentType;
ercmi: Index;
seqrcmx: SeqIndex;
found: BOOL;
oldrcmbx: CARDINAL = rcmbx;
IF TRUE THEN ERROR NIY["Stand-alone Sequences"L];
unlike for unions, there is no way to get back to the enclosing record type
IF ~IsRC[stb, componentSEI] THEN RETURN [nullIndex];
IF ~stb.seb[seqsei].controlled THEN ERROR NIY["computed sequences"L];
ercmi ← DoAcquire[stb, stb.UnderType[componentSEI]];
seqrcmx ← NewSeqRCM[];
rcmb[seqrcmx].wordsPerElement ← stb.WordsForType[componentSEI];
rcmb[seqrcmx].fdLength ← [
wordOffset: 0,
bitFirst: stb.seb[tagSEI].idValue MOD bitsPerWord,
bitCount: stb.seb[tagSEI].idInfo];
rcmb[seqrcmx].commonPart ← nullIndex;
rcmb[seqrcmx].dataOffset ← (stb.seb[tagSEI].idValue + stb.seb[tagSEI].idInfo) / bitsPerWord;
rcmb[seqrcmx].rcmi ← ercmi;
[found, ans] ← FindRCMap[[rcmb, seqrcmx], oldrcmbx];
IF found THEN {PopRCMX[oldrcmbx]; RETURN [ans]} ELSE RETURN [seqrcmx];
};
MakeRCMapForUnion: INTERNAL PROC [stb: SymbolTable.Base, usei: UnionSEIndex] RETURNS [rcmx: Index ← invalidIndex] = {
GetRCMX: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
get the rcmx for the enclosing record
rcsei: CSEIndex ← stb.UnderType[stb.TypeLink[isei]];
IF rcsei = CSENull THEN ERROR;
NOTE offset, inclusion of common parts
rcmx ← MakeRCMapForRecord[stb, LOOPHOLE[rcsei, RecordSEIndex]];
RETURN [TRUE]}; -- stop the enumeration
nVariants: CARDINAL = stb.Cardinality[stb.seb[stb.seb[usei].tagSei].idType];
nFields: CARDINAL ← 0;
IF ~stb.seb[usei].hints.refField THEN RETURN [nullIndex];
FOR isei: ISEIndex ← stb.FirstCtxSe[stb.seb[usei].caseCtx], stb.NextSe[isei]
UNTIL isei = ISENull DO nFields ← nFields + 1 ENDLOOP;
[] ← EnumerateCtxIseis[stb, stb.seb[usei].caseCtx, GetRCMX, (nVariants = nFields)];
IF rcmx = invalidIndex THEN ERROR;
};
MakeRCMapForNVRecord: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex] RETURNS [Index] = {
n: CARDINAL = CountRCCommonComponents[stb, rsei];
oldrcmbx: CARDINAL = rcmbx;
nvrcmx: NVIndex;
simpRCM: UNSPECIFIED;
simplified: BOOL;
IF n = 0 THEN RETURN [nullIndex];
nvrcmx ← NewNVRCM[n];
IF StuffRCCommonComponents[stb, rsei, nvrcmx] # n THEN ERROR;
[simpRCM, simplified] ← SimplifyRCM[nvrcmx];
IF simplified
THEN {PopRCMX[oldrcmbx]; RETURN [InstallSimplifiedRCM[simpRCM]]}
ELSE {
x: Index;
found: BOOL;
rcmb[nvrcmx].complete ← TRUE;
[found, x] ← FindRCMap[[rcmb, nvrcmx], oldrcmbx];
IF found THEN {PopRCMX[oldrcmbx]; RETURN [x]} ELSE RETURN [nvrcmx]};
};
MakeRCMapForVRecord: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex] RETURNS [ans: Index] = {
maybe a sequence-containing record
ncc: CARDINAL = CountRCCommonComponents[stb, rsei];
oldrcmbx: CARDINAL = rcmbx;
nvrcmx: Index ← MakeRCMapForNVRecord[stb, rsei];
up: INTERNAL PROC [ucstb: SymbolTable.Base, ucser: SERecord.cons.union] = {
called once
nvc: CARDINAL = CountRCVariants[ucstb, ucser];
x: Index;
found: BOOL;
IF nvc + ncc = 0 THEN ERROR;
IF nvc = 0 THEN ans ← nvrcmx
ELSE {
tagSEI: ISEIndex = ucser.tagSei;
nVariants: CARDINAL = ucstb.Cardinality[ucstb.seb[tagSEI].idType];
vrcmx: VIndex ← NewVRCM[
nVariants: nVariants,
fdTag: [wordOffset: ucstb.seb[tagSEI].idValue / bitsPerWord,
bitFirst: ucstb.seb[tagSEI].idValue MOD bitsPerWord,
bitCount: ucstb.seb[tagSEI].idInfo]];
FOR i: CARDINAL IN [0..nVariants) DO
rcmb[vrcmx].variants[i] ← nvrcmx; ENDLOOP; -- NOTE LOOPHOLE
IF StuffRCVariantComponents[ucstb, ucser, vrcmx, nVariants] # nvc THEN ERROR;
rcmb[vrcmx].complete ← TRUE;
[found, x] ← FindRCMap[[rcmb, vrcmx], oldrcmbx];
IF found THEN {PopRCMX[oldrcmbx]; ans ← x} ELSE ans ← vrcmx}};
sp: INTERNAL PROC [scstb: SymbolTable.Base, scser: SERecord.cons.sequence] = {
called once
IF ~scser.controlled THEN ERROR NIY["computed sequences"L];
IF ncc = 0 AND ~IsRC[scstb, scser.componentType] THEN ERROR;
IF ~IsRC[scstb, scser.componentType]
THEN ans ← nvrcmx
ELSE {
ercmi: Index = DoAcquire[scstb, scstb.UnderType[scser.componentType]];
tagSEI: ISEIndex = scser.tagSei;
found: BOOL;
x: Index;
seqrcmx: SeqIndex ← NewSeqRCM[];
rcmb[seqrcmx].wordsPerElement ← scstb.WordsForType[scser.componentType];
rcmb[seqrcmx].fdLength ←
[wordOffset: scstb.seb[tagSEI].idValue / bitsPerWord,
bitFirst: scstb.seb[tagSEI].idValue MOD bitsPerWord,
bitCount: scstb.seb[tagSEI].idInfo];
rcmb[seqrcmx].commonPart ← nvrcmx;
rcmb[seqrcmx].dataOffset ←
(scstb.seb[tagSEI].idValue + scstb.seb[tagSEI].idInfo) / bitsPerWord;
rcmb[seqrcmx].rcmi ← ercmi;
[found, x] ← FindRCMap[[rcmb, seqrcmx], oldrcmbx];
IF found THEN {PopRCMX[oldrcmbx]; ans ← x} ELSE ans ← seqrcmx};
};
IF ~FindVariantField[stb, stb.seb[rsei].fieldCtx, up, sp] THEN ERROR;
};
second level utility PROCs for constructing RCMap Objects
StuffRCCommonComponents: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex, nvrcmx: NVIndex] RETURNS [nextIndex: CARDINAL ← 0] = {
if looking, will find old eqv ones
argrec: BOOL = stb.seb[rsei].argument;
append: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
sei: Type ← stb.seb[isei].idType;
foffset: INTERNAL PROC [isei: ISEIndex] RETURNS [BitAddress] = INLINE
{RETURN [IF argrec THEN stb.FnField[isei].offset ELSE stb.seb[isei].idValue]};
IF (~(IsUnion[stb, sei] OR IsSequence[stb, sei]))
AND (~stb.seb[isei].constant) AND IsRC[stb, sei] THEN {
rcmb[nvrcmx].components[nextIndex] ← [wordOffset: foffset[isei].wd,
rcmi: DoAcquire[stb, stb.UnderType[sei]]];
nextIndex ← nextIndex + 1};
RETURN [FALSE]}; -- keep counting
[] ← EnumerateRecordIseis[stb, rsei, append];
};
StuffRCVariantComponents: INTERNAL PROC [stb: SymbolTable.Base, uc: SERecord.cons.union, vrcmx: VIndex, nVariants: CARDINAL]
RETURNS
[n: CARDINAL] = {
srcvc: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
IF IsRC[stb, isei, FALSE] THEN {
rcmb[vrcmx].variants[stb.seb[isei].idValue] ← DoAcquire[stb, stb.UnderType[isei]];
n ← n + 1};
RETURN [FALSE]}; -- keep counting
nFields: CARDINAL ← 0;
FOR isei: ISEIndex ← stb.FirstCtxSe[uc.caseCtx], stb.NextSe[isei] UNTIL isei = ISENull DO
nFields ← nFields + 1; ENDLOOP;
n ← 0;
[] ← EnumerateCtxIseis[stb, uc.caseCtx, srcvc, (nVariants = nFields)];
};
SimplifyRCM: INTERNAL PROC [rcmx: Index] RETURNS [rcmr: UNSPECIFIED, simplified: BOOL] = {
srcmr: Object.simple ← [simple[]];
rrcmr: Object.oneRef ← [oneRef[]];
nRefOffsets: CARDINAL ← 0;
nSimpleVecEntries: CARDINAL ← 0;
p: INTERNAL PROC [refOffset: CARDINAL] RETURNS [stop: BOOL] = {
nRefOffsets ← nRefOffsets+1;
IF ((nRefOffsets # 1) OR (refOffset > componentMaxIndex))
AND (refOffset > simpleMaxIndex) THEN RETURN [TRUE]; -- can't simplify. Fail.
IF nRefOffsets = 1 AND refOffset <= componentMaxIndex THEN
rrcmr.offset ← refOffset;
IF refOffset <= simpleMaxIndex THEN {
nSimpleVecEntries ← nSimpleVecEntries + 1;
IF nSimpleVecEntries # nRefOffsets THEN RETURN [TRUE]; -- can't simplify. Fail.
srcmr.refs[refOffset] ← TRUE;
srcmr.length ← MAX[srcmr.length, refOffset + 1]};
RETURN [FALSE]}; -- keep going
simplified ← ~EnumerateForSimplify[rcmx, p].stopped;
SELECT TRUE FROM
NOT simplified => rcmr ← NIL;
nRefOffsets = 0 => rcmr ← Object[null[]];
nRefOffsets = 1 => IF rrcmr.offset = 0 THEN rcmr ← Object[ref[]] ELSE rcmr ← rrcmr;
ENDCASE => rcmr ← srcmr;
};
EnumerateForSimplify: INTERNAL PROC [
rcmx: Index,
p: PROC [refOffset: CARDINAL] RETURNS [stop: BOOL],
offset: CARDINAL ← 0]
RETURNS
[stopped: BOOL] = {
MapArrayRCM: INTERNAL PROC [refOffset: CARDINAL, arcmx: AIndex]
RETURNS
[stop: BOOL] = {
FOR i: CARDINAL IN [0..rcmb[arcmx].nElements) DO
IF EnumerateForSimplify[
rcmb[arcmx].rcmi, p, refOffset+i*rcmb[arcmx].wordsPerElement].stopped THEN
RETURN [stop: TRUE];
ENDLOOP;
RETURN [stop: FALSE]};
MapRecordRCM: INTERNAL PROC [refOffset: CARDINAL, nvrcmx: NVIndex]
RETURNS
[stop: BOOL] = {
FOR i: CARDINAL IN [0..rcmb[nvrcmx].nComponents) DO
IF EnumerateForSimplify[
rcmb[nvrcmx].components[i].rcmi,
p,
refOffset+rcmb[nvrcmx].components[i].wordOffset].stopped THEN
RETURN [stop: TRUE];
ENDLOOP;
RETURN [stop: FALSE]};
EnumerateForSimplify begins here
WITH rcmr: rcmb[rcmx] SELECT FROM
nonVariant => stopped ← MapRecordRCM[offset, LOOPHOLE[rcmx]];
array => stopped ← MapArrayRCM[offset, LOOPHOLE[rcmx]];
null => stopped ← FALSE;
ref => stopped ← p[offset];
controlLink => stopped ← p[offset];
oneRef => stopped ← p[offset+rcmr.offset];
simple => {
FOR i: CARDINAL IN [0..rcmr.length) DO
IF rcmr.refs[i] THEN IF p[offset+i].stop THEN RETURN [TRUE];
ENDLOOP;
stopped ← FALSE};
variant, sequence => stopped ← TRUE;
ENDCASE => ERROR;
};
PROCS for poking around in the symbol table
copied (GROAN) from RTWalkSymbolsImpl
IsUnion: INTERNAL PROC [stb: SymbolTable.Base, seIndex: Type] RETURNS [BOOL] = {
RETURN [stb.seb[stb.UnderType[seIndex]].typeTag = union];
};
copied (GROAN) from RTWalkSymbolsImpl
IsSequence: INTERNAL PROC [stb: SymbolTable.Base, seIndex: Type] RETURNS [BOOL] = {
RETURN [stb.seb[stb.UnderType[seIndex]].typeTag = sequence]};
copied (GROAN) from RTWalkSymbolsImpl
EnumerateRecordIseis: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex, p: PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL], level: CARDINAL ← 0] RETURNS [stopped: BOOL] = {
proc: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
sei: Type ← stb.seb[isei].idType;
IF ~(IsUnion[stb, sei] OR IsSequence[stb, sei]) OR level = 0 THEN RETURN [p[stb, isei]];
RETURN [FALSE]};
IF rsei = CSENull THEN RETURN [FALSE];
WITH lrc: stb.seb[rsei] SELECT FROM
linked => {
stopped ← EnumerateRecordIseis[
stb, LOOPHOLE[stb.UnderType[lrc.linkType]], p, level + 1];
IF stopped THEN RETURN [TRUE]};
ENDCASE;
RETURN [EnumerateCtxIseis[stb, stb.seb[rsei].fieldCtx, proc]];
};
copied (GROAN) from RTWalkSymbolsImpl
EnumerateCtxIseis: INTERNAL PROC [stb: SymbolTable.Base, ctx: CTXIndex, proc: PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL], reallyComplete: BOOLFALSE] RETURNS [stopped: BOOL] = {
isei: ISEIndex;
IF ctx = CTXNull THEN RETURN [FALSE];
IF ~reallyComplete
THEN WITH c: stb.ctxb[ctx] SELECT FROM
included =>
IF ~c.complete THEN
{ p: INTERNAL PROC [base: SymbolTable.Base] = -- called once
{ stopped ← EnumerateCtxIseis[base, c.map, proc]};
IF outer = NIL THEN ERROR ELSE outer[stb, c.module, p];
RETURN [stopped];
};
simple => NULL;
ENDCASE => ERROR;
FOR isei ← stb.FirstCtxSe[ctx], stb.NextSe[isei] UNTIL isei = ISENull DO
IF stb.seb[isei].hash = nullName AND stb.seb[isei].idCtx = CTXNull THEN LOOP; -- padding
IF proc[stb, isei] THEN RETURN [TRUE]; ENDLOOP;
RETURN [FALSE];
};
FindVariantField: INTERNAL PROC [stb: SymbolTable.Base, ctx: CTXIndex,
unionProc: PROC [ucstb: SymbolTable.Base, ucser: SERecord.cons.union],
sequenceProc: PROC [scstb: SymbolTable.Base, scser: SERecord.cons.sequence]]
RETURNS [BOOL] = {
p: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
sei: Type ← stb.seb[isei].idType;
c: SERecord.cons ← stb.seb[stb.UnderType[sei]];
WITH c: c SELECT FROM
union => unionProc[stb, c];
sequence => sequenceProc[stb, c];
ENDCASE => RETURN [FALSE];
RETURN [TRUE];
};
RETURN [EnumerateCtxIseis[stb, ctx, p]];
};
CountRCVariants: INTERNAL PROC [stb: SymbolTable.Base, uc: SERecord.cons.union] RETURNS [n: CARDINAL ← 0] = {
count: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
IF IsRC[stb, isei, FALSE] THEN n ← n+1;
RETURN [FALSE]; -- keep counting
};
tagCardinality: CARDINAL ← stb.Cardinality[stb.seb[uc.tagSei].idType];
[] ← EnumerateCtxIseis[stb, uc.caseCtx, count, (tagCardinality = stb.CtxEntries[uc.caseCtx])];
};
CountRCCommonComponents: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex] RETURNS [n: CARDINAL ← 0] = {
count: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
sei: Type ← stb.seb[isei].idType;
IF (~(IsUnion[stb, sei] OR IsSequence[stb, sei]))
AND (~stb.seb[isei].constant)
AND IsRC[stb, sei] THEN n ← n+1; -- don't count the variant part
RETURN [FALSE]; -- keep counting
};
[] ← EnumerateRecordIseis[stb, rsei, count];
};
copied (GROAN) from RTWalkSymbolsImpl
IsRC: INTERNAL PROC [stb: SymbolTable.Base, seIndex: Type, checkCommon: BOOLTRUE] RETURNS [BOOL] = {
cse: SERecord.cons ← stb.seb[stb.UnderType[seIndex]];
WITH cr: cse SELECT FROM
record => {
rcP: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex] RETURNS [stop: BOOL] = {
cse1: SERecord.cons;
sei: Type ← stb.seb[isei].idType;
cse1 ← stb.seb[stb.UnderType[sei]];
WITH cse1: cse1 SELECT FROM
union => {
urcP: INTERNAL PROC [stb: SymbolTable.Base, isei: ISEIndex]
RETURNS [stop: BOOL] = {
RETURN [IsRC[stb, isei, FALSE]];
};
tagCardinality: CARDINAL ← stb.Cardinality[stb.seb[cse1.tagSei].idType];
RETURN [EnumerateCtxIseis[stb, cse1.caseCtx, urcP,
(tagCardinality = stb.CtxEntries[cse1.caseCtx])]];
};
sequence => IF IsRC[stb, cse1.componentType] THEN RETURN [TRUE];
ENDCASE => IF IsRC[stb, sei] THEN RETURN [TRUE];
RETURN [FALSE]; -- keep looking
};
SELECT TRUE FROM
checkCommon => RETURN [cr.hints.refField];
easy if the common parts are to be included
cr.hints.refField => RETURN [EnumerateCtxIseis[stb, cr.fieldCtx, rcP]];
look individually at the fields
ENDCASE => RETURN [FALSE];
neither the variants nor the common parts are RC
};
sequence, union => ERROR;
transfer => RETURN [FALSE]; -- NOTE for now
relative => RETURN [FALSE]; -- NOTE for now
long => RETURN [WITH rse: stb.seb[stb.UnderType[cr.rangeType] ] SELECT FROM
ref => rse.counted,
ENDCASE => FALSE];
zone => RETURN [cr.counted];
array => RETURN [IsRC[stb, cr.componentType]];
ENDCASE => RETURN [FALSE];
};
PROCs for managing RCMap Bases
InlineSize: INTERNAL PROC [h: Handle] RETURNS [CARDINAL] = INLINE {
RETURN [WITH rcmh: h.base[h.index] SELECT FROM
null => Object.null.SIZE, --NOTE better be 1
ref => Object.ref.SIZE, --NOTE better be 1
controlLink => Object.controlLink.SIZE, --NOTE better be 1
oneRef => Object.oneRef.SIZE, --NOTE better be 1
simple => Object.simple.SIZE, --NOTE better be 1
nonVariant => Object.nonVariant.SIZE + rcmh.nComponents*RCField.SIZE,
variant => Object.variant.SIZE + rcmh.nVariants*Index.SIZE,
array => Object.array.SIZE,
sequence => Object.sequence.SIZE,
ENDCASE => ERROR]};
FastEqualMaps: INTERNAL PROC [h1, h2: Handle] RETURNS [BOOL] = INLINE {
DO
WITH m1: h1.base[h1.index] SELECT FROM
null, ref, controlLink => RETURN [h1.index = h2.index]; -- StandardRCMap's
oneRef => RETURN [m1 = h2.base[h2.index]];
simple => RETURN [m1 = h2.base[h2.index]];
nonVariant =>
WITH m2: h2.base[h2.index] SELECT FROM
nonVariant => {
matched: BOOL
(m1.complete AND m2.complete) AND (m1.nComponents = m2.nComponents);
FOR i: NAT IN [0 .. m1.nComponents) WHILE matched DO
matched ← (m1.components[i].wordOffset = m2.components[i].wordOffset)
AND EqualMaps[[h1.base, m1.components[i].rcmi],
[h2.base, m2.components[i].rcmi]];
ENDLOOP;
RETURN [matched]};
ENDCASE;
variant =>
WITH m2: h2.base[h2.index] SELECT FROM
variant => {
matched: BOOL ← (m1.complete AND m2.complete)
AND (m1.nVariants = m2.nVariants) AND (m1.fdTag = m2.fdTag);
FOR i: NAT IN [0 .. m1.nVariants) WHILE matched DO
matched ← EqualMaps[[h1.base, m1.variants[i]], [h2.base, m2.variants[i]]];
ENDLOOP;
RETURN [matched]};
ENDCASE;
array => {
WITH m2: h2.base[h2.index] SELECT FROM
array => {
SELECT TRUE FROM
m1.wordsPerElement # m2.wordsPerElement => {};
m1.nElements # m2.nElements => {};
ENDCASE => {
Tail-recursive check for element maps
h1 ← [h1.base, m1.rcmi];
h2 ← [h2.base, m2.rcmi];
LOOP;
};
};
ENDCASE;
};
sequence => {
WITH m2: h2.base[h2.index] SELECT FROM
sequence =>
SELECT TRUE FROM
m1.wordsPerElement # m2.wordsPerElement => {};
m1.fdLength # m2.fdLength => {};
m1.dataOffset # m2.dataOffset => {};
EqualMaps[[h1.base, m1.commonPart], [h2.base, m2.commonPart]] => {
Tail-recursive check for element maps
h1 ← [h1.base, m1.rcmi];
h2 ← [h2.base, m2.rcmi];
LOOP;
};
ENDCASE;
ENDCASE;
};
ENDCASE => ERROR;
RETURN [FALSE];
ENDLOOP;
};
EqualMaps: INTERNAL PROC [h1, h2: Handle] RETURNS [BOOL] = {
RETURN [FastEqualMaps[h1, h2]];
};
FindRCMap: INTERNAL PROC
[h: Handle, nWords: CARDINALLOOPHOLE[invalidIndex]]
RETURNS
[found: BOOL, rcmx: Index] = {
IF nWords = LOOPHOLE[invalidIndex, CARDINAL] THEN nWords ← rcmbx;
WITH rcm: h.base[h.index] SELECT FROM
null, ref, controlLink =>
standard entries
RETURN [TRUE, h.index];
ENDCASE => {
Frequent case of DoEnumerate is placed INLINE and specialized!
rcmx ← controlLinkIndex;
IF hashTab # NIL THEN {
A hash table exists, so we can try for a faster lookup
hash: [0..HashMod) ← Hash[h];
entry: HashEntry ← hashTab[hash];
FOR x: HashEntryIndex IN HashEntryIndex DO
rcmx ← entry[x];
IF rcmx = RCMap.nullIndex THEN RETURN [FALSE, invalidIndex];
IF FastEqualMaps[h, [rcmb, rcmx]] THEN
IF Complete[[rcmb, rcmx]] THEN RETURN [TRUE, rcmx];
ENDLOOP;
};
At this point rcmx has the last index that was examined, either via the hash table or implicitly (= controlLinkIndex). The loop is started up by skipping that last successful entry, then testing for completion.
DO
rcmx ← rcmx + InlineSize[[rcmb, rcmx]];
IF LOOPHOLE[rcmx, CARDINAL] >= nWords THEN RETURN [FALSE, invalidIndex];
IF FastEqualMaps[h, [rcmb, rcmx]] THEN
IF Complete[[rcmb, rcmx]] THEN RETURN [TRUE, rcmx];
ENDLOOP;
};
};
EnterRCMap: INTERNAL PROC [h: Handle] RETURNS [new: Index] = {
nw: CARDINAL = InlineSize[h];
new ← AllocRCMap[nw];
WITH m: h.base[h.index] SELECT FROM
null, ref, controlLink, oneRef, simple => {
PrincOpsUtils.LongCopy[from: @h.base[h.index], to: @rcmb[new], nwords: nw];
};
array => {
cRcmi: Index = MapRCMIndex[[h.base, m.rcmi]];
rcmb[new] ← [array[
wordsPerElement: m.wordsPerElement, nElements: m.nElements, rcmi: cRcmi]];
};
nonVariant => {
nvRcmi: RCMap.NVIndex ← LOOPHOLE[new];
rcmb[nvRcmi] ← [nonVariant[
nComponents: m.nComponents, components: TRASH, complete: FALSE]];
FOR i: NAT IN [0..m.nComponents) DO
rcmb[nvRcmi].components[i] ← [
m.components[i].wordOffset, MapRCMIndex[[h.base, m.components[i].rcmi]]];
ENDLOOP;
rcmb[nvRcmi].complete ← TRUE;
};
variant => {
vRcmi: RCMap.VIndex = LOOPHOLE[new];
rcmb[vRcmi] ← [variant[
nVariants: m.nVariants, fdTag: m.fdTag, variants: TRASH, complete: FALSE]];
FOR i: NAT IN [0..m.nVariants) DO
rcmb[vRcmi].variants[i] ← MapRCMIndex[[h.base, m.variants[i]]];
ENDLOOP;
rcmb[vRcmi].complete ← TRUE;
};
sequence => {
commonRcmi: Index = MapRCMIndex[[h.base, m.commonPart]];
cRcmi: Index = MapRCMIndex[[h.base, m.rcmi]];
rcmb[new] ← [sequence[
wordsPerElement: m.wordsPerElement, fdLength: m.fdLength,
commonPart: commonRcmi, dataOffset: m.dataOffset, rcmi: cRcmi]];
};
ENDCASE => ERROR;
IF hashTab # NIL THEN {
hash: [0..HashMod) ← Hash[h];
entry: HashEntry ← hashTab[hash];
totalEntries ← totalEntries + 1;
FOR x: HashEntryIndex IN HashEntryIndex DO
IF entry[x] = RCMap.nullIndex THEN {
hashTab[hash][x] ← new;
hashEntryCounts[x] ← hashEntryCounts[x] + 1;
RETURN;
};
ENDLOOP;
otherHashEntries ← otherHashEntries + 1;
};
RETURN;
};
MapRCMIndex: INTERNAL PROC [old: Handle] RETURNS [new: Index] = {
found: BOOL;
[found, new] ← FindRCMap[old];
IF ~found THEN new ← EnterRCMap[old];
RETURN;
};
AllocRCMap: INTERNAL PROC [nw: CARDINAL] RETURNS [Index] = {
short: CARDINAL ← rcmbx;
new: Index ← LOOPHOLE[short];
IF new = invalidIndex THEN ERROR TooManyRCMaps;
rcmbx ← rcmbx + nw;
IF rcmbx > rcmbLimit THEN ExpandRCMSpace[];
rcmb[new] ← [null[]];
IF nw > 1 THEN
Ensure valid initialization for this map entry to avoid finding crap!
PrincOpsUtils.LongCopy[from: @rcmb[new], to: @rcmb[new+1], nwords: nw-1];
RETURN [LOOPHOLE[new]];
};
ExpandRCMSpace: INTERNAL PROC = {
newLimit: CARDINAL = rcmbLimit + 4*PrincOps.wordsPerPage;
newRCMB: RCMap.Base;
IF NOT expansionAllowed THEN ERROR TooManyRCMaps;
newRCMB ← LOOPHOLE[VM.AddressForPageNumber[VM.SimpleAllocate[rcmbPages + 4].page],     RCMap.Base];
IF rcmb # NIL THEN {
PrincOpsUtils.LongCopy[from: rcmb, to: newRCMB, nwords: rcmbLimit];
VM.Free[[page: VM.PageNumberForAddress[rcmb], count: rcmbPages]]};
rcmb ← newRCMB;
rcmbPages ← rcmbPages + 4;
rcmbLimit ← newLimit};
START HERE
IF Object.null.SIZE # 1
OR Object.ref.SIZE # 1
OR Object.oneRef.SIZE # 1
OR Object.simple.SIZE # 1
OR Object.controlLink.SIZE # 1 THEN ERROR;
}.