
<<file Pass4B.Mesa>>
<<last modified by Satterthwaite, June 7, 1983 10:02 am>>
<<last modified by Sweet, Jan 20, 1981 12:32 PM>>
<<Last Edited by: Maxwell, August 2, 1983 11:30 am>>

DIRECTORY
Alloc: TYPE USING [Notifier, Top],
BcdDefs: TYPE USING [
BCD, BcdBase, CodeDesc, EVHandle, EVIndex, EVRecord, EXPRecord, FTIndex, FTRecord,
IMPIndex, IMPRecord, Link, LFIndex, MTRecord, Namee, NameRecord, NameString,
NTRecord, PackedString, RefLitIndex, RFIndex, SGIndex, SGRecord, TFIndex, TMRecord,
TypeIndex, TYPIndex, TYPRecord, VarIndex, VersionID,
CTNull, EVNull, FTSelf, LFNull, RFNull, TFNull, NullLink, NullName],
ComData: TYPE USING [
bcdSeg, codeSeg, compilerVersion, fixupLoc, importCtx, interface, linkCount,
mainCtx, moduleCtx, mtRoot, mtRootSize, nBodies, nSigCodes, objectVersion,
ownSymbols, pattern, source, switches, symSeg, table, textIndex],
CompilerUtil: TYPE USING [
AppendBCDString, AppendBCDWord, AppendBCDWords, EndBCD, FillBCDPage,
ReadBCDIndex, ReadBCDOffset, RTTableOut, StartBCD, UpdateBCDWords],
ConvertUnsafe: TYPE USING [EqualSubStrings, AppendRope, SubString, SubStringToRope, ToRope],
Copier: TYPE USING [FreeSymbolTable, GetSymbolTable, MapSymbols, UnmapSymbols],
Log: TYPE USING [ErrorN, ErrorSei, WarningSei, WarningRope, WarningSubString],
P4: TYPE USING [ownGfi, DefaultBasicOps, OperandType],
Pass4: TYPE USING [resident],
PrincOps: TYPE USING [EPIndex, GFTIndex, MaxNGfi, wordsPerPage],
ReplOps: TYPE USING [MatchedBodies, Unmatched],
Rope: TYPE USING [Length],
Symbols: TYPE USING [
bodyType, ctxType, mdType, seType,
Base, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
IncludedCTXIndex, BitAddress, Linkage, MDRecord, MDIndex, BTIndex,
nullName, ISENull, CTXNull, MDNull, BTNull, nullFileIndex,
OwnMdi, RootBti, typeTYPE],
SymbolOps: TYPE USING [
FindString, FirstCtxSe, NextSe, SearchContext, SubStringForName,
TypeForm, UnderType, XferMode],
SymbolTable: TYPE USING [Base],
SymLiteralOps: TYPE USING [
RefLitItem,
DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes,
UTypeId, TypeIndex],
Tree: TYPE USING [Base, Index, Link, Map, Scan, NullIndex, treeType],
TreeOps: TYPE USING [GetNode, GetSe, ListLength, ScanList],
Types: TYPE USING [SymbolTableBase, Assignable, Equivalent];

