

<<RCMapBuilderImpl.mesa>>
<<last Modified By Satterthwaite On March 23, 1983 10:18 am>>
<<Last Edited by: Levin, August 8, 1983 4:06 pm>>
<<last Modified By Paul Rovner On September 19, 1983 9:31 pm>>

DIRECTORY
Basics: TYPE USING [bitsPerWord],
Symbols: TYPE USING [
Base, Limit,
SERecord, Type, CSEIndex, ArraySEIndex, RecordSEIndex, ISEIndex,
CSENull, ISENull, CTXRecord, CTXIndex, CTXNull, nullName,
BitAddress, MDIndex],
SymbolTable: TYPE USING [Base],
PrincOps: TYPE USING [wordsPerPage],
PrincOpsUtils: TYPE USING [LongCOPY],
RCMap: TYPE,
RCMapOps: TYPE USING [MapMapItem, MapMapObj, MapMap],
VM: TYPE USING [Allocate, Free, PageNumberForAddress, AddressForPageNumber];

RCMapBuilderImpl: MONITOR  -- protects the current RCMap Base
IMPORTS 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

expansionAllowed: BOOL _ FALSE;

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: BOOL _ FALSE] = {
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};

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

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 ZONE_NIL]
RETURNS[mm: MapMap _ NIL] = {
ENABLE UNWIND => NULL;

count: INTERNAL PROC[Index] RETURNS[stop: BOOL_FALSE] = {
mmEntries _ mmEntries + 1};

include: INTERNAL PROC[index: Index] RETURNS[stop: BOOL_FALSE] = {
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: BOOL _ FALSE] = {
FOR rcmx: Index _ Index.FIRST, rcmx + Size[[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
null => TRUE,
ref => TRUE,
controlLink => TRUE,
oneRef => TRUE,
simple => TRUE,
nonVariant => rcmr.complete,
variant => rcmr.complete,
array => TRUE,
sequence => TRUE,
ENDCASE => ERROR]};


<<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};  -- LOOPHOLE

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]]
ELSE 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;

<<IF stb.seb[asei].packed THEN ERROR NIY["packed RC arrays"L];>>
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;

<<NOTE unlike for unions, there is no way to get back to the enclosing record type>>
IF TRUE THEN ERROR NIY["Stand-alone Sequences"L];
IF ~IsRC[stb, componentSEI] THEN RETURN[nullIndex];
IF ~stb.seb[seqsei].controlled THEN ERROR NIY["computed sequences"L];
<<IF stb.seb[seqsei].packed THEN ERROR NIY["packed RC sequence elements"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;
seqrcmx: SeqIndex;
found: BOOL;
x: Index;

<<IF scser.packed THEN ERROR NIY["packed RC sequence elements"L];>>
seqrcmx _ 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[  -- if looking, will find old eqv ones
stb: SymbolTable.Base, rsei: RecordSEIndex, nvrcmx: NVIndex]
RETURNS[nextIndex: CARDINAL _ 0] = {
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;
IF simplified
THEN {
IF nRefOffsets = 0 THEN rcmr _ Object[null[]]
ELSE IF nRefOffsets = 1 THEN {
IF rrcmr.offset = 0 THEN rcmr _ Object[ref[]]
ELSE rcmr _ rrcmr}
ELSE rcmr _ srcmr}
ELSE rcmr _ NIL};

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: BOOL _ FALSE]
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] =
{  c: SERecord.cons;
sei: Type _ stb.seb[isei].idType;
c _ 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] =
{ 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];
n _ 0;
[] _ EnumerateCtxIseis[stb, uc.caseCtx, count, (tagCardinality = stb.CtxEntries[uc.caseCtx])]};

CountRCCommonComponents: INTERNAL PROC [stb: SymbolTable.Base, rsei: RecordSEIndex] 
RETURNS [n: CARDINAL] =
{ 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
};
n _ 0;
[] _ EnumerateRecordIseis[stb, rsei, count]};

