-- file Pass3B.mesa
-- last modified by Satterthwaite, February 17, 1983 5:00 pm
DIRECTORY
Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Words],
ComData: TYPE USING [
importCtx, interface, moduleCtx, objectStamp, outerCtx, table, textIndex, zone],
Copier: TYPE USING [
CreateFileTable, EnterFile, FillModule, SearchFileCtx, UnknownModule],
LiteralOps: TYPE USING [StringIndex, StringValue],
Log: TYPE USING [ErrorHti, ErrorSei, ErrorTree],
OSMiscOps: TYPE USING [MergeStamps, TimeToStamp],
P3: TYPE USING [
mark,
EnterIdList, Exp, MakeIdTable, MakeFrameRecord, MakeRefType,
PopCtx, PushCtx, RAttr, RPop, RType, Shared],
Strings: TYPE USING [String, SubString, SubStringDescriptor],
Symbols: TYPE USING [
Base, SERecord, CTXRecord,
HTIndex, ISEIndex, CSEIndex, CTXIndex, IncludedCTXIndex, MDIndex, CBTIndex,
HTNull, ISENull, CTXNull, RootBti, BTNull, lG, OwnMdi, typeANY,
seType, ctxType, mdType, bodyType],
SymbolOps: TYPE USING [
FillCtxSe, FirstCtxSe, LinkMode, MakeCtxSe, MakeNonCtxSe, NameClash,
NewCtx, NextSe, SearchContext, UnderType],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, NullIndex, treeType],
TreeOps: TYPE USING [GetHash, GetNode, ListLength, ScanList, SearchList, UpdateList];
Pass3B: PROGRAM
IMPORTS
Alloc, Copier, LiteralOps, Log, OSMiscOps, P3, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P3 = {
OPEN TreeOps, SymbolOps, Symbols, P3;
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)
BCDNotify: 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]};
GetSe: PROC [t: Tree.Link] RETURNS [ISEIndex] = {
RETURN [WITH t SELECT FROM
symbol => index,
subtree => GetSe[tb[index].son[1]],
ENDCASE => ERROR]};
ItemLabel: PROC [node: Tree.Index] RETURNS [ISEIndex] = INLINE {
RETURN [GetSe[tb[node].son[1]]]};
MemberId: PROC [hti: HTIndex, list: Tree.Link] RETURNS [found: BOOL←FALSE] = {
TestItem: Tree.Test = {
RETURN [WITH t SELECT FROM
hash => IF index = hti THEN (found ← TRUE) ELSE FALSE,
subtree => TestItem[tb[index].son[1]],
ENDCASE => FALSE]};
SearchList[list, TestItem];
RETURN};
-- module header
HashTest: TYPE = PROC [hti: HTIndex] RETURNS [BOOL];
Header: PUBLIC PROC [node: Tree.Index] = {
TestShared: HashTest = {
RETURN [MemberId[hti, tb[node].son[3]] OR MemberId[hti, tb[node].son[4]]]};
(dataPtr.table).AddNotify[BCDNotify];
Directory[directory: tb[node].son[1], shared: TestShared];
ScanList[tb[node].son[4], Sharing];
PushCtx[dataPtr.outerCtx]; PushCtx[dataPtr.moduleCtx];
Interfaces[imports: tb[node].son[2], exports: tb[node].son[3]];
PopCtx[]; PopCtx[];
(dataPtr.table).DropNotify[BCDNotify]};
-- directory processing
Directory: PROC [directory: Tree.Link, shared: HashTest] = {
nIdLists: CARDINAL;
mdb[OwnMdi].moduleId ← seb[bb[RootBti].id].hash;
nIdLists ← DirectoryScan[directory];
MakeIdTable[nIdLists];
DirectoryDecls[directory, shared]};
MdiMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF MDIndex];
mdiMap: LONG POINTER TO MdiMap;
DirectoryScan: PROC [t: Tree.Link] RETURNS [nLists: CARDINAL ← 0] = {
i: CARDINAL ← 0;
FileEntry: Tree.Scan = {
ss: Strings.SubStringDescriptor;
s: Strings.SubString = @ss;
node: Tree.Index = GetNode[t];
formalId: HTIndex = seb[ItemLabel[node]].hash;
typeId: HTIndex = WITH tb[node].son[2] SELECT FROM
hash => index,
ENDCASE => formalId;
mdiMap[i] ← Copier.EnterFile[formalId, typeId, TreeStringValue[tb[node].son[2]]];
i ← i + 1;
IF tb[node].son[3] # Tree.Null THEN nLists ← nLists+1};
n: CARDINAL = ListLength[t];
Copier.CreateFileTable[n];
mdiMap ← (dataPtr.zone).NEW[MdiMap[n]];
ScanList[t, FileEntry];
RETURN};
TreeStringValue: PROC [t: Tree.Link] RETURNS [Strings.String] = {
RETURN [WITH t SELECT FROM
s: Tree.Link.literal => LiteralOps.StringValue[LiteralOps.StringIndex[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: HTIndex = WITH tb[node].son[2] SELECT FROM
hash => index,
ENDCASE => seb[sei].hash;
type: CSEIndex;
ctx: CTXIndex;
bti: CBTIndex;
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
tb[node].attr2 ← tb[node].attr3 ← P3.mark;
Copier.FillModule[sei, key, mdiMap[i]
! Copier.UnknownModule => {Log.ErrorHti[moduleId, hti]; RESUME}];
type ← UnderType[seb[sei].idType];
ctx ← WITH t: seb[type] SELECT FROM
definition => t.defCtx,
transfer => IF (bti←seb[sei].idInfo) # BTNull THEN bb[bti].localCtx ELSE CTXNull,
ENDCASE => CTXNull;
IF ctx # CTXNull THEN {
WITH c: ctxb[ctx] SELECT FROM
included => {
dataPtr.objectStamp ← OSMiscOps.MergeStamps[
dataPtr.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]]};
i ← i + 1;
dataPtr.textIndex ← saveIndex};
ScanList[directory, DirectoryItem];
(dataPtr.zone).FREE[@mdiMap]};
IncludedIds: PROC [ctx: CTXIndex, list: Tree.Link] RETURNS [val: Tree.Link] = {
includedCtx: IncludedCTXIndex;
IncludedId: Tree.Map = {
WITH t SELECT FROM
hash => {
hti: HTIndex = index;
sei: ISEIndex;
found, duplicate, update: BOOL;
CheckDuplicate: Tree.Test = {
RETURN [WITH t SELECT FROM
symbol => IF index = sei THEN (duplicate ← TRUE) ELSE FALSE,
ENDCASE => TRUE]};
sei ← SearchContext[hti, ctx];
IF sei = ISENull THEN {
[found, sei] ← Copier.SearchFileCtx[hti, includedCtx]; update ← found}
ELSE {
found ← TRUE; update ← LinkMode[sei] = manifest;
duplicate ← FALSE; SearchList[list, CheckDuplicate];
IF duplicate THEN Log.ErrorHti[duplicateId, hti]};
IF found THEN {
IF ~seb[sei].public AND ~Shared[includedCtx] THEN {
Log.ErrorHti[noAccess, hti]; seb[sei].public ← TRUE};
IF update THEN seb[sei].idCtx ← CTXNull;
v ← [symbol[index: sei]]}
ELSE {Log.ErrorHti[unknownId, hti]; v ← t}};
ENDCASE => ERROR;
RETURN};
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;
RETURN};
Sharing: Tree.Scan = {
hti: HTIndex = GetHash[t];
sei: ISEIndex = SearchContext[hti, dataPtr.moduleCtx];
IF sei = ISENull THEN Log.ErrorHti[unknownId, hti]
ELSE {
type: CSEIndex = UnderType[seb[sei].idType];
ctx: CTXIndex ← CTXNull;
WITH seb[type] SELECT FROM
definition => ctx ← defCtx;
transfer =>
IF seb[sei].mark4 AND seb[sei].constant AND mode = program THEN
ctx ← bb[LOOPHOLE[seb[sei].idInfo, CBTIndex]].localCtx;
ENDCASE;
IF ctx = CTXNull AND type # typeANY THEN Log.ErrorHti[typeClash, hti]}};
ImportType: PROC [mdi: MDIndex] RETURNS [CSEIndex] = {
sei: ISEIndex;
type: CSEIndex;
FOR sei ← FirstCtxSe[dataPtr.moduleCtx], NextSe[sei] UNTIL sei = ISENull DO
type ← UnderType[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 ← MakeCtxSe[mdb[mdi].moduleId, CTXNull];
Copier.FillModule[sei, seb[sei].hash, mdi]};
ENDLOOP;
RETURN [UnderType[seb[sei].idType]]};
-- import/export processing
Interfaces: PROC [imports, exports: Tree.Link] = INLINE {
ScanList[imports, ImportItem];
ScanList[exports, ExportItem]};
ImportItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
sei: ISEIndex = ItemLabel[node];
type, vType: CSEIndex;
const: BOOL;
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
tb[node].attr2 ← tb[node].attr3 ← P3.mark;
tb[node].son[2] ← Exp[tb[node].son[2], typeANY];
vType ← RType[]; const ← RAttr[].const; RPop[];
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 dataPtr.interface THEN Log.ErrorSei[nonDefinition, sei]};
ENDCASE => {type ← typeANY; Log.ErrorTree[notPortable, tb[node].son[2]]};
transfer => {
IF v.mode # program OR dataPtr.interface THEN
Log.ErrorTree[notPortable, tb[node].son[2]];
seb[sei].immutable ← TRUE;
type ← MakeRefType[MakeFrameRecord[tb[node].son[2]], typeANY];
const ← FALSE};
ENDCASE => {
IF vType # typeANY THEN Log.ErrorTree[typeClash, tb[node].son[2]];
type ← typeANY};
seb[sei].idType ← type;
seb[sei].immutable ← TRUE; seb[sei].constant ← const; seb[sei].idInfo ← 1;
seb[sei].mark3 ← TRUE;
dataPtr.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 ← MakeNonCtxSe[SERecord.cons.definition.SIZE];
seb[type] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[definition[
nGfi: t.nGfi, named: named, defCtx: ctx]]];
IF ~named THEN mdb[c.module].defaultImport ← ctx};
ENDCASE => ERROR;
ENDCASE => type ← typeANY;
RETURN};
NewImportedCtx: PROC [link: IncludedCTXIndex] RETURNS [ctx: CTXIndex] = {
ctx ← (dataPtr.table).Words[ctxType, CTXRecord.imported.SIZE];
ctxb[ctx] ← CTXRecord[
rePainted: FALSE, varUpdated: FALSE,
seList: ISENull,
level: ctxb[link].level,
extension: imported[includeLink: link]];
RETURN};
ExportItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
type: CSEIndex;
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
tb[node].son[2] ← Exp[tb[node].son[2], typeANY]; type ← RType[]; RPop[];
WITH d: seb[type] SELECT FROM
definition => {
WITH ctxb[d.defCtx] SELECT FROM
included => mdb[module].exported ← TRUE;
ENDCASE => Log.ErrorTree[notPortable, tb[node].son[2]]};
ENDCASE => IF type # typeANY THEN Log.ErrorTree[typeClash, tb[node].son[2]];
dataPtr.textIndex ← saveIndex};
SetDefaultImport: PUBLIC PROC [iCtx: IncludedCTXIndex, implicitOK: BOOL] = {
mdi: MDIndex;
(dataPtr.table).AddNotify[BCDNotify];
mdi ← ctxb[iCtx].module;
IF mdb[mdi].defaultImport = CTXNull THEN {
sei: ISEIndex;
type: CSEIndex;
n: CARDINAL ← 0;
IF dataPtr.importCtx = CTXNull THEN dataPtr.importCtx ← NewCtx[lG];
FOR sei ← FirstCtxSe[dataPtr.importCtx], NextSe[sei] UNTIL sei = ISENull DO
type ← UnderType[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 Log.ErrorHti[missingImport, mdb[mdi].moduleId];
sei ← MakeCtxSe[HTNull, dataPtr.importCtx];
FillCtxSe[sei, mdb[mdi].moduleId, FALSE
! NameClash => {Log.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 ← 1; seb[sei].idValue ← Tree.NullIndex;
seb[sei].mark3 ← TRUE; seb[sei].mark4 ← FALSE};
1 => NULL;
ENDCASE => Log.ErrorHti[missingImport, mdb[mdi].moduleId];
IF mdb[mdi].defaultImport = CTXNull THEN mdb[mdi].defaultImport ← NewImportedCtx[iCtx]};
(dataPtr.table).DropNotify[BCDNotify]};
}.