Pass4B: PROGRAM
IMPORTS
Alloc, CompilerUtil, ConvertUnsafe, Copier, Log, P4, ReplOps, Rope, 
SymbolOps, SymLiteralOps, TreeOps, Types,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 = {
OPEN SymbolOps, Symbols;

tb: Tree.Base;    -- tree base address (local copy)
seb: Symbols.Base;    -- se table base address (local copy)
ctxb: Symbols.Base;    -- context table base address (local copy)
mdb: Symbols.Base;    -- body table base address (local copy)
bb: Symbols.Base;    -- body table base address (local copy)

zone: UNCOUNTED ZONE _ NIL;

ZoneWords: PROC [n: CARDINAL] RETURNS [LONG POINTER] = {
WordSeq: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
RETURN [zone.NEW[WordSeq[n]]]};

FreeZoneWords: PROC [p: LONG POINTER] = INLINE {zone.FREE[@p]};


BCDNotify: PUBLIC Alloc.Notifier = {
<<called by allocator whenever table area is repacked>>
tb _ base[Tree.treeType];
seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
bb _ base[bodyType]};


<<shared variables>>

bcdHeader: BcdDefs.BcdBase;
BcdHeaderPage: CARDINAL = 1;        -- page 0 is reserved
bcdOffset, mtOffset: CARDINAL;

nString: BcdDefs.NameString;

firstPorted: MDIndex = MDIndex.FIRST + MDRecord.SIZE;
lastPorted: MDIndex;    -- im/exported files in [firstPorted..lastPorted)

<<service routines>>

GFTIndex: TYPE = PrincOps.GFTIndex;
EPIndex: TYPE = PrincOps.EPIndex;
EPLimit: CARDINAL = EPIndex.LAST+1;
VarLimit: CARDINAL = BcdDefs.VarIndex.LAST+1;
BcdLink: TYPE = BcdDefs.Link;

ownGfi: GFTIndex = P4.ownGfi;


GFSlots: PROC [epMax: EPIndex] RETURNS [nGfi: [1..4]] = {
nGfi _ epMax/EPLimit + 1; RETURN};

MakeEPLink: PUBLIC PROC [ep: CARDINAL, gfi: GFTIndex] RETURNS [BcdLink] = {
RETURN [[procedure[tag: TRUE, ep: ep MOD EPLimit, gfi: gfi + ep/EPLimit]]]};

MakeFrameLink: PROC [ep: CARDINAL, gfi: GFTIndex] RETURNS [BcdLink] = {
RETURN [[variable[vtag: var, var: ep MOD VarLimit, vgfi: gfi + ep/VarLimit]]]};

MakeTypeLink: PROC [index: BcdDefs.TYPIndex] RETURNS [BcdLink] = INLINE {
RETURN [[type[typeID: index, type: TRUE, proc: FALSE]]]};


MdiForCtx: PROC [ctx: CTXIndex] RETURNS [MDIndex] = {
RETURN [WITH c: ctxb[ctx] SELECT FROM
included => c.module,
imported => ctxb[c.includeLink].module,
ENDCASE => OwnMdi]};

PortedCtx: PROC [ctx: CTXIndex] RETURNS [BcdDefs.FTIndex] = {
RETURN [PortedFile[MdiForCtx[ctx]]]};

PortedFile: PROC [mdi: MDIndex] RETURNS [fti: BcdDefs.FTIndex] = {
n: CARDINAL;
IF mdi = OwnMdi THEN fti _ BcdDefs.FTSelf
ELSE {
IF mdi IN [firstPorted .. lastPorted) THEN
n _ LOOPHOLE[mdi-firstPorted, CARDINAL]/MDRecord.SIZE
ELSE {
n _ LOOPHOLE[lastPorted-firstPorted, CARDINAL]/MDRecord.SIZE;
SwapMdi[mdi, lastPorted];
lastPorted _ lastPorted + MDRecord.SIZE};
fti _ LOOPHOLE[n*BcdDefs.FTRecord.SIZE]};
RETURN};

SwapMdi: PROC [mdi1, mdi2: MDIndex] = {
IF mdi1 # mdi2 THEN {
ctx: IncludedCTXIndex;
t: MDRecord;
FOR ctx _ mdb[mdi1].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
ctxb[ctx].module _ mdi2 ENDLOOP;
FOR ctx _ mdb[mdi2].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
ctxb[ctx].module _ mdi1 ENDLOOP;
t _ mdb[mdi1];  mdb[mdi1] _ mdb[mdi2];  mdb[mdi2] _ t}};


SubString: TYPE = ConvertUnsafe.SubString;

EnterId: PROC [id: SubString, ignoreCase: BOOL] RETURNS [BcdDefs.NameRecord] = {
i: CARDINAL;
s: SubString;
i _ 0;  s.base _ @nString.string;
UNTIL i = nString.string.length DO
s.offset _ i _ i+1;  s.length _ nString.size[i];
IF ConvertUnsafe.EqualSubStrings[s1: id, s2: s, case: ~ignoreCase] THEN EXIT;
i _ i + s.length;
REPEAT
FINISHED => {
IF nString.string.length + (id.length+1) > nString.string.maxlength THEN {
<<rewrite if nString is in table area>>
t: BcdDefs.NameString _ LOOPHOLE[
zone.NEW[StringBody[nString.string.maxlength + MAX[(id.length+1), 32]]]];
ConvertUnsafe.AppendRope[@t.string, ConvertUnsafe.ToRope[@nString.string]];
zone.FREE[@nString];  nString _ t};
i _ nString.string.length _ nString.string.length + 1;
nString.size[i] _ id.length;
<<FOR j: CARDINAL IN [0..id.length) DO>>
<<Strings.AppendChar[@nString.string, id.base[id.offset+j]]] >>
<<ENDLOOP>>
ConvertUnsafe.AppendRope[@nString.string, ConvertUnsafe.SubStringToRope[[id.base, id.offset, id.offset + id.length]]]};
ENDLOOP;
RETURN [[i]]};

EnterSymbolId: PROC [sei: ISEIndex] RETURNS [BcdDefs.NameRecord] = {
s: ConvertUnsafe.SubString;
s _ SubStringForName[seb[sei].hash];
RETURN [EnterId[s, FALSE]]};

EnterFileId: PROC [mdi: MDIndex] RETURNS [BcdDefs.NameRecord] = {
s: ConvertUnsafe.SubString;
extLength: CARDINAL = (".bcd"L).length;
s _ SubStringForName[mdb[mdi].fileId];
IF s.base[s.offset+s.length-1] = '. THEN s.length _ s.length - 1;
IF s.length > extLength THEN {
t: ConvertUnsafe.SubString _ [
base: s.base, offset: s.offset+s.length-extLength, length: extLength];
ext: ConvertUnsafe.SubString _ [base:".bcd"L, offset:0, length:extLength];
IF ConvertUnsafe.EqualSubStrings[s1: t, s2: ext, case: FALSE] 
THEN s.length _ s.length - extLength};
RETURN [EnterId[s, TRUE]]};


