Pass3B.mesa
Copyright Ó 1985, 1986, 1987, 1990, 1991 by Xerox Corporation. All rights reserved.
Satterthwaite, June 18, 1986 12:21:16 pm PDT
Russ Atkinson (RRA) January 23, 1990 1:13:26 pm PST
DIRECTORY
Alloc USING [Units],
CompilerUtil USING [],
ConvertUnsafe USING [SubString, ToRope],
LiteralOps USING [StringValue],
MimData USING [base, importCtx, interface, moduleCtx, monitored, objectStamp, outerCtx, stopping, switches, table, textIndex, worstAlignment],
MimosaCopier USING [CopierInit, CopierReset, CreateFileTable, EnterFile, FileProblem, FileVersion, FileVersionMix, FillModule, SearchFileCtx, TableRelocated, UnknownModule],
MimosaEvents USING [Callback, RegisterSet],
MimosaLog USING [ErrorHti, ErrorSei, ErrorTree, WarningTree],
MimP3 USING [BodyList, DeclList, DeclNotify, EnterIdList, Exp, ExpANotify, ExpCNotify, IdInit, IdReset, MakeFrameRecord, MakeIdTable, MakeRefType, mark, MiscNotify, PopCtx, PushCtx, RAttrPop, RPop, Shared, StmtNotify, UType, VRNotify],
MimP3S USING [safety],
MimZones USING [permZone],
OSMiscOps USING [MergeStamps, Stamp, TimeToStamp],
Pass3Attributes USING [TypeNotify],
Rope USING [ROPE],
SourceMap USING [Loc],
SymbolOps USING [DecodeBti, EncodeCard, EncodeTreeIndex, FillCtxSe, FirstCtxSe, LinkMode, MakeCtxSe, MakeNonCtxSe, NameClash, NewCtx, NextSe, own, SearchContext, SubStringForName, UnderType],
Symbols USING [Base, bodyType, BTNull, CBTIndex, CSEIndex, CSENull, CTXIndex, CTXNull, CTXRecord, ctxType, IncludedCTXIndex, ISEIndex, ISENull, lG, MDIndex, mdType, Name, nullName, OwnMdi, RootBti, SERecord, seType, typeANY],
SymLiteralOps USING [Reset],
Target: TYPE MachineParms USING [bitsPerPtr],
Tree USING [Base, Index, Link, Map, Scan, Test, Null, nullIndex, treeType],
TreeOps USING [GetHash, GetNode, GetTag, ListLength, ScanList, SearchList, ToLoc, UpdateList];
Pass3B: PROGRAM
IMPORTS Alloc, ConvertUnsafe, LiteralOps, MimData, MimosaCopier, MimosaEvents, MimosaLog, MimP3, MimP3S, MimZones, OSMiscOps, Pass3Attributes, SymbolOps, SymLiteralOps, TreeOps
EXPORTS CompilerUtil, MimP3 = {
OPEN MimP3, TreeOps, 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; -- module table base address (local copy)
bb: Symbols.Base; -- body table base address (local copy)
Pass3Notify: MimosaEvents.Callback = {
called by allocator whenever table area is repacked
SELECT class FROM
relocate => {
tb ¬ MimData.base[Tree.treeType];
seb ¬ MimData.base[seType];
ctxb ¬ MimData.base[ctxType];
mdb ¬ MimData.base[mdType];
bb ¬ MimData.base[bodyType];
Pass3Attributes.TypeNotify[MimData.base];
MimP3.DeclNotify[MimData.base];
MimP3.MiscNotify[MimData.base];
MimP3.StmtNotify[MimData.base];
MimP3.VRNotify[MimData.base];
MimP3.ExpANotify[MimData.base];
MimP3.ExpCNotify[MimData.base];
};
ENDCASE;
};
Stuff formerly in Pass3
lockNode: PUBLIC Tree.Index;  -- lambda expr for monitor lock
checkedANY: PUBLIC Symbols.CSEIndex; -- typeANY in CHECKED code
P3Unit: PUBLIC PROC [unit: Tree.Link] RETURNS [Tree.Link] = {
Exported to CompilerUtil
node: Tree.Index;
saveIndex: SourceMap.Loc = MimData.textIndex;
checkedANY ¬ Symbols.CSENull;
MimP3S.safety ¬ none;
node ¬ TreeOps.GetNode[unit];
MimData.textIndex ¬ TreeOps.ToLoc[tb[node].info];
MimosaCopier.CopierInit[ownTable: MimData.table, symbolCachePages: 256];
MimP3.IdInit[];
{
ENABLE {
MimosaCopier.FileProblem => {MimosaLog.ErrorHti[fileName, hti]; RESUME [TRUE]};
MimosaCopier.FileVersion => {MimosaLog.ErrorHti[fileWrong, hti]; RESUME [TRUE]};
MimosaCopier.FileVersionMix => {
MimosaLog.WarningTree[fileVersion, [hash[index: hti]]]; RESUME};
MimosaCopier.TableRelocated => {RESUME}};
MimData.stopping ¬ FALSE;
{
formerly the Header procedure
TestShared: HashTest = {
RETURN [MemberId[id, tb[node].son[3]] OR MemberId[id, tb[node].son[4]]];
};
Directory[directory: tb[node].son[1], shared: TestShared];
ScanList[tb[node].son[4], Sharing];
PushCtx[MimData.outerCtx];
PushCtx[MimData.moduleCtx];
ScanList[tb[node].son[2], ImportItem];
Process the IMPORTS clause
ScanList[tb[node].son[3], ExportItem];
Process the EXPORTS clause
PopCtx[];
PopCtx[];
};
MimP3.PushCtx[MimData.outerCtx];
MimP3.PushCtx[MimData.moduleCtx];
MimP3.PushCtx[MimData.importCtx];
lockNode ¬ IF ~MimData.monitored THEN Tree.nullIndex ELSE GetNode[tb[node].son[5]];
MimP3.DeclList[tb[node].son[6]];
MimP3.BodyList[Symbols.RootBti];
MimP3.PopCtx[]; -- import context
MimP3.PopCtx[]; MimP3.PopCtx[];
MimP3.IdReset[tb[node].son[1]];
};
MimosaCopier.CopierReset[];
SymLiteralOps.Reset[pad: ~MimData.switches['s]];
MimData.textIndex ¬ saveIndex;
RETURN [unit];
};
Some utilities
ItemLabel: PROC [node: Tree.Index] RETURNS [ISEIndex] = INLINE {
t: Tree.Link ¬ tb[node].son[1];
DO
WITH t SELECT GetTag[t] FROM
symbol => RETURN [index];
subtree => t ¬ tb[index].son[1];
ENDCASE => ERROR;
ENDLOOP;
};
MemberId: PROC [id: Name, list: Tree.Link] RETURNS [found: BOOL¬FALSE] = {
TestItem: Tree.Test = {
DO
WITH t SELECT GetTag[t] FROM
hash => IF index = id THEN RETURN [found ¬ TRUE];
subtree => IF t # Tree.Null THEN {t ¬ tb[index].son[1]; LOOP};
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};
SearchList[list, TestItem];
};
module header
HashTest: TYPE = PROC [id: Name] RETURNS [BOOL];
directory processing
Directory: PROC [directory: Tree.Link, shared: HashTest] = {
bytesPerStamp: NAT = BITS[OSMiscOps.Stamp] / BITS[CHAR];
id: Name ¬ seb[bb[RootBti].id].hash;
ss: ConvertUnsafe.SubString ¬ SymbolOps.SubStringForName[SymbolOps.own, id];
accumPos: [0..bytesPerStamp) ¬ 0;
Workaround for Mimosa bug:
Long: PROC [p: LONG POINTER] RETURNS [LONG POINTER] = {RETURN[p]};
stampAccum: PACKED ARRAY [0..bytesPerStamp) OF CHAR ¬ ALL[0C];
lp: LONG POINTER TO OSMiscOps.Stamp ¬ LOOPHOLE[Long[@stampAccum]];
FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO
stampAccum[accumPos] ¬ ss.base[i];
IF accumPos = bytesPerStamp-1
THEN {
Make the version stamp depend on the module name
MimData.objectStamp ¬ OSMiscOps.MergeStamps[MimData.objectStamp, lp­];
accumPos ¬ 0}
ELSE accumPos ¬ accumPos + 1;
ENDLOOP;
IF accumPos # 0 THEN
Residual characters to consider
MimData.objectStamp ¬ OSMiscOps.MergeStamps[MimData.objectStamp, lp­];
mdb[OwnMdi].moduleId ¬ id;
MakeIdTable[DirectoryScan[directory]];
DirectoryDecls[directory, shared];
};
MdiMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF MDIndex];
mdiMap: REF MdiMap;
DirectoryScan: PROC [t: Tree.Link] RETURNS [nLists: CARDINAL ¬ 0] = {
i: CARDINAL ¬ 0;
FileEntry: Tree.Scan = {
node: Tree.Index = GetNode[t];
formalId: Name = seb[ItemLabel[node]].hash;
typeId: Name = WITH tb[node].son[2] SELECT GetTag[tb[node].son[2]] FROM
hash => index,
ENDCASE => formalId;
mdiMap[i] ¬ MimosaCopier.EnterFile[formalId, typeId, TreeStringValue[tb[node].son[2]]
! MimosaCopier.FileVersionMix => {IF hti = typeId THEN RESUME ELSE REJECT}];
i ¬ i + 1;
IF tb[node].son[3] # Tree.Null THEN nLists ¬ nLists+1;
};
n: CARDINAL = ListLength[t];
MimosaCopier.CreateFileTable[n];
MimZones.permZone.FREE[@mdiMap]; -- (just in case of a previous UNWIND)
mdiMap ¬ MimZones.permZone.NEW[MdiMap[n]];
ScanList[t, FileEntry];
};
TreeStringValue: PROC [t: Tree.Link] RETURNS [Rope.ROPE] = {
RETURN [WITH s: t SELECT GetTag[t] FROM
string => ConvertUnsafe.ToRope[LiteralOps.StringValue[s.index]],
ENDCASE => NIL]
};
DirectoryDecls: PROC [directory: Tree.Link, shared: HashTest] = {
i: CARDINAL ¬ 0;
DirectoryItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
sei: ISEIndex = ItemLabel[node];
key: Name = WITH tb[node].son[2] SELECT GetTag[tb[node].son[2]] FROM
hash => index,
ENDCASE => seb[sei].hash;
type: CSEIndex;
ctx: CTXIndex;
bti: CBTIndex;
saveIndex: SourceMap.Loc = MimData.textIndex;
MimData.textIndex ¬ ToLoc[tb[node].info];
tb[node].attr2 ¬ tb[node].attr3 ¬ MimP3.mark;
MimosaCopier.FillModule[sei, key, mdiMap[i]
! MimosaCopier.UnknownModule => {MimosaLog.ErrorHti[moduleId, hti]; RESUME}];
type ¬ SymbolOps.UnderType[SymbolOps.own, seb[sei].idType];
ctx ¬ WITH t: seb[type] SELECT FROM
definition => t.defCtx,
transfer => IF (bti¬SymbolOps.DecodeBti[seb[sei].idInfo]) # BTNull THEN
bb[bti].localCtx ELSE CTXNull,
ENDCASE => CTXNull;
IF ctx # CTXNull THEN {
WITH c: ctxb[ctx] SELECT FROM
included => {
MimData.objectStamp ¬ OSMiscOps.MergeStamps[
MimData.objectStamp, OSMiscOps.TimeToStamp[mdb[c.module].stamp]];
mdb[c.module].shared ¬ shared[seb[sei].hash]};
ENDCASE;
tb[node].son[3] ¬ IncludedIds[ctx, tb[node].son[3]
! MimosaCopier.FileVersionMix => {IF hti=key THEN RESUME ELSE REJECT}]
};
i ¬ i + 1;
MimData.textIndex ¬ saveIndex;
};
ScanList[directory, DirectoryItem];
MimZones.permZone.FREE[@mdiMap];
};
IncludedIds: PROC [ctx: CTXIndex, list: Tree.Link] RETURNS [val: Tree.Link] = {
includedCtx: IncludedCTXIndex;
IncludedId: Tree.Map = {
WITH t SELECT GetTag[t] FROM
hash => {
id: Name = index;
found, update: BOOL;
sei: ISEIndex ¬ SymbolOps.SearchContext[SymbolOps.own, id, ctx];
IF sei = ISENull
THEN {
[found, sei] ¬ MimosaCopier.SearchFileCtx[id, includedCtx];
update ¬ found;
}
ELSE {
CheckDuplicate: Tree.Test = {
RETURN[WITH t SELECT GetTag[t] FROM
symbol => IF index = sei THEN (duplicate ¬ TRUE) ELSE FALSE,
ENDCASE => TRUE];
};
duplicate: BOOL ¬ FALSE;
found ¬ TRUE;
update ¬ SymbolOps.LinkMode[SymbolOps.own, sei] = manifest;
duplicate ¬ FALSE;
SearchList[list, CheckDuplicate];
IF duplicate THEN MimosaLog.ErrorHti[duplicateId, id];
};
IF found
THEN {
IF ~seb[sei].public AND ~Shared[includedCtx] THEN {
MimosaLog.ErrorSei[privateId, sei];
seb[sei].public ¬ TRUE;
};
IF update THEN seb[sei].idCtx ¬ CTXNull;
v ¬ [symbol[index: sei]];
}
ELSE {MimosaLog.ErrorHti[unknownId, id]; v ¬ t};
};
ENDCASE => ERROR;
};
WITH c: ctxb[ctx] SELECT FROM
included =>
IF list # Tree.Null
THEN {
includedCtx ¬ LOOPHOLE[ctx];
c.restricted ¬ TRUE;
val ¬ UpdateList[list, IncludedId];
EnterIdList[includedCtx, val];
}
ELSE val ¬ Tree.Null;
ENDCASE => ERROR;
};
Sharing: Tree.Scan = {
id: Name = GetHash[t];
sei: ISEIndex = SymbolOps.SearchContext[SymbolOps.own, id, MimData.moduleCtx];
IF sei = ISENull
THEN MimosaLog.ErrorHti[unknownId, id]
ELSE {
type: CSEIndex = SymbolOps.UnderType[SymbolOps.own, seb[sei].idType];
ctx: CTXIndex ¬ CTXNull;
WITH t: seb[type] SELECT FROM
definition => ctx ¬ t.defCtx;
transfer =>
IF seb[sei].mark4 AND seb[sei].constant AND t.mode = program THEN
ctx ¬ bb[SymbolOps.DecodeBti[seb[sei].idInfo]].localCtx;
ENDCASE;
IF ctx = CTXNull AND type # typeANY THEN MimosaLog.ErrorTree[nonInterface, t];
};
};
ImportType: PROC [mdi: MDIndex] RETURNS[CSEIndex] = {
sei: ISEIndex;
FOR sei ¬ SymbolOps.FirstCtxSe[SymbolOps.own, MimData.moduleCtx], SymbolOps.NextSe[SymbolOps.own, sei]
UNTIL sei = ISENull DO
type: CSEIndex ¬ SymbolOps.UnderType[SymbolOps.own, seb[sei].idType];
WITH t: seb[type] SELECT FROM
definition =>
WITH c: ctxb[t.defCtx] SELECT FROM
imported => IF ctxb[c.includeLink].module = mdi THEN GO TO Found;
ENDCASE;
ENDCASE;
REPEAT
Found => NULL;
FINISHED => {
sei ¬ SymbolOps.MakeCtxSe[mdb[mdi].moduleId, CTXNull];
MimosaCopier.FillModule[sei, seb[sei].hash, mdi];
};
ENDLOOP;
RETURN[SymbolOps.UnderType[SymbolOps.own, seb[sei].idType]];
};
import/export processing
ImportItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
sei: ISEIndex = ItemLabel[node];
type, vType: CSEIndex;
const: BOOL;
saveIndex: SourceMap.Loc = MimData.textIndex;
son2: Tree.Link ¬ tb[node].son[2];
MimData.textIndex ¬ ToLoc[tb[node].info];
tb[node].attr2 ¬ tb[node].attr3 ¬ MimP3.mark;
son2 ¬ tb[node].son[2] ¬ Exp[son2, typeANY];
vType ¬ UType[];
const ¬ RAttrPop[].const;
WITH v: seb[vType] SELECT FROM
definition =>
SELECT ctxb[v.defCtx].ctxType FROM
included => {
type ¬ ImportInstance[iType: vType, named: tb[node].attr1];
IF tb[node].attr1 AND MimData.interface THEN
MimosaLog.ErrorSei[nonDefinition, sei];
};
ENDCASE => {type ¬ typeANY; MimosaLog.ErrorTree[notImExPortable, son2]};
transfer => {
IF v.mode # program OR MimData.interface THEN
MimosaLog.ErrorTree[notImExPortable, tb[node].son[2]];
seb[sei].immutable ¬ TRUE;
type ¬ MakeRefType[MakeFrameRecord[son2], typeANY, Target.bitsPerPtr];
const ¬ FALSE;
};
ENDCASE => {
IF vType # typeANY THEN MimosaLog.ErrorTree[nonInterface, son2];
type ¬ typeANY;
};
seb[sei].idType ¬ type;
seb[sei].immutable ¬ TRUE;
seb[sei].constant ¬ const;
seb[sei].idInfo ¬ SymbolOps.EncodeCard[1];
seb[sei].mark3 ¬ TRUE;
MimData.textIndex ¬ saveIndex;
};
ImportInstance: PROC [iType: CSEIndex, named: BOOL] RETURNS [type: CSEIndex] = {
WITH t: seb[iType] SELECT FROM
definition =>
WITH c: ctxb[t.defCtx] SELECT FROM
included => {
ctx: CTXIndex = NewImportedCtx[LOOPHOLE[t.defCtx]];
type ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.definition.SIZE];
seb[type] ¬ SERecord[mark3: TRUE, mark4: TRUE, body: cons[
align: MimData.worstAlignment,
typeInfo: definition[slots: t.slots, named: named, defCtx: ctx]]];
IF ~named THEN mdb[c.module].defaultImport ¬ ctx;
};
ENDCASE => ERROR;
ENDCASE => type ¬ typeANY;
};
NewImportedCtx: PROC [link: IncludedCTXIndex] RETURNS [ctx: CTXIndex] = {
ctx ¬ (MimData.table).Units[ctxType, CTXRecord.imported.SIZE];
ctxb[ctx] ¬ CTXRecord[
level: ctxb[link].level,
seList: ISENull, varUpdated: FALSE,
extension: imported[includeLink: link]];
};
ExportItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
type: CSEIndex;
saveIndex: SourceMap.Loc = MimData.textIndex;
son2: Tree.Link ¬ tb[node].son[2];
MimData.textIndex ¬ ToLoc[tb[node].info];
son2 ¬ tb[node].son[2] ¬ Exp[son2, typeANY];
type ¬ UType[];
RPop[];
WITH d: seb[type] SELECT FROM
definition =>
WITH c: ctxb[d.defCtx] SELECT FROM
included => mdb[c.module].exported ¬ TRUE;
ENDCASE => MimosaLog.ErrorTree[notImExPortable, son2];
ENDCASE => IF type # typeANY THEN MimosaLog.ErrorTree[nonInterface, son2];
MimData.textIndex ¬ saveIndex;
};
SetDefaultImport: PUBLIC PROC [iCtx: IncludedCTXIndex, implicitOK: BOOL] = {
mdi: MDIndex ¬ ctxb[iCtx].module;
IF mdb[mdi].defaultImport = CTXNull THEN {
sei: ISEIndex;
type: CSEIndex;
n: CARDINAL ¬ 0;
IF MimData.importCtx = CTXNull THEN MimData.importCtx ¬ SymbolOps.NewCtx[lG];
FOR sei ¬ SymbolOps.FirstCtxSe[SymbolOps.own, MimData.importCtx], SymbolOps.NextSe[SymbolOps.own, sei]
UNTIL sei = ISENull DO
type ¬ SymbolOps.UnderType[SymbolOps.own, seb[sei].idType];
WITH t: seb[type] SELECT FROM
definition =>
WITH c: ctxb[t.defCtx] SELECT FROM
imported =>
IF ctxb[c.includeLink].module = mdi THEN {
mdb[mdi].defaultImport ¬ t.defCtx;
n ¬ n+1;
};
ENDCASE;
ENDCASE;
ENDLOOP;
SELECT n FROM
0 => {
IF ~implicitOK THEN MimosaLog.ErrorHti[missingImport, mdb[mdi].moduleId];
sei ¬ SymbolOps.MakeCtxSe[nullName, MimData.importCtx];
SymbolOps.FillCtxSe[sei, mdb[mdi].moduleId, FALSE
! SymbolOps.NameClash => {MimosaLog.ErrorHti[missingImport, name]; RESUME}];
seb[sei].immutable ¬ seb[sei].constant ¬ TRUE;
seb[sei].linkSpace ¬ seb[sei].extended ¬ FALSE;
seb[sei].idType ¬ ImportInstance[iType: ImportType[mdi], named: FALSE];
seb[sei].idInfo ¬ SymbolOps.EncodeCard[1];
seb[sei].idValue ¬ SymbolOps.EncodeTreeIndex[Tree.nullIndex];
seb[sei].mark3 ¬ TRUE;
seb[sei].mark4 ¬ FALSE;
};
1 => {};
ENDCASE => MimosaLog.ErrorHti[missingImport, mdb[mdi].moduleId];
IF mdb[mdi].defaultImport = CTXNull THEN
mdb[mdi].defaultImport ¬ NewImportedCtx[iCtx];
};
};
MimosaEvents.RegisterSet[Pass3Notify, ALL[TRUE]];
}.