DIRECTORY
Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Words],
ComData:
TYPE
USING [
importCtx, interface, moduleCtx, objectStamp, outerCtx, table, textIndex, zone],
ConvertUnsafe: TYPE USING [ToRope],
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],
Rope: TYPE USING [ROPE],
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, ConvertUnsafe, 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 = {
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 [Rope.
ROPE] = {
RETURN [
WITH t
SELECT
FROM
s: Tree.Link.literal => ConvertUnsafe.ToRope[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]};
}.