<<processing directory entries (to file table)>>

ProcessDirectory: PUBLIC Tree.Scan = {

DirectoryItem: Tree.Scan = {
node: Tree.Index = TreeOps.GetNode[t];
sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
type: CSEIndex = UnderType[seb[sei].idType];
WITH t: seb[type] SELECT FROM
definition => [] _ PortedCtx[t.defCtx];
transfer => {
bti: BTIndex = seb[sei].idInfo;
IF bti # BTNull THEN [] _ PortedCtx[bb[bti].localCtx]};
ENDCASE};

TreeOps.ScanList[t, DirectoryItem]};


<<relocating imported control links>>

ScanImports: PROC [action: PROC [ISEIndex]] = {
FOR sei: ISEIndex _ FirstCtxSe[dataPtr.importCtx], NextSe[sei] UNTIL sei = ISENull DO
action[sei] ENDLOOP};

RelocateImports: PROC [ctx: CTXIndex, gfi: GFTIndex] RETURNS [epMax: EPIndex _ 0] = {
FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF ~seb[sei].constant THEN {
epN: CARDINAL = seb[sei].idValue;
seb[sei].idValue _ MakeEPLink[epN, gfi];  epMax _ MAX[epN, epMax]};
ENDLOOP;
RETURN};

AssignImports: PUBLIC Tree.Scan = {
gfi: GFTIndex;
saveIndex: CARDINAL = dataPtr.textIndex;

ImportItem: PROC [sei: ISEIndex] = {
node: Tree.Index = seb[sei].idValue;
type: CSEIndex = UnderType[seb[sei].idType];
epMax: EPIndex;
IF node # Tree.NullIndex THEN dataPtr.textIndex _ tb[node].info;
WITH t: seb[type] SELECT FROM
definition => {
IF ctxb[t.defCtx].seList = ISENull THEN Log.WarningSei[unusedImport, sei];
epMax _ IF dataPtr.interface THEN 0 ELSE RelocateImports[t.defCtx, gfi];
gfi _ gfi + (seb[sei].idInfo _ t.nGfi)};
ref => {
IF ~dataPtr.interface THEN seb[sei].idValue _ MakeEPLink[ep:0, gfi:gfi];
gfi _ gfi + 1};
ENDCASE;
seb[sei].mark4 _ TRUE};

dataPtr.mtRoot.gfi _ ownGfi;
dataPtr.mtRoot.ngfi _ GFSlots[MAX[dataPtr.nBodies, dataPtr.nSigCodes]-1];
gfi _ bcdHeader.firstdummy _ ownGfi + PrincOps.MaxNGfi;
ScanImports[ImportItem];
bcdHeader.nDummies _ gfi - bcdHeader.firstdummy;
dataPtr.textIndex _ saveIndex};


<<writing frame fragments (link fragment written by Pass4L)>>

ProcessSymLiterals: PUBLIC PROC = {
offset, length: CARDINAL;
bcdHeader.rfOffset _ CompilerUtil.ReadBCDOffset[];
bcdHeader.lfLimit _ LOOPHOLE[bcdHeader.rfOffset - bcdHeader.lfOffset];
IF ~dataPtr.interface THEN {
rfi: BcdDefs.RefLitIndex _ [0];

AppendLitItem: PROC [SymLiteralOps.RefLitItem] = {
CompilerUtil.AppendBCDWords[@rfi, BcdDefs.RefLitIndex.SIZE];
rfi _ [rfi + 1]};

[offset, length] _ SymLiteralOps.DescribeRefLits[];
IF length # 0 THEN {
WITH m: dataPtr.mtRoot SELECT FROM
multiple => m.refLiterals _ BcdDefs.RFIndex.FIRST;
ENDCASE;
CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
SymLiteralOps.EnumerateRefLits[AppendLitItem]}};
bcdHeader.tfOffset _ CompilerUtil.ReadBCDOffset[];
bcdHeader.rfLimit _ LOOPHOLE[bcdHeader.tfOffset - bcdHeader.rfOffset];
IF ~dataPtr.interface THEN {
tfi: BcdDefs.TypeIndex _ [0];

AppendTypeIndex: PROC [canonical: BOOL, type: Type] = {
CompilerUtil.AppendBCDWords[@tfi, BcdDefs.TypeIndex.SIZE];
tfi _ [tfi + 1]};

[offset, length] _ SymLiteralOps.DescribeTypes[];
IF length # 0 THEN {
WITH m: dataPtr.mtRoot SELECT FROM
multiple => m.types _ BcdDefs.TFIndex.FIRST;
ENDCASE;
CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
SymLiteralOps.EnumerateTypes[AppendTypeIndex]}};
bcdHeader.tfLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[] - bcdHeader.tfOffset]};


