-- RCMapBuilderImpl.mesa
-- Last Modified By Satterthwaite On June 29, 1982 11:30 am
-- Last Modified By Paul Rovner On January 12, 1983 11:34 am

DIRECTORY
Inline USING[LongCOPY],
Table USING[Base, Limit],
Symbols USING[SERecord, CSEIndex, ArraySEIndex, RecordSEIndex, SEIndex, ISEIndex,
ISENull, CTXRecord, CTXIndex, SENull, CTXNull, HTNull, BitAddress,
MDIndex],
SymbolTable USING[Base],
Environment USING[bitsPerWord, wordsPerPage],
RCMap,
NewRCMapOps USING[MapMapItem, MapMapObj, MapMap]; -- EXPORTS only

RCMapBuilderImpl: MONITOR -- protects the current RCMap Base
IMPORTS Inline
EXPORTS NewRCMapOps

= BEGIN OPEN Environment, Symbols, RCMap;


-- Types --
UnionSEIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO union cons SERecord;
SequenceSEIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit)
TO sequence cons SERecord;

Handle: TYPE = RECORD[base: Base, index: Index];

MapMapItem: TYPE = NewRCMapOps.MapMapItem;
MapMapObj: TYPE = NewRCMapOps.MapMapObj;
MapMap: TYPE = NewRCMapOps.MapMap;

-- Variables that define the current RCMap Base--
rcmb: Base ← NIL;
rcmbPages: CARDINAL;
rcmbLimit: CARDINAL;
rcmbx: CARDINAL; -- number of words in the base
zone: UNCOUNTED ZONE ← NIL;
outer: PROC[stb: SymbolTable.Base, mdi: MDIndex, inner: PROC[base: SymbolTable.Base]] ← NIL;

--Errors --
TooManyRCMaps: ERROR = CODE;
NIY: ERROR[msg: STRING];

--PROCs

Initialize: PUBLIC ENTRY PROC[ptr: Base,
nPages: CARDINAL,
expansionZone: UNCOUNTED ZONE ← NIL] =
{rcmb ← ptr; rcmbx ← 0;
rcmbPages ← nPages;
rcmbLimit ← nPages*Environment.wordsPerPage;
zone ← expansionZone;
InitStandardRCMaps[! UNWIND => NULL]};

EstablishOuter: PUBLIC ENTRY PROC
[outerProc:
PROC [stb: SymbolTable.Base,
mdi: Symbols.MDIndex,
inner: PROC[base: SymbolTable.Base]]] =
{outer ← outerProc};

InitStandardRCMaps: INTERNAL PROC = {
IF rcmbLimit < 3 THEN ExpandRCMSpace[];
-- make standard entries
rcmb[nullIndex] ← [null[]];
rcmb[refIndex] ← [ref[]];
rcmb[controlLinkIndex] ← [controlLink[]];
rcmbx ← 3};

Finalize: PUBLIC ENTRY PROC = {IF zone # NIL THEN zone.FREE[@rcmb]};

GetBase: PUBLIC ENTRY PROC RETURNS[base: Base, nWords: CARDINAL] = {RETURN[rcmb, rcmbx]};

Acquire: PUBLIC ENTRY PROC[stb: SymbolTable.Base, sei: SEIndex]
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 ← FIRST[Index], 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 =
{ 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[SIZE[array Object]]];
rcmb[ans] ← [array[]]};

NewNVRCM: INTERNAL PROC[nComponents: [0..componentMaxIndex]] RETURNS[ans: NVIndex] =
{ans ← LOOPHOLE[AllocRCMap[SIZE[nonVariant Object] + nComponents * SIZE[RCField]]];
rcmb[ans] ← [nonVariant[nComponents: nComponents,
components: NULL]];
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[SIZE[variant Object] + nVariants * SIZE[Index]]];
rcmb[ans] ← [variant[fdTag: fdTag,
nVariants: nVariants,
variants: NULL]];
FOR i: CARDINAL IN [0..nVariants) DO rcmb[ans].variants[i] ← nullIndex; ENDLOOP};

NewSeqRCM: INTERNAL PROC RETURNS[ans: SeqIndex] =
{ans ← LOOPHOLE[AllocRCMap[SIZE[sequence Object]]];
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, null Object].type = null THEN RETURN[nullIndex];
IF LOOPHOLE[srcm, ref Object].type = ref THEN RETURN[refIndex];
IF DoEnumerate[rcmb, rcmbx, proc].stopped THEN RETURN[ans];
ans ← AllocRCMap[SIZE[simple Object]];
rcmb[LOOPHOLE[ans, RefIndex]] ← srcm};