<<copied (GROAN) from RTWalkSymbolsImpl>>
IsRC: INTERNAL PROC [stb: SymbolTable.Base, seIndex: Type, checkCommon: BOOL _ TRUE]
RETURNS[BOOL] =
{ cse: SERecord.cons _ stb.seb[stb.UnderType[seIndex]];
WITH cr: cse SELECT FROM
record =>
BEGIN
rcP: INTERNAL PROC[stb: SymbolTable.Base, isei: ISEIndex] RETURNS[stop: BOOL] =
BEGIN
cse1: SERecord.cons;
sei: Type _ stb.seb[isei].idType;
cse1 _ stb.seb[stb.UnderType[sei]];
WITH cse1: cse1 SELECT FROM
union =>
BEGIN
urcP: INTERNAL PROC[stb: SymbolTable.Base, isei: ISEIndex] RETURNS[stop: BOOL] =
BEGIN
IF IsRC[stb, isei, FALSE] THEN RETURN[TRUE]; -- stop looking. This is it
RETURN[FALSE];  -- keep looking
END;
tagCardinality: CARDINAL _ stb.Cardinality[stb.seb[cse1.tagSei].idType];
RETURN[EnumerateCtxIseis[stb, cse1.caseCtx, urcP,
(tagCardinality = stb.CtxEntries[cse1.caseCtx])]];
END;
sequence => IF IsRC[stb, cse1.componentType] THEN RETURN[TRUE]; -- stop looking. here tis
ENDCASE => IF IsRC[stb, sei] THEN RETURN[TRUE]; -- stop looking. This is it
RETURN[FALSE];  -- keep looking
END;

IF checkCommon THEN RETURN[cr.hints.refField]  -- easy if the common parts are to be included
ELSE IF ~cr.hints.refField
THEN RETURN[FALSE]  -- neither the variants nor the common parts are RC
ELSE RETURN[EnumerateCtxIseis[stb, cr.fieldCtx, rcP]];  -- look individually at the fields
END;
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>>

Size: INTERNAL PROC[h: Handle] RETURNS[CARDINAL] = {
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]};

EqualMaps: INTERNAL PROC [h1, h2: Handle] RETURNS [BOOL] = {
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 => RETURN [FALSE];
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 => RETURN [FALSE];
array =>
RETURN [WITH m2: h2.base[h2.index] SELECT FROM
array =>
(m1.wordsPerElement = m2.wordsPerElement) AND (m1.nElements = m2.nElements)
AND EqualMaps[[h1.base, m1.rcmi], [h2.base, m2.rcmi]],
ENDCASE => FALSE];
sequence =>
RETURN [WITH m2: h2.base[h2.index] SELECT FROM
sequence =>
(m1.wordsPerElement = m2.wordsPerElement) AND (m1.fdLength = m2.fdLength)
AND EqualMaps[[h1.base, m1.commonPart], [h2.base, m2.commonPart]]
AND (m1.dataOffset = m2.dataOffset)
AND EqualMaps[[h1.base, m1.rcmi], [h2.base, m2.rcmi]],
ENDCASE => FALSE];
ENDCASE => ERROR};


FindRCMap: INTERNAL PROC [h: Handle, nWords: CARDINAL _ LOOPHOLE[invalidIndex]]
RETURNS [found: BOOL, index: Index] = {

Test: INTERNAL PROC [x: Index] RETURNS [stop: BOOL _ FALSE] = {
IF EqualMaps[h, [rcmb, x]] THEN {index _ x; stop _ TRUE}};

IF nWords = LOOPHOLE[invalidIndex, CARDINAL] THEN nWords _ rcmbx;
WITH rcm: h.base[h.index] SELECT FROM
null, ref, controlLink => {found _ TRUE; index _ h.index};    -- standard entries
ENDCASE => found _ DoEnumerate[rcmb, nWords, Test];
RETURN};

EnterRCMap: INTERNAL PROC [h: Handle] RETURNS [new: Index] = {
nw: CARDINAL = Size[h];
WITH m: h.base[h.index] SELECT FROM
null, ref, controlLink, oneRef, simple => {
new _ AllocRCMap[nw];    -- NOTE nw should be 1
PrincOpsUtils.LongCOPY[from: @h.base[h.index], to: @rcmb[new], nwords: nw]};
array => {
cRcmi: Index = MapRCMIndex[[h.base, m.rcmi]];
new _ AllocRCMap[nw];
rcmb[new] _ [array[
wordsPerElement: m.wordsPerElement, nElements: m.nElements, rcmi: cRcmi]]};
nonVariant => {
nvRcmi: RCMap.NVIndex _ LOOPHOLE[AllocRCMap[nw]];
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;  new _ nvRcmi};
variant => {
vRcmi: RCMap.VIndex = LOOPHOLE[AllocRCMap[nw]];
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;  new _ vRcmi};
sequence => {
commonRcmi: Index = MapRCMIndex[[h.base, m.commonPart]];
cRcmi: Index = MapRCMIndex[[h.base, m.rcmi]];
new _ AllocRCMap[nw];
rcmb[new] _ [sequence[
wordsPerElement: m.wordsPerElement, fdLength: m.fdLength,
commonPart: commonRcmi, dataOffset: m.dataOffset, rcmi: cRcmi]]};
ENDCASE => ERROR;
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] = {
new: CARDINAL _ rcmbx;
IF new = LOOPHOLE[invalidIndex, CARDINAL] THEN ERROR TooManyRCMaps;
rcmbx _ rcmbx + nw;
IF rcmbx > rcmbLimit THEN ExpandRCMSpace[];
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.Allocate[count: 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;

}.