<<writing import records>>

ProcessImports: PUBLIC Tree.Scan = {
<<N.B. nextGfi must be regenerated to match AssignImports>>
nImports: CARDINAL;
impi: BcdDefs.IMPIndex;
nextGfi: GFTIndex;
anyNamed: BOOL;

ProcessSei: PROC [sei, tSei: ISEIndex, implicit: BOOL] = {
type: CSEIndex = UnderType[seb[sei].idType];
entry: BcdDefs.IMPRecord _ [
name: EnterSymbolId[tSei],
port: interface,
namedInstance: seb[sei].hash # seb[tSei].hash,
file: ,
gfi: nextGfi, ngfi: ];
WITH t: seb[type] SELECT FROM
definition => {
entry.file _ PortedCtx[t.defCtx];  entry.ngfi _ seb[sei].idInfo;
nextGfi _ (seb[sei].idValue _ nextGfi) + seb[sei].idInfo};
ref => {
rType: RecordSEIndex = LOOPHOLE[UnderType[t.refType]];
entry.port _ module;
entry.file _ PortedCtx[seb[rType].fieldCtx];  entry.ngfi _ 1;
nextGfi _ nextGfi + 1};
ENDCASE;
nImports _ nImports + 1;
IF entry.namedInstance THEN anyNamed _ TRUE;
CompilerUtil.AppendBCDWords[@entry, BcdDefs.IMPRecord.SIZE]};

sei: ISEIndex;    -- updated by ImportItem

ImportItem: Tree.Scan = {
node: Tree.Index = TreeOps.GetNode[t];
ProcessSei[sei, TreeOps.GetSe[tb[node].son[2]], FALSE];
sei _ NextSe[sei]};

NameItem: Tree.Scan = {
node: Tree.Index = TreeOps.GetNode[t];
sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
tSei: ISEIndex = TreeOps.GetSe[tb[node].son[2]];
entry: BcdDefs.NTRecord;
IF  seb[sei].hash # seb[tSei].hash THEN {
entry _ [name: EnterSymbolId[sei], item: BcdDefs.Namee[import[impi]]];
CompilerUtil.AppendBCDWords[@entry, BcdDefs.NTRecord.SIZE]};
impi _ impi + BcdDefs.IMPRecord.SIZE};

offset: CARDINAL;
bcdHeader.impOffset _ offset _ CompilerUtil.ReadBCDOffset[];
nImports _ 0;  impi _ BcdDefs.IMPIndex.FIRST;
nextGfi _ bcdHeader.firstdummy;  anyNamed _ FALSE;
sei _ FirstCtxSe[dataPtr.importCtx];
TreeOps.ScanList[t, ImportItem];
UNTIL sei = ISENull DO ProcessSei[sei, sei, TRUE]; sei _ NextSe[sei] ENDLOOP;
bcdHeader.nImports _ nImports;
bcdHeader.impLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
bcdHeader.ntOffset _ offset _ CompilerUtil.ReadBCDOffset[];
IF anyNamed THEN TreeOps.ScanList[t, NameItem];    -- matches importCtx prefix
bcdHeader.ntLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset]};


<<writing export records>>

maxEVLength: CARDINAL;
evList: BcdDefs.EVHandle;

EnterEVOffset: PROC [offset: CARDINAL] RETURNS [index: CARDINAL] = {
IF offset = 0 THEN index _ 0
ELSE
FOR index IN [1 .. evList.length] DO
IF offset = evList.offsets[index] THEN EXIT;
REPEAT
FINISHED => {
index _ evList.length _ evList.length + 1;
IF index <= maxEVLength THEN evList.offsets[index] _ offset};
ENDLOOP;
RETURN};


TypeMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF
RECORD [opaque: BcdDefs.TMRecord, concrete: BcdDefs.TYPRecord]];
typeMap: LONG POINTER TO TypeMap;
mapIndex: CARDINAL;
typeIndex: BcdDefs.TYPIndex;

EnterType: PROC [mdi: MDIndex, offset: CARDINAL, sei: ISEIndex]
RETURNS [typeId: BcdDefs.TYPIndex] = {
entry: BcdDefs.TYPRecord = MakeTypeId[sei];
IF typeMap = NIL OR mapIndex >= typeMap.length THEN AdjustTypeMap[8];
FOR i: CARDINAL IN [0..mapIndex) DO
IF typeMap[i].concrete = entry THEN GO TO matched;
REPEAT
matched => typeId _ typeMap[i].opaque.map;
FINISHED => {typeId _ typeIndex; typeIndex _ typeIndex + BcdDefs.TYPRecord.SIZE};
ENDLOOP;
typeMap[mapIndex] _ [
opaque: [version: mdb[mdi].stamp, offset: offset, map: typeId],
concrete: entry];
mapIndex _ mapIndex + 1;
RETURN};