MakeRCMapForRecord: INTERNAL PROC[stb: SymbolTable.Base, rsei: RecordSEIndex]
RETURNS[Index] =
{ IF NOT 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: SEIndex = 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 NOT IsRC[stb, componentSEI] THEN RETURN[nullIndex];
IF NOT 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 = SENull 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 NOT 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: union cons SERecord] = -- 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: sequence cons SERecord] = -- called once
{ IF NOT scser.controlled THEN ERROR NIY["computed sequences"L];
IF ncc = 0 AND NOT 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 NOT 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]=
{ argrec: BOOL = stb.seb[rsei].argument;

foffset: INTERNAL PROC[isei: ISEIndex] RETURNS[BitAddress] =
{RETURN[IF argrec THEN stb.FnField[isei].offset ELSE stb.seb[isei].idValue]};

append: INTERNAL PROC[stb: SymbolTable.Base, isei: ISEIndex] RETURNS[stop: BOOL] =
{ sei: SEIndex ← stb.seb[isei].idType;
IF (NOT (IsUnion[stb, sei] OR IsSequence[stb, sei]))
AND (NOT stb.seb[isei].constant)
AND IsRC[stb, sei] THEN
{ foffset: INTERNAL PROC[stb: SymbolTable.Base, isei: ISEIndex] RETURNS[BitAddress] =
{RETURN[IF argrec THEN stb.FnField[isei].offset ELSE stb.seb[isei].idValue]};
rcmb[nvrcmx].components[nextIndex]
← [ wordOffset: foffset[stb, isei].wd,
rcmi: DoAcquire[stb, stb.UnderType[sei]]];
nextIndex ← nextIndex + 1
};
RETURN[FALSE]; -- keep counting
};
nextIndex ← 0;
[] ← EnumerateRecordIseis[stb, rsei, append];
};

StuffRCVariantComponents: INTERNAL PROC
[ stb: SymbolTable.Base,
uc: union cons SERecord,
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: simple Object ← [simple[]];
rrcmr: oneRef Object ← [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 ← NOT 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: SEIndex] RETURNS[BOOL] =
{RETURN[stb.seb[stb.UnderType[seIndex]].typeTag = union]};

-- copied (GROAN) from RTWalkSymbolsImpl
IsSequence: INTERNAL PROC [stb: SymbolTable.Base, seIndex: SEIndex] 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: SEIndex ← stb.seb[isei].idType;
IF NOT (IsUnion[stb, sei] OR IsSequence[stb, sei]) OR level = 0 THEN RETURN[p[stb, isei]];
RETURN[FALSE]};

IF rsei = SENull 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 NOT 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 = HTNull 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: union cons SERecord],
sequenceProc: PROC[scstb: SymbolTable.Base, scser: sequence cons SERecord]]
RETURNS[BOOL] =
{ p: INTERNAL PROC[stb: SymbolTable.Base, isei: ISEIndex] RETURNS[stop: BOOL] =
{ c: cons SERecord;
sei: SEIndex ← 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: union cons SERecord]
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: SEIndex ← stb.seb[isei].idType;
IF (NOT (IsUnion[stb, sei] OR IsSequence[stb, sei]))
AND (NOT 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: SEIndex, checkCommon: BOOL ← TRUE]
RETURNS[BOOL] =
{ cse: cons SERecord ← 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: cons SERecord;
sei: SEIndex ← 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 NOT 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 => SIZE[null Object], --NOTE better be 1
ref => SIZE[ref Object], --NOTE better be 1
controlLink => SIZE[controlLink Object], --NOTE better be 1
oneRef => SIZE[oneRef Object], --NOTE better be 1
simple => SIZE[simple Object], --NOTE better be 1
nonVariant => SIZE[nonVariant Object] + rcmh.nComponents*SIZE[RCField],
variant => SIZE[variant Object] + rcmh.nVariants*SIZE[Index],
array => SIZE[array Object],
sequence => SIZE[sequence Object],
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
 Inline.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: NULL, 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: NULL, 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*Environment.wordsPerPage;
newRCMB: RCMap.Base;
T: TYPE = RECORD[SEQUENCE i: NAT OF WORD];
IF zone = NIL THEN ERROR TooManyRCMaps;
newRCMB ← LOOPHOLE[zone.NEW[T[newLimit-SIZE[T[0]]]]];
IF rcmb # NIL THEN {
Inline.LongCOPY[from: rcmb, to: newRCMB, nwords: rcmbLimit];
zone.FREE[@rcmb]};
rcmb ← newRCMB; rcmbLimit ← newLimit};


-- START HERE

IF SIZE[null Object] # 1
OR SIZE[ref Object] # 1
OR SIZE[oneRef Object] # 1
OR SIZE[simple Object] # 1
OR SIZE[controlLink Object] # 1 THEN ERROR;

END.