Pass4B.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, May 27, 1986 3:05:23 pm PDT
Sweet, Jan 20, 1981 12:32 PM
Paul Rovner, October 5, 1983 5:03 pm
Russ Atkinson (RRA) March 6, 1985 10:49:46 pm PST
DIRECTORY
Alloc: TYPE USING [Notifier, Top],
BcdDefs: TYPE USING [BCD, BcdBase, CodeDesc, EVHandle, EVIndex, EVRecord, EXPRecord, FTIndex, FTRecord, IMPIndex, IMPRecord, Link, LFIndex, ModuleIndex, MTHandle, MTRecord, Namee, NameRecord, NameString, NTRecord, PackedString, ProcIndex, RefLitIndex, RFIndex, SGIndex, SGRecord, TFIndex, TMRecord, TypeIndex, TYPIndex, TYPRecord, VarIndex, VersionID, CTNull, EVNull, FTSelf, LFNull, RFNull, TFNull, NullLink, NullName, MaxNMi, PageSize, ProcLimit, VarLimit],
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],
Copier: TYPE USING [FreeSymbolTable, GetSymbolTable, MapSymbols, UnmapSymbols],
Log: TYPE USING [ErrorN, ErrorSei, ErrorType, WarningSei, WarningRope, WarningSubString],
P4: TYPE USING [ownGfi, DefaultBasicOps, OperandStruct],
Pass4: TYPE USING [resident],
RefText: TYPE USING [Append],
Rope: TYPE USING [Length],
SourceMap: TYPE USING [Loc],
Symbols: TYPE USING [bodyType, ctxType, mdType, seType, Base, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, IncludedCTXIndex, BitAddress, Linkage, MDRecord, MDIndex, BTIndex, CBTIndex, nullName, ISENull, RecordSENull, 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 [Handle, SymbolTableBase, Assignable, Equivalent],
UnsafeStorage: TYPE USING [GetSystemUZone];
Pass4B: PROGRAM
IMPORTS Alloc, CompilerUtil, ConvertUnsafe, Copier, Log, P4, RefText, Rope, SymbolOps, SymLiteralOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass4, UnsafeStorage
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)
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; -- initialized in START code, below
BcdHeaderPage: CARDINAL = 1;  -- page 0 is reserved
bcdOffset, mtOffset: CARDINAL;
nString: BcdDefs.NameString;
nStringREFTEXT: REF TEXT; -- NOTE SHARING with nString
firstPorted: MDIndex = MDIndex.FIRST + MDRecord.SIZE;
lastPorted: MDIndex; -- im/exported files in [firstPorted..lastPorted)
evList: BcdDefs.EVHandle; -- initialized in START code, below
indirectMTRecord: BcdDefs.MTHandle; -- initialized in START code, below
multipleMTRecord: BcdDefs.MTHandle; -- initialized in START code, below
service routines
ModuleIndex: TYPE = BcdDefs.ModuleIndex;
ProcIndex: TYPE = BcdDefs.ProcIndex;
ProcLimit: CARDINAL = BcdDefs.ProcLimit;
VarLimit: CARDINAL = BcdDefs.VarLimit;
maxEVLength: CARDINAL = BcdDefs.MaxNMi*(BcdDefs.VarIndex.LAST+1) - 1;
BcdLink: TYPE = BcdDefs.Link;
ownGfi: ModuleIndex = P4.ownGfi;
GFSlots: PROC[epMax: NAT] RETURNS[nGfi: NAT] = {
nGfi ← epMax/ProcLimit + 1; RETURN};
MakeEPLink: PUBLIC PROC[ep: CARDINAL, gfi: ModuleIndex] RETURNS[BcdLink] = {
RETURN[[procedure[tag: TRUE, ep: ep MOD ProcLimit, gfi: gfi + ep/ProcLimit]]]};
MakeFrameLink: PROC[ep: CARDINAL, gfi: ModuleIndex] 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}
};
EnterId: PROC[id: ConvertUnsafe.SubString, ignoreCase: BOOL]
RETURNS[BcdDefs.NameRecord] = {
i: CARDINAL;
s: ConvertUnsafe.SubString;
i ← 0; s.base ← @nString.string;
UNTIL i = nString.string.length DO
s.offset ← i ← i+1; s.length ← nString.size[i];
IF id.EqualSubStrings[s2: s, case: ~ignoreCase] THEN EXIT;
i ← i + s.length;
REPEAT
FINISHED => {
IF nString.string.length + (id.length+1) > nString.string.maxlength THEN {
t: REF TEXTNEW[TEXT[nString.string.maxlength + MAX[(id.length+1), 512]]];
t ← RefText.Append[t, nStringREFTEXT];
nStringREFTEXT ← t;
nString ← LOOPHOLE[nStringREFTEXT, BcdDefs.NameString];
};
i ← nString.string.length ← nString.string.length + 1;
nString.size[i] ← id.length;
FOR j: CARDINAL IN [0..id.length) DO
nString.string[i+j] ← id.base[id.offset+j]
ENDLOOP;
nString.string.length ← i + 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 t.EqualSubStrings[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: ModuleIndex] = {
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]};
ENDLOOP;
RETURN};
AssignImports: PUBLIC Tree.Scan = {
gfi: ModuleIndex;
saveIndex: SourceMap.Loc = dataPtr.textIndex;
ImportItem: PROC[sei: ISEIndex] = {
node: Tree.Index = seb[sei].idValue;
type: CSEIndex = UnderType[seb[sei].idType];
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];
IF ~dataPtr.interface THEN RelocateImports[t.defCtx, gfi];
gfi ← gfi + (seb[sei].idInfo ← 4*t.nDummyGfi.q + t.nDummyGfi.r)};
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 + BcdDefs.MaxNMi;
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: ModuleIndex;
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
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: REF 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: REF TypeMap = NEW[TypeMap[oldN+delta]];
FOR i: CARDINAL IN [0 .. oldN) DO newMap[i] ← typeMap[i] ENDLOOP;
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.OperandStruct[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: ConvertUnsafe.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;
type: CSEIndex = UnderType[seb[sei].idType];
iTarget: Type = iBase.seb[iSei].idType;
iType: CSEIndex = iBase.UnderType[iTarget];
SELECT mode FROM
$val => {
IF ~Types.Assignable[[iBase, iType], [dataPtr.ownSymbols, type]] THEN {
IF public THEN
Log.ErrorType[exportClash, [symbol[sei]], [iBase, iTarget]];
}
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[type] = $program
THEN MakeFrameLink[ep: EnterEVOffset[0], gfi: ownGfi]
ELSE seb[sei].idValue)}};
$ref => {
iVType: CSEIndex ← iType;
iConst: BOOL ← iBase.seb[iSei].immutable;
WITH t: iBase.seb[iType] SELECT FROM
ref =>
IF t.var THEN {
iVType ← iBase.UnderType[t.refType]; iConst ← t.readOnly};
ENDCASE;
IF ~Types.Equivalent[[iBase, iVType], [dataPtr.ownSymbols, type]] THEN {
IF public THEN
Log.ErrorType[exportClash, [symbol[sei]], [iBase, iTarget]]
}
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[updateClash, sei];
ENDCASE;
link ← MakeFrameLink[
ep: EnterEVOffset[LOOPHOLE[seb[sei].idValue, BitAddress].wd],
gfi: ownGfi]}};
$type =>
IF type # 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 (type # 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: SourceMap.Loc = 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[];
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];
WriteTypeTable[];
typeMap ← NIL;
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] = {
OPEN BcdDefs;
nIds: CARDINAL;
nIds ← TreeOps.ListLength[ids];
IF nIds > 1 AND ~dataPtr.interface THEN {Log.ErrorN[listLong, nIds-1]; nIds ← 1};
lastPorted ← firstPorted;
nStringREFTEXT ← NEW[TEXT[512]];
nString ← LOOPHOLE[nStringREFTEXT, BcdDefs.NameString];
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.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[to: @nString.string, from: dataPtr.source.locator];
bcdOffset ← CompilerUtil.ReadBCDOffset[];
CompilerUtil.AppendBCDWords[bcdHeader, BcdDefs.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 ← indirectMTRecord;
dataPtr.mtRoot.extension ← indirect[links: BcdDefs.LFNull]}
ELSE {
dataPtr.mtRootSize ← BcdDefs.MTRecord.multiple.SIZE;
dataPtr.mtRoot ← multipleMTRecord;
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 = BcdDefs.PageSize;
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, BcdDefs.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[];
nStringREFTEXT ← NIL;
nString ← NIL};
MatchBCD: PUBLIC PROC RETURNS[matched: BOOLFALSE] = {
oldSymbols: SymbolTable.Base ← Copier.MapSymbols[dataPtr.pattern];
IF oldSymbols = NIL THEN Log.WarningRope[fileName, dataPtr.pattern.locator]
ELSE {
matched ← MatchedBodies[
[oldSymbols, RootBti], [dataPtr.ownSymbols, RootBti]
! 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]}};
matching for module replacement (formerly in ReplPack)
IdHandle: TYPE = RECORD [
stb: SymbolTable.Base,
sei: Symbols.ISEIndex];
MatchedNames: PROC[id1, id2: IdHandle] RETURNS[BOOL] = {
OPEN b1: id1.stb, b2: id2.stb;
ss1, ss2: ConvertUnsafe.SubString;
IF id1.sei = ISENull OR id2.sei = ISENull THEN RETURN [FALSE];
ss1 ← b1.SubStringForName[b1.seb[id1.sei].hash];
ss2 ← b2.SubStringForName[b2.seb[id2.sei].hash];
RETURN [ConvertUnsafe.EqualSubStrings[ss1, ss2]]};
MatchMode: PROC[id: IdHandle] RETURNS[Linkage] = {
LinkMode for a virtual defs module
OPEN b: id.stb;
RETURN[IF b.seb[id.sei].idType = typeTYPE AND b.seb[id.sei].public
THEN $type
ELSE IF b.seb[id.sei].constant THEN
SELECT b.XferMode[b.seb[id.sei].idType] FROM
proc, program, signal, error => $val,
ENDCASE => $manifest
ELSE $ref]
};
MatchedAttrs: PROC[idL, idR: IdHandle] RETURNS[BOOL] = {
OPEN bL: idL.stb, bR: idR.stb;
typeL: CSEIndex = bL.UnderType[bL.seb[idL.sei].idType];
mode: Linkage = MatchMode[idL];
matched: BOOL;
IF idR.sei # ISENull THEN {
typeR: CSEIndex = bR.UnderType[bR.seb[idR.sei].idType];
matched ← (SELECT mode FROM
$val =>
Types.Assignable[[idL.stb, typeL], [idR.stb, typeR]]
AND
(bL.seb[idL.sei].idValue = bR.seb[idR.sei].idValue),
$ref =>
Types.Equivalent[[idL.stb, typeL], [idR.stb, typeR]]
AND
(bL.seb[idL.sei].idValue = bR.seb[idR.sei].idValue) -- offsets
AND
(bL.seb[idL.sei].idInfo = bR.seb[idR.sei].idInfo), -- sizes
$type =>
(bR.seb[idR.sei].idType = typeTYPE) AND (bR.seb[idR.sei].public)
AND
Types.Equivalent[
[idL.stb, bL.UnderType[idL.sei]], [idR.stb, bR.UnderType[idR.sei]]],
ENDCASE => TRUE)}
ELSE matched ← (mode = manifest);
IF ~matched THEN SIGNAL Unmatched[$id, idL];
RETURN[matched]};
CTXHandle: TYPE = RECORD [
stb: SymbolTable.Base,
ctx: CTXIndex];
MatchedContexts: PROC[ctxL, ctxR: CTXHandle] RETURNS[BOOL] = {
OPEN bL: ctxL.stb, bR: ctxR.stb;
n: CARDINAL ← 0;
FOR sei: ISEIndex ← bL.FirstCtxSe[ctxL.ctx], bL.NextSe[sei]
UNTIL sei = ISENull OR n > 4 DO
IF bL.seb[sei].hash # nullName THEN {
ss: ConvertUnsafe.SubString ← bL.SubStringForName[bL.seb[sei].hash];
IF ~MatchedAttrs[
[ctxL.stb, sei], [ctxR.stb, bR.SearchContext[bR.FindString[ss], ctxR.ctx]]] THEN
n ← n+1};
ENDLOOP;
RETURN[n = 0]};
RecordHandle: TYPE = RECORD[
stb: SymbolTable.Base,
sei: RecordSEIndex];
MatchedRecords: PROC[recL, recR: RecordHandle] RETURNS[BOOL] = {
OPEN bL: recL.stb, bR: recR.stb;
RETURN[IF recL.sei = RecordSENull OR recR.sei = RecordSENull
THEN recL.sei = recR.sei
ELSE MatchedContexts[
[recL.stb, bL.seb[recL.sei].fieldCtx], [recR.stb, bR.seb[recR.sei].fieldCtx]]]
};
MatchedArgLists: PROC[argL, argR: Types.Handle] RETURNS[BOOL] = {
OPEN bL: argL.stb, bR: argR.stb;
inL, inR, outL, outR: RecordSEIndex;
[inL, outL] ← bL.TransferTypes[argL.sei];
[inR, outR] ← bR.TransferTypes[argR.sei];
RETURN[
MatchedRecords[[argL.stb, inL], [argR.stb, inR]]
AND
MatchedRecords[[argL.stb, outL], [argR.stb, outR]]]
};
BodyHandle: TYPE = RECORD [
stb: SymbolTable.Base,
bti: Symbols.CBTIndex];
MatchAttr: TYPE = {id, strings};
Unmatched: SIGNAL[attr: MatchAttr, id: IdHandle] = CODE;
MatchedBodies: PROC[bodyL, bodyR: BodyHandle] RETURNS[BOOL] = {
OPEN bL: bodyL.stb, bR: bodyR.stb;
matched: BOOLTRUE;
IF ~bL.bb[bodyL.bti].hints.noStrings THEN {
SIGNAL Unmatched[$strings, [bodyL.stb, bL.bb[bodyL.bti].id]];
matched ← FALSE};
IF ~bR.bb[bodyR.bti].hints.noStrings THEN {
IF ~matched THEN SIGNAL Unmatched[$strings, [bodyR.stb, bR.bb[bodyR.bti].id]];
matched ← FALSE};
IF ~(
MatchedNames[
[bodyL.stb, bL.bb[bodyL.bti].id], [bodyR.stb, bR.bb[bodyR.bti].id]]
AND
(bL.bb[bodyL.bti].entryIndex = bR.bb[bodyR.bti].entryIndex)
AND
Types.Assignable[
[bodyL.stb, bL.bb[bodyL.bti].ioType],
[bodyR.stb, bR.bb[bodyR.bti].ioType]]
AND
MatchedArgLists[
[bodyL.stb, bL.bb[bodyL.bti].ioType],
[bodyR.stb, bR.bb[bodyR.bti].ioType]])
THEN {
SIGNAL Unmatched[$id, [bodyL.stb, bL.bb[bodyL.bti].id]];
matched ← FALSE};
IF ~MatchedContexts[
[bodyL.stb, bL.bb[bodyL.bti].localCtx],
[bodyR.stb, bR.bb[bodyR.bti].localCtx]] THEN matched ← FALSE;
RETURN[matched]};
START HERE
{
WordSeq: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
systemUZone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];
evList ← LOOPHOLE[
 systemUZone.NEW[WordSeq[BcdDefs.EVRecord.SIZE+maxEVLength]],
 BcdDefs.EVHandle];
bcdHeader ← systemUZone.NEW[BcdDefs.BCD];
indirectMTRecord ← systemUZone.NEW[BcdDefs.MTRecord.indirect];
multipleMTRecord ← systemUZone.NEW[BcdDefs.MTRecord.multiple];
};
}.