MakeTypeId: PROC [id: ISEIndex] RETURNS [BcdDefs.TYPRecord] = {
sei: ISEIndex _ id;
next: Type;
mdi: MDIndex;
DO
next _ seb[sei].idInfo;
WITH seb[next] SELECT FROM
id => sei _ LOOPHOLE[next];
ENDCASE => EXIT;
ENDLOOP;
mdi _ MdiForCtx[seb[sei].idCtx];
RETURN [[id: [seb[sei].idValue], version: mdb[mdi].stamp]]};

AdjustTypeMap: PROC [delta: CARDINAL] = {
oldN: CARDINAL = IF typeMap = NIL THEN 0 ELSE typeMap.length;
newMap: LONG POINTER TO TypeMap = zone.NEW[TypeMap[oldN+delta]];
FOR i: CARDINAL IN [0 .. oldN) DO newMap[i] _ typeMap[i] ENDLOOP;
IF typeMap # NIL THEN zone.FREE[@typeMap];
typeMap _ newMap};

WriteTypeTable: PROC = {
i, offset: CARDINAL;
next: BcdDefs.TYPIndex _ BcdDefs.TYPIndex.FIRST;
bcdHeader.typOffset _ offset _ CompilerUtil.ReadBCDOffset[];
FOR i IN [0 .. mapIndex) DO
FOR j: CARDINAL IN [0..i) DO
IF typeMap[i].opaque.map = typeMap[j].opaque.map THEN EXIT
REPEAT
FINISHED => {
CompilerUtil.AppendBCDWords[@typeMap[i].concrete, BcdDefs.TYPRecord.SIZE];
next _ next + BcdDefs.TYPRecord.SIZE};
ENDLOOP;
ENDLOOP;
bcdHeader.typLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
bcdHeader.tmOffset _ offset _ CompilerUtil.ReadBCDOffset[];
FOR i IN [0 .. mapIndex) DO
CompilerUtil.AppendBCDWords[@typeMap[i].opaque, BcdDefs.TMRecord.SIZE];
ENDLOOP;
bcdHeader.tmLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset]};


ExportId: Tree.Map = {
expType: CSEIndex = P4.OperandType[t];
ctx: IncludedCTXIndex;
iBase: Types.SymbolTableBase;
id, sei, iSei: ISEIndex;
epN: CARDINAL;
used: BOOL;
id _ TreeOps.GetSe[t];
WITH v: seb[expType] SELECT FROM
definition => {
ctx _ LOOPHOLE[v.defCtx];
iBase _ Copier.GetSymbolTable[ctxb[ctx].module];
IF iBase # NIL THEN {
BEGIN
header: BcdDefs.EXPRecord _ [
name: EnterSymbolId[id],
size: 0,
port: interface,
namedInstance: FALSE,
typeExported: FALSE,
file: PortedCtx[v.defCtx],
links: ];
FOR iSei _ iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
SELECT iBase.LinkMode[iSei] FROM
val, ref => header.size _ header.size + 1;
type => {header.typeExported _ TRUE; header.size _ header.size + 1};
ENDCASE;
ENDLOOP;
CompilerUtil.AppendBCDWords[@header, BcdDefs.EXPRecord.SIZE];
END;
used _ FALSE;  epN _ 0;
FOR iSei _ iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
mode: Linkage = iBase.LinkMode[iSei];
link: BcdLink _ BcdDefs.NullLink;
BEGIN
ss: SubString;
name: Name;
ss _ iBase.SubStringForName[iBase.seb[iSei].hash];
name _ FindString[ss];
IF name = nullName THEN sei _ ISENull
ELSE {
sei _ SearchContext[name, dataPtr.mainCtx];
IF sei = ISENull THEN sei _ SearchContext[name, dataPtr.moduleCtx]};
END;
IF sei # ISENull THEN {
public: BOOL = seb[sei].public;
iType: CSEIndex = iBase.UnderType[iBase.seb[iSei].idType];
SELECT mode FROM
val => {
IF ~Types.Assignable[
[iBase, iType], [dataPtr.ownSymbols, UnderType[seb[sei].idType]]] THEN {
IF public THEN Log.ErrorSei[exportClash,sei]}
ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
Log.WarningSei[privateExport, sei];
IF public THEN {
IF ~seb[sei].constant OR seb[sei].extended THEN Log.ErrorSei[varExport, sei];
link _ IF XferMode[seb[sei].idType] = program
THEN MakeFrameLink[ep:EnterEVOffset[0], gfi:ownGfi]
ELSE seb[sei].idValue}};
ref => {
iTarget: CSEIndex _ iType;
iConst: BOOL _ iBase.seb[iSei].immutable;
WITH t: iBase.seb[iType] SELECT FROM
ref =>
IF t.var THEN {iTarget _ iBase.UnderType[t.refType]; iConst _ t.readOnly}; 
ENDCASE;
IF ~Types.Equivalent[
[iBase, iTarget], [dataPtr.ownSymbols, UnderType[seb[sei].idType]]] THEN {
IF public THEN Log.ErrorSei[exportClash,sei]}
ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
Log.WarningSei[privateExport, sei];
IF public THEN {
SELECT TRUE FROM
seb[sei].constant => Log.ErrorSei[varExport, sei];
seb[sei].immutable AND ~iConst => Log.ErrorSei[exportClash, sei];
ENDCASE;
link _ MakeFrameLink[
ep: EnterEVOffset[LOOPHOLE[seb[sei].idValue, BitAddress].wd],
gfi: ownGfi]}};
type =>
IF seb[sei].idType # typeTYPE OR TypeForm[sei] = opaque THEN {
IF public THEN Log.ErrorSei[exportClash, sei]}
ELSE {
iValue: CSEIndex = iBase.UnderType[iSei];
IF (~public AND seb[sei].idCtx = dataPtr.mainCtx) THEN
Log.WarningSei[privateExport, sei]
ELSE
WITH it: iBase.seb[iValue] SELECT FROM
opaque =>
IF it.lengthKnown AND ~P4.DefaultBasicOps[sei, it.length] THEN
Log.ErrorSei[exportAttr, sei];
ENDCASE => ERROR;
IF public THEN {
link _ MakeTypeLink[EnterType[ctxb[ctx].module, epN, sei]];
bcdHeader.typeExported _ TRUE}};
manifest =>
IF public
AND (seb[sei].idType # typeTYPE OR iBase.seb[iSei].idType # typeTYPE) THEN
Log.WarningSei[voidExport, sei];
ENDCASE};
IF link # BcdDefs.NullLink THEN used _ TRUE;
IF mode # manifest THEN {CompilerUtil.AppendBCDWord[link]; epN _ epN + 1};
ENDLOOP;
Copier.FreeSymbolTable[iBase];
IF ~used THEN Log.WarningSei[unusedExport, id]}};
ENDCASE;
RETURN [t]};

ExportItem: Tree.Scan = {
node: Tree.Index = TreeOps.GetNode[t];
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex _ tb[node].info;
tb[node].son[2] _ ExportId[tb[node].son[2]];
dataPtr.textIndex _ saveIndex};

ProcessExports: PUBLIC Tree.Map = {
offset: CARDINAL;
bcdHeader.nExports _ TreeOps.ListLength[t];
bcdHeader.expOffset _ offset _ CompilerUtil.ReadBCDOffset[];
maxEVLength _ PrincOps.MaxNGfi*VarLimit - 1;
evList _ ZoneWords[BcdDefs.EVRecord.SIZE+maxEVLength];
evList^ _ [length:0, offsets:];
typeIndex _ BcdDefs.TYPIndex.FIRST;  mapIndex _ 0;  typeMap _ NIL;
TreeOps.ScanList[t, ExportItem];
bcdHeader.expLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
bcdHeader.evOffset _ offset _ CompilerUtil.ReadBCDOffset[];
IF evList.length > maxEVLength THEN Log.ErrorN[exportedVars, evList.length-maxEVLength];
IF evList.length = 0 THEN dataPtr.mtRoot.variables _ BcdDefs.EVNull
ELSE {
dataPtr.mtRoot.ngfi _ MAX[dataPtr.mtRoot.ngfi, evList.length/VarLimit+1];
dataPtr.mtRoot.variables _ BcdDefs.EVIndex.FIRST;
CompilerUtil.AppendBCDWords[evList,
BcdDefs.EVRecord.SIZE + MIN[evList.length, maxEVLength]]};
bcdHeader.evLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
FreeZoneWords[evList];
WriteTypeTable[];
IF typeMap # NIL THEN zone.FREE[@typeMap];
RETURN [t]};


<<initialization/finalization>>

ProcessFiles: PROC = {
ftEntry: BcdDefs.FTRecord;
mdi: MDIndex;
limit: MDIndex = (dataPtr.table).Top[mdType];

EnterCanonicalFile: PROC [canonical: BOOL, type: Type] = {
IF ~canonical THEN {
mdi: MDIndex;
[mdi, ] _  SymLiteralOps.UTypeId[type];
IF mdi # MDNull THEN [] _ PortedFile[mdi]}};

offset: CARDINAL = CompilerUtil.ReadBCDOffset[];
FOR mdi _ lastPorted, mdi + MDRecord.SIZE UNTIL mdi = limit DO
IF mdb[mdi].file # nullFileIndex THEN
[] _ PortedFile[mdi];    -- add any files opened during compilation
ENDLOOP;
bcdHeader.ftOffset _ offset;
SymLiteralOps.EnumerateTypes[EnterCanonicalFile];
FOR mdi _ firstPorted, mdi + MDRecord.SIZE UNTIL mdi = lastPorted DO
ftEntry _ [name: EnterFileId[mdi], version: mdb[mdi].stamp];
CompilerUtil.AppendBCDWords[@ftEntry, BcdDefs.FTRecord.SIZE];
ENDLOOP;
bcdHeader.ftLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[] - offset]};


InitBCD: PUBLIC PROC [ids: Tree.Link, scratchZone: UNCOUNTED ZONE] = {
OPEN BcdDefs;
nIds: CARDINAL;
zone _ scratchZone;
nIds _ TreeOps.ListLength[ids];
IF nIds > 1 AND ~dataPtr.interface THEN {Log.ErrorN[listLong, nIds-1]; nIds _ 1};
lastPorted _ firstPorted;
nString _ LOOPHOLE[zone.NEW[StringBody[64]]];
<<allocate the null name>>
nString.string.length _ BcdDefs.NullName;
nString.size[BcdDefs.NullName] _ 0;
mdb[OwnMdi].stamp _ dataPtr.objectVersion;    -- update from DIRECTORY processing
CompilerUtil.StartBCD[];
bcdHeader _ zone.NEW[BCD];
bcdHeader.versionIdent _ VersionID;
bcdHeader.version _ dataPtr.objectVersion;
bcdHeader.creator _ dataPtr.compilerVersion;
bcdHeader.sourceVersion _ dataPtr.source.version;
bcdHeader.nConfigs _ 0;
bcdHeader.nModules _ nIds;
bcdHeader.nImports _ bcdHeader.nExports _ 0;
bcdHeader.definitions _ dataPtr.interface;
bcdHeader.typeExported _ FALSE;
bcdHeader.repackaged _ bcdHeader.tableCompiled _ FALSE;
bcdHeader.versions _ FALSE;
bcdHeader.extended _ TRUE;
bcdHeader.spare1 _ TRUE;    -- large eval stack
bcdHeader.spare2 _ FALSE;
bcdHeader.ctOffset _ 0;  bcdHeader.ctLimit _ LOOPHOLE[0];
bcdHeader.spOffset _ 0;  bcdHeader.spLimit _ LOOPHOLE[0];
bcdHeader.fpOffset _ 0;  bcdHeader.fpLimit _ LOOPHOLE[0];
nString.string.length _ nString.string.length + 1;
bcdHeader.source _ NameRecord[nString.string.length];
nString.size[bcdHeader.source] _ dataPtr.source.locator.Length[];
ConvertUnsafe.AppendRope[@nString.string, dataPtr.source.locator];
bcdOffset _ CompilerUtil.ReadBCDOffset[];
CompilerUtil.AppendBCDWords[bcdHeader, BCD.SIZE];
dataPtr.fixupLoc _ CompilerUtil.ReadBCDIndex[];
bcdHeader.sgOffset _ CompilerUtil.ReadBCDOffset[];
CompilerUtil.AppendBCDWords[@dataPtr.codeSeg, SGRecord.SIZE];
CompilerUtil.AppendBCDWords[@dataPtr.symSeg, SGRecord.SIZE];
bcdHeader.mtOffset _ mtOffset _ CompilerUtil.ReadBCDOffset[];
bcdHeader.sgLimit _ LOOPHOLE[mtOffset - bcdHeader.sgOffset];
IF dataPtr.interface THEN {
dataPtr.mtRootSize _ BcdDefs.MTRecord.indirect.SIZE;
dataPtr.mtRoot _ zone.NEW[BcdDefs.MTRecord.indirect];
dataPtr.mtRoot.extension _ indirect[links: BcdDefs.LFNull]}
ELSE {
dataPtr.mtRootSize _ BcdDefs.MTRecord.multiple.SIZE;
dataPtr.mtRoot _ zone.NEW[BcdDefs.MTRecord.multiple];
dataPtr.mtRoot.extension _ multiple[
links: BcdDefs.LFIndex.FIRST,
refLiterals: BcdDefs.RFNull,
types: BcdDefs.TFNull]};
FOR i: CARDINAL IN [0..nIds) DO
CompilerUtil.AppendBCDWords[dataPtr.mtRoot, dataPtr.mtRootSize]
ENDLOOP;
bcdHeader.lfOffset _ CompilerUtil.ReadBCDOffset[];
bcdHeader.mtLimit _ LOOPHOLE[bcdHeader.lfOffset-bcdHeader.mtOffset]};

FinishBCD: PUBLIC PROC [ids: Tree.Link] = {
OPEN BcdDefs;
PageSize: CARDINAL = PrincOps.wordsPerPage;
Alignment: CARDINAL = 4;  -- Code Segments must start at 0 MOD Alignment
nLinks: CARDINAL = dataPtr.linkCount;
codeLinks: BOOL = dataPtr.switches['l];
gfType: RecordSEIndex = bb[RootBti].type;
<<fill MTRecord>>
IF TreeOps.ListLength[ids] > 1 THEN {    -- complete nString now

EnterId: Tree.Scan = {[] _ EnterSymbolId[TreeOps.GetSe[t]]};

TreeOps.ScanList[ids, EnterId]};
dataPtr.mtRoot.name _ EnterSymbolId[bb[RootBti].id];
dataPtr.mtRoot.namedInstance _ FALSE;
dataPtr.mtRoot.initial _ ~dataPtr.switches['s];
dataPtr.mtRoot.file _ dataPtr.bcdSeg.file _ dataPtr.codeSeg.file _ dataPtr.symSeg.file _ 
PortedCtx[dataPtr.mainCtx];
dataPtr.bcdSeg.base _ 0;
dataPtr.mtRoot.linkLoc _ IF codeLinks THEN code ELSE frame;
dataPtr.mtRoot.config _ CTNull;
dataPtr.mtRoot.code _ CodeDesc[
sgi: SGIndex.FIRST,
packed: FALSE, linkspace: codeLinks,
offset: IF codeLinks AND nLinks # 0
THEN (nLinks+1) + (Alignment-1 - (nLinks MOD Alignment))
ELSE 0,
length: 0];    -- will be updated
dataPtr.mtRoot.sseg _ SGIndex.FIRST + SGRecord.SIZE;
dataPtr.mtRoot.frameRefs _ seb[gfType].hints.refField;
dataPtr.mtRoot.frameType _
IF seb[gfType].hints.refField THEN SymLiteralOps.TypeIndex[gfType] ELSE 0;
dataPtr.mtRoot.framesize _ 0;    -- will be updated
dataPtr.mtRoot.altoCode _  FALSE;
dataPtr.mtRoot.tableCompiled _ FALSE;
dataPtr.mtRoot.residentFrame _ passPtr.resident;
dataPtr.mtRoot.boundsChecks _ dataPtr.switches['b];
dataPtr.mtRoot.nilChecks _ dataPtr.switches['n];
dataPtr.mtRoot.long _ dataPtr.switches['c];    -- compiled for Cedar
dataPtr.mtRoot.crossJumped _ dataPtr.switches['j];
dataPtr.mtRoot.packageable _ TRUE;
ProcessFiles[];
bcdHeader.ssOffset _ CompilerUtil.ReadBCDOffset[];
CompilerUtil.AppendBCDString[@nString.string];
bcdHeader.ssLimit _ LOOPHOLE[CompilerUtil.ReadBCDOffset[]-bcdHeader.ssOffset];
IF dataPtr.interface THEN bcdHeader.rtPages.relPageBase _ 0
ELSE {
CompilerUtil.FillBCDPage[];
bcdHeader.rtPages.relPageBase _ CompilerUtil.ReadBCDOffset[]/PageSize;
CompilerUtil.RTTableOut[dataPtr.table]};
bcdHeader.nPages _ (CompilerUtil.ReadBCDOffset[] + (PageSize-1))/PageSize;
bcdHeader.rtPages.pages _ bcdHeader.nPages - bcdHeader.rtPages.relPageBase;
CompilerUtil.UpdateBCDWords[bcdOffset, bcdHeader, BCD.SIZE];
dataPtr.bcdSeg.base _ 0; dataPtr.bcdSeg.pages _ bcdHeader.nPages;
IF dataPtr.interface AND TreeOps.ListLength[ids] > 1 THEN {
offset: CARDINAL _ mtOffset;
saveName: BcdDefs.NameRecord = dataPtr.mtRoot.name;

UpdateMDEntry: Tree.Scan = {
dataPtr.mtRoot.name _ EnterSymbolId[TreeOps.GetSe[t]];
CompilerUtil.UpdateBCDWords[offset, dataPtr.mtRoot, dataPtr.mtRootSize];
offset _ offset + dataPtr.mtRootSize};

offset _ mtOffset;  TreeOps.ScanList[ids, UpdateMDEntry];
dataPtr.mtRoot.name _ saveName};
CompilerUtil.EndBCD[];
zone.FREE[@nString]; zone.FREE[@bcdHeader]; zone _ NIL};


MatchBCD: PUBLIC PROC RETURNS [matched: BOOL _ FALSE] = {
oldSymbols: SymbolTable.Base _ Copier.MapSymbols[dataPtr.pattern];
IF oldSymbols = NIL THEN
Log.WarningRope[fileName, dataPtr.pattern.locator]
ELSE {
matched _ ReplOps.MatchedBodies[
[oldSymbols, RootBti], [dataPtr.ownSymbols, RootBti]
! ReplOps.Unmatched => {
d: ConvertUnsafe.SubString;
d _ id.stb.SubStringForName[id.stb.NameForSe[id.sei]];
SELECT attr FROM
strings => Log.WarningSubString[replString, d];
id => Log.WarningSubString[replId, d];
ENDCASE;
RESUME}];
Copier.UnmapSymbols[oldSymbols]}};

}.