-- file Pass3I.mesa
-- last modified by Satterthwaite, March 24, 1983 1:02 pm
-- last modified by Donahue, 8-Dec-81 15:29:30
DIRECTORY
A3: TYPE USING [
LongPath, MarkedType, OperandType, PermanentType, TypeForTree, VarType],
Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
ComData: TYPE USING [
interface, moduleCtx, seAnon, switches, table, textIndex, typeAtomRecord],
Copier: TYPE USING [CompleteContext, Delink, SearchFileCtx],
Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree, WarningSei],
P3: TYPE USING [
Attr, fullAttr, voidAttr, mark, MergeNP, phraseNP,
And, Exp, FirstId, InterfaceCtx, MakeRefType, ResolveType, ResolveValue,
RPop, RPush, RType, SetDefaultImport, VariantUnionType, VoidExp],
P3S: TYPE USING [currentBody, currentScope, safety],
Symbols: TYPE USING [
seType, ctxType, mdType,
Base, CTXRecord, ExtensionType,
MDIndex, Name, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
CTXIndex, IncludedCTXIndex, Closure,
nullName, nullType, ISENull, RecordSENull, CTXNull, IncludedCTXNull,
lG, lZ, StandardContext, typeTYPE, typeANY],
SymbolOps: TYPE USING [
ArgCtx, ConstantId, EnterExtension, FindExtension, FirstCtxSe, LinkMode,
NextSe, NormalType, RCType, RecordRoot, ReferentType, SearchContext, SetSeLink,
TypeForm, TypeLink, TypeRoot, UnderType],
SymLiteralOps: TYPE USING [EnterAtom, EnterType],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, NullIndex, treeType],
TreeOps: TYPE USING [
CopyTree, FreeTree, GetHash, GetNode, GetSe, ListLength, MarkShared,
NthSon, OpName, PopTree, PushTree, PushNode, ScanList, ScanSons, SearchList,
SetAttr, SetInfo, UpdateList, UpdateLeaves];
Pass3I: PROGRAM
IMPORTS
A3, Alloc, Copier, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P3 = {
OPEN SymbolOps, A3, P3, Symbols, TreeOps;
-- uninitialized variable processing
RefItem: TYPE = RECORD [kind: {seal, rhs, lhs}, sei: ISEIndex];
RefSeal: RefItem = [kind:seal, sei:ISENull];
RefSequence: TYPE = RECORD [SEQUENCE length: CARDINAL OF RefItem];
RefStack: TYPE = LONG POINTER TO RefSequence;
refStack: RefStack;
refIndex: CARDINAL;
AdjustRefStack: PROC [n: CARDINAL] = {
oldStack: RefStack ← refStack;
refStack ← zone.NEW[RefSequence[n]];
FOR i: CARDINAL IN [0..refIndex) DO refStack[i] ← oldStack[i] ENDLOOP;
zone.FREE[@oldStack]};
RecordMention: PUBLIC PROC [sei: ISEIndex] = {
IF dataPtr.switches['u] AND (seb[sei].idInfo = 0 AND ~seb[sei].mark4) THEN {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← [kind:rhs, sei:sei];
refIndex ← refIndex + 1}
ELSE BumpCount[sei]};
RecordLhs: PUBLIC PROC [sei: ISEIndex] = {
key: RefItem;
IF dataPtr.switches['u] AND (seb[sei].idInfo = 0 AND ~seb[sei].mark4) THEN {
key ← [kind:rhs, sei:sei];
FOR i: CARDINAL DECREASING IN [0..refIndex) DO
SELECT refStack[i] FROM
key => {refStack[i].kind ← lhs; EXIT};
RefSeal => EXIT;
ENDCASE;
ENDLOOP}};
SealRefStack: PUBLIC PROC = {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← RefSeal; refIndex ← refIndex + 1};
UnsealRefStack: PUBLIC PROC = {
ClearRefStack[]; refIndex ← refIndex - 1;
IF refStack[refIndex] # RefSeal THEN ERROR};
ClearRefStack: PUBLIC PROC = {
sei: ISEIndex;
FOR i: CARDINAL DECREASING IN [0..refIndex) UNTIL refStack[i] = RefSeal DO
sei ← refStack[i].sei;
IF refStack[i].kind = rhs
AND ~ConstantInit[sei]
AND (~dataPtr.interface OR ctxb[seb[sei].idCtx].level # lG) THEN
Log.WarningSei[uninitialized, sei];
BumpCount[sei];
refIndex ← refIndex - 1;
ENDLOOP;
IF refStack.length > 16 AND refIndex <= 16 THEN AdjustRefStack[16]};
ConstantInit: PROC [sei: ISEIndex] RETURNS [BOOL] = {
node: Tree.Index;
IF seb[sei].constant THEN RETURN [TRUE];
node ← seb[sei].idValue;
RETURN [seb[sei].immutable
AND node # Tree.NullIndex AND OpName[tb[node].son[3]] = body]};
-- tables defining the current symbol table
tb: Tree.Base; -- tree base
seb: Symbols.Base; -- se table
ctxb: Symbols.Base; -- context table
mdb: Symbols.Base; -- module directory base
IdNotify: Alloc.Notifier = {
-- called whenever the main symbol table is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]};
zone: UNCOUNTED ZONE ← NIL;
-- type table management
EnterType: PUBLIC PROC [type: Type, canonical: BOOL←TRUE] = {
SymLiteralOps.EnterType[type, canonical];
CompleteRCType[type]};
CompleteRCType: PROC [type: Type] = {
subType: CSEIndex = UnderType[TypeRoot[type]];
IF RCType[subType] # none THEN {
WITH t: seb[subType] SELECT FROM
record => CompleteRecord[LOOPHOLE[subType], rc];
array => CompleteRCType[t.componentType];
union, sequence => Log.Error[unimplemented];
ENDCASE => NULL}};
EnterComposite: PUBLIC PROC [type: Type, t: Tree.Link, init: BOOL] = {
csei: CSEIndex = UnderType[type];
SELECT OpName[t] FROM
loophole, cast, safen, pad => {
t1: Tree.Link = NthSon[t, 1];
EnterComposite[OperandType[t1], t1, init];
IF RCType[csei] = composite THEN EnterType[csei, TRUE]};
construct =>
IF RCType[csei] = composite THEN {
node: Tree.Index = GetNode[t];
EnterFieldTypes[RecordRoot[tb[node].info], tb[node].son[2], init];
IF ~init THEN EnterType[csei, TRUE]}; -- in case constant-folded
union => {
node: Tree.Index = GetNode[t];
EnterFieldTypes[LOOPHOLE[UnderType[GetSe[tb[node].son[1]]]], tb[node].son[2], init]};
rowcons => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = tb[node].info;
cSei: Type = seb[aSei].componentType;
EnterElement: Tree.Scan = {EnterComposite[cSei, t, init]};
IF RCType[cSei] # none THEN {
ScanList[tb[node].son[2], EnterElement];
IF ~init THEN EnterType[UnderType[csei], TRUE]}};
all => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = tb[node].info;
cSei: Type = seb[aSei].componentType;
IF RCType[cSei] # none THEN {
EnterComposite[cSei, NthSon[t, 1], FALSE];
IF ~init THEN EnterType[UnderType[csei], TRUE]}};
ENDCASE =>
SELECT seb[csei].typeTag FROM
union => Log.ErrorTree[unimplemented, t];
sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];
ENDCASE => IF RCType[csei] = composite THEN EnterType[csei, TRUE]};
EnterFieldTypes: PROC [rSei: RecordSEIndex, t: Tree.Link, init: BOOL] = {
sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx];
EnterField: Tree.Scan = {
IF sei # ISENull THEN {
subType: CSEIndex = UnderType[seb[sei].idType];
WITH seb[subType] SELECT FROM
record =>
IF hints.variant THEN {
IF RCType[subType] = composite THEN EnterType[subType, TRUE]}
ELSE EnterComposite[subType, t, init];
ENDCASE => EnterComposite[subType, t, init]};
sei ← NextSe[sei]};
ScanList[t, EnterField]};
EnterMarkedType: PROC [type: Type] = INLINE {
EnterType[MarkedType[type]]};
EnterDiscriminator: PROC [t: Tree.Link] = INLINE { -- guarantee that union is copied
[] ← VariantUnionType[OpenedType[OperandType[t]]]};
EnterTags: PROC [type: Type] = INLINE {
subType: CSEIndex ← OpenedType[UnderType[type]];
DO
next: Type = TypeLink[subType];
IF next = nullType THEN EXIT;
subType ← UnderType[next];
[] ← VariantUnionType[subType]; -- guarantee that union is copied
ENDLOOP};
-- identifier look-up
Id: PUBLIC PROC [name: Name] RETURNS [val: Tree.Link] = {
sei: ISEIndex;
type: Type;
ctx: CTXIndex;
baseV: Tree.Link;
attr: Attr ← voidAttr;
indirect: BOOL;
[sei, baseV, indirect] ← FindSe[name];
IF sei # ISENull THEN {
IF baseV = Tree.Null THEN RecordMention[sei] ELSE BumpCount[sei];
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
val ← [symbol[index: sei]]; type ← seb[sei].idType;
ctx ← seb[sei].idCtx;
SELECT ctxb[ctx].ctxType FROM
included => {
attr.const ← ConstantId[sei];
IF baseV = Tree.Null AND (~attr.const OR ~InterfaceConst[sei]) THEN
Log.ErrorSei[notImported, sei]};
imported => {
IF TypeForm[type] = ref THEN [val, type] ← DeRef[val, type];
attr.const ← FALSE};
ENDCASE => {
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
attr.const ← seb[sei].constant};
SELECT TRUE FROM
baseV = Tree.Null => {
IF ctx = P3S.currentBody.argCtx THEN phraseNP ← ref;
IF ctxb[ctx].level = lZ AND ~attr.const THEN
SELECT ctx FROM
IN StandardContext, dataPtr.moduleCtx => NULL;
ENDCASE => Log.ErrorSei[missingBase, sei]};
(~attr.const AND ctxb[ctx].ctxType # imported) => {
attr ← And[UpdateTreeAttr[baseV], attr];
PushTree[CopyTree[baseV]]; PushTree[val];
IF indirect THEN {PushNode[dot, 2]; SetAttr[2, TypeForm[OperandType[baseV]] = long]}
ELSE {PushNode[dollar, 2]; SetAttr[2, LongPath[baseV]]};
SetInfo[type]; val ← PopTree[]};
ENDCASE;
IF VarType[type] THEN [val, type] ← DeRef[val, type, TRUE];
IF seb[sei].extended THEN attr ← And[UpdateExtension[sei], attr]}
ELSE {
attr ← And[UpdateTreeAttr[baseV], attr]; type ← OperandType[baseV];
IF indirect THEN [val, type] ← DeRef[CopyTree[baseV], type]
ELSE val ← CopyTree[baseV]};
RPush[type, attr];
RETURN};
DeRef: PROC [t: Tree.Link, type: Type, var: BOOL←FALSE] RETURNS [Tree.Link, Type] = {
rType: Type = ReferentType[type];
PushTree[t];
PushNode[uparrow, 1];
SetInfo[rType]; SetAttr[2, TypeForm[type] = long]; SetAttr[3, var];
RETURN [PopTree[], rType]};
UpdateExtension: PROC [sei: ISEIndex] RETURNS [attr: Attr] = {
t: Tree.Link;
tag: ExtensionType;
[tag, t] ← FindExtension[sei];
IF tag # value THEN attr ← fullAttr
ELSE {attr ← UpdateTreeAttr[t]; attr.const ← TRUE};
RETURN};
FieldId: PUBLIC PROC [name: Name, type: RecordSEIndex] RETURNS [n: CARDINAL, sei: ISEIndex] = {
[n, sei] ← SearchRecord[name, type];
IF n # 0 THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
BumpCount[sei]};
RETURN};
InterfaceId: PUBLIC PROC [name: Name, ctx: CTXIndex]
RETURNS [found: BOOL, sei: ISEIndex] = {
[found, sei] ← SearchCtxList[name, ctx];
IF found THEN {
SELECT ctxb[seb[sei].idCtx].ctxType FROM
imported => NULL;
included =>
IF ~ConstantId[sei] OR ~InterfaceConst[sei] THEN Log.ErrorSei[notImported, sei];
ENDCASE => {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei]};
BumpCount[sei]};
RETURN};
ClusterId: PUBLIC PROC [name: Name, ctx: CTXIndex]
RETURNS [found: BOOL, sei: ISEIndex] = {
WITH c: ctxb[ctx] SELECT FROM
simple => [found, sei] ← SearchCtxList[name, ctx];
included => {
mdi: MDIndex = c.module;
IF mdb[mdi].defaultImport = CTXNull THEN { -- avoid creating spurious principal imports
IF SearchCtxList[name, ctx].found THEN
[found, sei] ← SearchCtxList[name, DefaultImport[LOOPHOLE[ctx], FALSE]]
ELSE {found ← FALSE; sei ← ISENull}}
ELSE [found, sei] ← SearchCtxList[name, mdb[mdi].defaultImport]};
ENDCASE => {found ← FALSE; sei ← ISENull};
IF found THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
BumpCount[sei]};
RETURN};
-- service routines for above
InterfaceConst: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {
RETURN [SELECT LinkMode[sei] FROM val, ref => FALSE, ENDCASE => TRUE]};
ConstResolved: PROC [sei: ISEIndex] RETURNS [BOOL] = {
RETURN [(seb[sei].mark4 OR seb[sei].idValue = Tree.Null) OR ~seb[sei].immutable
OR (seb[sei].constant AND ~RootType[sei])]};
RootType: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {
RETURN [seb[sei].idType = typeTYPE AND TypeLink[sei] = nullType]};
ResolveIdType: PROC [sei: ISEIndex] = {
declNode: Tree.Index ← seb[sei].idValue;
IF tb[declNode].attr3 # P3.mark THEN ResolveType[sei]};
ResolveIdValue: PROC [sei: ISEIndex] = {
declNode: Tree.Index ← seb[sei].idValue;
IF seb[sei].mark3 AND tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]};
BumpCount: PUBLIC PROC [sei: ISEIndex] = {
OPEN seb[sei];
IF idType # typeTYPE AND (~mark4 OR (ctxb[idCtx].ctxType = imported AND ~constant)) THEN
idInfo ← idInfo + 1};
-- keyed-list matching
CompleteRecord: PUBLIC PROC [rSei: RecordSEIndex, depth: Closure←$unit] = {
ctx: CTXIndex = seb[rSei].fieldCtx;
WITH ctxb[ctx] SELECT FROM
simple => NULL;
included => IF level = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], depth];
ENDCASE};
ArrangeKeys: PUBLIC PROC [
expList: Tree.Link,
nextKey: PROC RETURNS [Name],
omittedValue: PROC RETURNS [Tree.Link]]
RETURNS [nItems: CARDINAL] = {
Pair: TYPE = RECORD[key: Name, val: Tree.Link];
PairList: TYPE = RECORD[SEQUENCE length: CARDINAL OF Pair];
a: LONG POINTER TO PairList;
n: CARDINAL;
duplicate: BOOL;
ListItem: Tree.Map = {
node: Tree.Index = GetNode[t];
name: Name = GetHash[tb[node].son[1]];
FOR i: CARDINAL IN [0 .. n) DO
IF name = a[i].key THEN GO TO Duplicate;
REPEAT
Duplicate => {duplicate ← TRUE; v ← t};
FINISHED => {
a[n] ← [key:name, val:tb[node].son[2]]; n ← n+1;
tb[node].son[2] ← Tree.Null; v ← FreeTree[t]};
ENDLOOP;
RETURN};
DuplicateItem: Tree.Scan = {
IF t # Tree.Null THEN {
node: Tree.Index = GetNode[t];
Log.ErrorTree[duplicateKey, tb[node].son[1]];
tb[node].son[2] ← P3.VoidExp[tb[node].son[2]]}};
key: Name;
m: CARDINAL;
n ← ListLength[expList]; nItems ← 0;
a ← zone.NEW[PairList[n]];
n ← 0; duplicate ← FALSE; expList ← UpdateList[expList, ListItem]; m ← n;
UNTIL (key ← nextKey[]) = nullName DO
FOR i: CARDINAL IN [0 .. n) DO
IF key = a[i].key THEN GO TO Found;
REPEAT
Found => {PushTree[a[i].val]; a[i].key ← nullName; m ← m-1};
FINISHED => PushTree[omittedValue[]];
ENDLOOP;
nItems ← nItems + 1;
ENDLOOP;
IF duplicate THEN ScanList[expList, DuplicateItem];
IF m # 0 THEN
FOR i: CARDINAL IN [0 .. n) DO
IF a[i].key # nullName THEN {
Log.ErrorHti[unknownKey, a[i].key]; [] ← FreeTree[P3.VoidExp[a[i].val]]};
ENDLOOP;
[] ← FreeTree[expList]; zone.FREE[@a];
RETURN};
-- service routines for copying/mapping list structure
BindTree: PUBLIC PROC [t: Tree.Link, binding: PROC [ISEIndex] RETURNS [Tree.Link]]
RETURNS [Tree.Link] = {
MapTree: Tree.Map = {
IF t = Tree.Null THEN v ← Tree.Null
ELSE WITH t SELECT FROM
symbol => v ← binding[index];
subtree => {
node: Tree.Index = index;
v ← SELECT TRUE FROM
tb[node].shared =>
SELECT tb[node].name FROM
call, callx => MapThreadedTree[t],
ENDCASE => t,
ENDCASE => TreeOps.CopyTree[[baseP:@tb, link:t], MapTree]};
ENDCASE => v ← t;
RETURN};
MapThread: Tree.Map = {
IF OpName[t] = thread THEN {
node: Tree.Index = GetNode[t];
PushTree[MapTree[tb[node].son[1]]]; PushTree[Tree.Null];
PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[P3S.currentScope];
v ← PopTree[]}
ELSE v ← MapTree[t]};
MapThreadedTree: Tree.Map = {
sThread: Tree.Index = GetNode[NthSon[t, 1]];
dThread: Tree.Index;
v ← TreeOps.CopyTree[[baseP:@tb, link:t], MapThread];
dThread ← GetNode[NthSon[v, 1]];
tb[dThread].son[2] ← tb[sThread].son[2];
tb[sThread].son[2] ← v; MarkShared[v, TRUE];
RETURN};
RETURN [MapTree[t]]};
IdentityBinding: PROC [sei: ISEIndex] RETURNS [Tree.Link] = {
RETURN [[symbol[index: sei]]]};
CopyTree: PUBLIC Tree.Map = {
RETURN [BindTree[t, IdentityBinding]]};
-- attribute completion/updating
EnterRefLits: PROC [node: Tree.Index] = {
IF node # Tree.NullIndex THEN
SELECT tb[node].name FROM
assign, assignx =>
IF tb[node].attr2 AND tb[node].attr3 THEN
EnterComposite[OperandType[tb[node].son[1]], tb[node].son[2], tb[node].attr1];
new =>
IF tb[node].attr3 THEN {
subType: Type = TypeForTree[tb[node].son[2]];
EnterType[TypeRoot[subType], FALSE];
IF tb[node].son[3] # Tree.Null THEN
EnterComposite[subType, tb[node].son[3], TRUE]};
ditem => {
sei: ISEIndex = FirstId[GetNode[tb[node].son[1]]];
UpdateNarrowing[seb[sei].idType, tb[node].attr2, tb[node].attr3]};
narrow => {
IF RCType[tb[node].info] = simple THEN {
nType: CSEIndex = NormalType[tb[node].info];
WITH t: seb[nType] SELECT FROM
ref => EnterType[t.refType, FALSE];
ENDCASE => NULL};
UpdateNarrowing[tb[node].info, tb[node].attr2, tb[node].attr3]};
istype =>
UpdateNarrowing[TypeForTree[tb[node].son[2]], tb[node].attr2, tb[node].attr3];
atom => {
SymLiteralOps.EnterAtom[GetHash[tb[node].son[1]]];
EnterType[dataPtr.typeAtomRecord, FALSE]};
bind, bindx =>
IF ~tb[node].attr3 THEN EnterDiscriminator[NthSon[tb[node].son[1], 2]];
ENDCASE};
UpdateNarrowing: PROC [type: Type, rtTest, tagTest: BOOL] = {
IF rtTest THEN EnterMarkedType[type];
IF tagTest THEN EnterTags[type]};
UpdateTreeAttr: PUBLIC PROC [t: Tree.Link] RETURNS [attr: Attr] = {
-- traverses the tree, incrementing reference counts for ids
UpdateAttr: Tree.Scan = {
WITH t SELECT FROM
symbol => {
IF seb[index].idCtx = P3S.currentBody.argCtx THEN
phraseNP ← MergeNP[phraseNP][ref];
BumpCount[index]};
subtree => {
node: Tree.Index = index;
ScanSons[t, UpdateAttr];
EnterRefLits[node];
SELECT tb[node].name FROM
assign, assignx => {
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set]};
IN [call..join], IN [callx..joinx] => { -- conservative
P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set]};
new => P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
ENDCASE => NULL};
ENDCASE => NULL};
attr ← fullAttr; phraseNP ← none; UpdateAttr[t];
attr.const ← FALSE; RETURN};
-- context stack management
ContextEntry: TYPE = RECORD [
base: Tree.Link, -- the basing expr (empty if none)
indirect: BOOL, -- true iff basing expr is pointer
info: SELECT tag: * FROM
list => [ctx: CTXIndex], -- a single context
record => [rSei: RecordSEIndex], -- a group of contexts
hash => [ctxHti: Name], -- a single identifier
ENDCASE];
ContextSequence: TYPE = RECORD [SEQUENCE length: NAT OF ContextEntry];
ContextStack: TYPE = LONG POINTER TO ContextSequence;
ctxStack: ContextStack;
ctxIndex: INTEGER;
ContextIncr: CARDINAL = 16;
MakeStack: PROC [size: CARDINAL] RETURNS [ContextStack] = INLINE {
RETURN [zone.NEW[ContextSequence[size]]]};
ExpandStack: PROC = {
oldstack: ContextStack ← ctxStack;
ctxStack ← MakeStack[oldstack.length + ContextIncr];
FOR i: CARDINAL IN [0 .. oldstack.length) DO ctxStack[i] ← oldstack[i] ENDLOOP;
zone.FREE[@oldstack]};
PushCtx: PUBLIC PROC [ctx: CTXIndex] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:Tree.Null, indirect:FALSE, info:list[ctx]]};
SetCtxBase: PROC [base: Tree.Link, indirect: BOOL] = {
ctxStack[ctxIndex].base ← base; ctxStack[ctxIndex].indirect ← indirect};
PushRecordCtx: PUBLIC PROC [rSei: RecordSEIndex, base: Tree.Link, indirect: BOOL] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:record[rSei]]};
UpdateRecordCtx: PUBLIC PROC [type: RecordSEIndex] = {
WITH ctxStack[ctxIndex] SELECT FROM
record => rSei ← type;
ENDCASE => ERROR};
PushHtCtx: PUBLIC PROC [name: Name, base: Tree.Link, indirect: BOOL] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:hash[name]]};
PopCtx: PUBLIC PROC = {ctxIndex ← ctxIndex-1};
TopCtx: PUBLIC PROC RETURNS [CTXIndex] = {
RETURN [WITH ctxStack[ctxIndex] SELECT FROM list => ctx, ENDCASE => ERROR]};
-- primary lookup
FindSe: PUBLIC PROC [name: Name] RETURNS [ISEIndex, Tree.Link, BOOL] = {
found: BOOL;
nHits: CARDINAL;
sei: ISEIndex;
FOR i: INTEGER DECREASING IN [0 .. ctxIndex] DO
WITH s: ctxStack[i] SELECT FROM
list => {
[found, sei] ← SearchCtxList[name, s.ctx];
IF found THEN GO TO Found};
record => {
[nHits, sei] ← SearchRecord[name, s.rSei];
SELECT nHits FROM
= 1 => GO TO Found;
> 1 => GO TO Ambiguous;
ENDCASE};
hash => IF name = s.ctxHti THEN {sei ← ISENull; GO TO Found};
ENDCASE;
REPEAT
Found => RETURN [sei, ctxStack[i].base, ctxStack[i].indirect];
Ambiguous => {
Log.ErrorHti[ambiguousId, name];
RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
FINISHED => {
IF name # nullName THEN Log.ErrorHti[unknownId, name];
RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
ENDLOOP};
SearchCtxList: PUBLIC PROC [name: Name, ctx: CTXIndex]
RETURNS [found: BOOL, sei: ISEIndex] = {
IF ctx = CTXNull THEN RETURN [FALSE, ISENull];
WITH c: ctxb[ctx] SELECT FROM
included => {
IF c.restricted THEN {
sei ← SearchRestrictedCtx[name, LOOPHOLE[ctx]]; found ← (sei # ISENull)}
ELSE {
sei ← SearchContext[name, ctx];
SELECT TRUE FROM
(sei # ISENull) => found ← TRUE;
(~c.closed AND ~c.reset) => [found, sei] ← Copier.SearchFileCtx[name, LOOPHOLE[ctx]];
ENDCASE => found ← FALSE};
IF found AND ~seb[sei].public AND ~Shared[ctx]
AND sei # dataPtr.seAnon THEN Log.ErrorHti[noAccess, name]};
imported => {
iCtx: IncludedCTXIndex = c.includeLink;
sei ← SearchContext[name, ctx];
IF sei # ISENull THEN
found ← ~ctxb[iCtx].restricted OR CheckRestrictedCtx[name, iCtx] # ISENull
ELSE {
[found, sei] ← SearchCtxList[name, iCtx];
IF found AND sei # dataPtr.seAnon THEN
SELECT LinkMode[sei] FROM
val => {MoveSe[sei, ctx]; ImportSe[sei, ctx]};
ref => {
MoveSe[sei, ctx];
IF ~dataPtr.interface AND ~VarType[seb[sei].idType] THEN {
seb[sei].idType ← MakeRefType[
cType: seb[sei].idType, readOnly: seb[sei].immutable,
hint: typeANY];
seb[sei].immutable ← TRUE};
ImportSe[sei, ctx]};
ENDCASE}};
ENDCASE => {sei ← SearchContext[name, ctx]; found ← (sei # ISENull)};
RETURN};
MoveSe: PROC [sei: ISEIndex, ctx: CTXIndex] = {
Copier.Delink[sei]; seb[sei].idCtx ← ctx;
SetSeLink[sei, ctxb[ctx].seList]; ctxb[ctx].seList ← sei};
-- import handling
MainIncludedCtx: PUBLIC PROC [mdi: MDIndex] RETURNS [ctx: IncludedCTXIndex] = {
FOR ctx ← mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
IF ctxb[ctx].level = lG THEN EXIT ENDLOOP;
RETURN};
DefaultImport: PROC [iCtx: IncludedCTXIndex, new: BOOL] RETURNS [CTXIndex] = {
mdi: MDIndex = ctxb[iCtx].module;
IF mdb[mdi].defaultImport = CTXNull THEN SetDefaultImport[iCtx, new];
RETURN [mdb[mdi].defaultImport]};
ImportTree: PROC [t: Tree.Link, importCtx: CTXIndex] RETURNS [Tree.Link] = {
iCtx: IncludedCTXIndex = WITH c: ctxb[importCtx] SELECT FROM
imported => c.includeLink,
ENDCASE => ERROR;
UpdateBinding: Tree.Map = {
WITH t SELECT FROM
symbol => {
oldSei: ISEIndex = index;
oldCtx: CTXIndex = seb[oldSei].idCtx;
newSei: ISEIndex;
WITH c: ctxb[oldCtx] SELECT FROM
included =>
IF c.level # lG OR InterfaceConst[oldSei] THEN newSei ← oldSei
ELSE {
mdi: MDIndex = c.module;
saveRestricted: BOOL = c.restricted;
saveShared: BOOL = mdb[mdi].shared;
targetCtx: CTXIndex;
c.restricted ← FALSE; mdb[mdi].shared ← TRUE;
targetCtx ← IF oldCtx = iCtx
THEN importCtx
ELSE DefaultImport[LOOPHOLE[oldCtx], TRUE];
newSei ← SearchCtxList[seb[oldSei].hash, targetCtx].sei;
mdb[mdi].shared ← saveShared; c.restricted ← saveRestricted};
ENDCASE => newSei ← oldSei;
v ← [symbol[index: newSei]];
IF ~dataPtr.interface AND ctxb[seb[newSei].idCtx].ctxType = imported THEN {
type: Type = seb[newSei].idType;
IF TypeForm[type] = ref AND ~VarType[type] THEN [v, ] ← DeRef[v, type]};
BumpCount[newSei]};
subtree => {
node: Tree.Index = index;
EnterRefLits[node];
v ← UpdateLeaves[t, UpdateBinding]};
ENDCASE => v ← t;
RETURN};
RETURN [UpdateBinding[t]]};
ImportCtx: PROC [ctx, importCtx: CTXIndex] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
ImportSe[sei, importCtx] ENDLOOP};
ImportSe: PROC [sei: ISEIndex, importCtx: CTXIndex] = {
t: Tree.Link;
tag: ExtensionType;
type: CSEIndex = UnderType[seb[sei].idType];
WITH t: seb[type] SELECT FROM
transfer => {
ImportCtx[ArgCtx[t.typeIn], importCtx];
ImportCtx[ArgCtx[t.typeOut], importCtx]};
ENDCASE;
IF seb[sei].extended THEN {
[tag, t] ← FindExtension[sei];
EnterExtension[sei, tag, ImportTree[t, importCtx]]}};
-- searching records
SearchRecordSegment: PROC [name: Name, rSei: RecordSEIndex, suffixed: BOOL]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
tSei: CSEIndex;
found: BOOL;
n: CARDINAL;
match: ISEIndex;
[found, sei] ← SearchCtxList[name, seb[rSei].fieldCtx];
nHits ← IF found THEN 1 ELSE 0;
IF seb[rSei].hints.variant THEN {
tSei ← VariantUnionType[rSei];
WITH seb[tSei] SELECT FROM
union => {
IF ~suffixed AND ~controlled AND overlaid THEN {
[n, match] ← SearchOverlays[name, caseCtx];
IF ~found THEN sei ← match;
nHits ← nHits + n};
IF controlled AND seb[tagSei].hash = name THEN {sei ← tagSei; nHits ← nHits + 1}};
sequence => {
IF controlled AND seb[tagSei].hash = name THEN {sei ← tagSei; nHits ← nHits + 1}};
ENDCASE => NULL};
RETURN};
SearchOverlays: PROC [name: Name, ctx: CTXIndex]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
vSei: ISEIndex;
rSei: Type;
n: CARDINAL;
match: ISEIndex;
WITH ctxb[ctx] SELECT FROM
included => Copier.CompleteContext[LOOPHOLE[ctx]];
ENDCASE;
nHits ← 0; sei ← ISENull;
FOR vSei ← FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull DO
IF seb[vSei].public OR Shared[ctx] THEN {
rSei ← seb[vSei].idInfo;
WITH r: seb[rSei] SELECT FROM
id => NULL;
cons =>
WITH r SELECT FROM
record => {
[n, match] ← SearchRecordSegment[name, LOOPHOLE[rSei], FALSE];
IF nHits = 0 THEN sei ← match;
nHits ← nHits + n};
ENDCASE => ERROR;
ENDCASE};
ENDLOOP;
RETURN};
SearchRecord: PROC [name: Name, type: RecordSEIndex]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
rSei: RecordSEIndex;
suffixed: BOOL;
rSei ← type; suffixed ← FALSE;
UNTIL rSei = RecordSENull DO
[nHits, sei] ← SearchRecordSegment[name, rSei, suffixed];
IF nHits # 0 THEN RETURN;
rSei ← WITH seb[rSei] SELECT FROM
linked => LOOPHOLE[UnderType[linkType]],
ENDCASE => RecordSENull;
suffixed ← TRUE;
ENDLOOP;
RETURN [0, ISENull]};
-- management of restricted contexts
Shared: PUBLIC PROC [ctx: CTXIndex] RETURNS [BOOL] = {
RETURN [WITH c: ctxb[ctx] SELECT FROM
included => mdb[c.module].shared,
imported => Shared[c.includeLink],
ENDCASE => TRUE]};
CtxRestriction: TYPE = RECORD [ctx: IncludedCTXIndex, list: Tree.Link];
CtxIdTable: TYPE = RECORD [SEQUENCE length: CARDINAL OF CtxRestriction];
ctxIdTable: LONG POINTER TO CtxIdTable;
CtxHash: PROC [ctx: IncludedCTXIndex] RETURNS [CARDINAL] = INLINE {
RETURN [(LOOPHOLE[ctx, CARDINAL]/CTXRecord.included.SIZE) MOD ctxIdTable.length]};
MakeIdTable: PUBLIC PROC [nIdLists: CARDINAL] = {
ctxIdTable ← zone.NEW[CtxIdTable[nIdLists]];
FOR i: CARDINAL IN [0..nIdLists) DO ctxIdTable[i] ← [IncludedCTXNull, Tree.Null] ENDLOOP};
EnterIdList: PUBLIC PROC [ctx: IncludedCTXIndex, list: Tree.Link] = {
i: CARDINAL ← CtxHash[ctx];
DO
IF ctxIdTable[i].ctx = IncludedCTXNull THEN {ctxIdTable[i] ← [ctx, list]; EXIT};
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP};
CheckRestrictedCtx: PROC [name: Name, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
TestId: Tree.Test = {
WITH t SELECT FROM
hash => IF index = name THEN sei ← dataPtr.seAnon;
symbol => IF seb[index].hash = name THEN sei ← index;
ENDCASE;
RETURN [sei # ISENull]};
i: CARDINAL ← CtxHash[ctx];
DO
IF ctxIdTable[i].ctx = ctx THEN EXIT;
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP;
sei ← ISENull; SearchList[ctxIdTable[i].list, TestId];
IF sei # ISENull AND seb[sei].idCtx = CTXNull THEN seb[sei].idCtx ← ctx;
RETURN};
SearchRestrictedCtx: PROC [name: Name, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
sei ← CheckRestrictedCtx[name, ctx];
IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {
[ , sei] ← Copier.SearchFileCtx[name, ctx];
seb[sei].public ← TRUE}; -- second copy, access already checked
RETURN};
CheckDirectoryIds: Tree.Scan = {
CheckId: Tree.Scan = {
WITH t SELECT FROM
symbol => IF seb[index].idCtx = CTXNull THEN Log.WarningSei[unusedId, index];
ENDCASE};
node: Tree.Index = GetNode[t];
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
ScanList[tb[node].son[3], CheckId];
dataPtr.textIndex ← saveIndex};
CheckDisjoint: PUBLIC PROC [ctx1, ctx2: CTXIndex] = {
name: Name;
saveIndex: CARDINAL = dataPtr.textIndex;
IF ctx1 # CTXNull AND ctx2 # CTXNull THEN
FOR sei: ISEIndex ← FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO
name ← seb[sei].hash;
IF name # nullName AND SearchContext[name, ctx1] # ISENull THEN {
IF ~seb[sei].mark3 THEN
dataPtr.textIndex ← tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].info;
Log.ErrorHti[duplicateId, name]};
ENDLOOP;
dataPtr.textIndex ← saveIndex};
-- basing management
OpenedType: PROC [type: CSEIndex] RETURNS [CSEIndex] = {
subType: CSEIndex = NormalType[type];
RETURN [WITH seb[subType] SELECT FROM
ref => UnderType[refType],
ENDCASE => type]};
OpenPointer: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [Tree.Link, Type] = {
subType: Type ← type;
nType, rType: CSEIndex;
nDerefs: CARDINAL ← 0;
DO
nType ← NormalType[subType];
WITH p: seb[nType] SELECT FROM
ref => {
rType ← UnderType[p.refType];
IF P3S.safety = checked AND ~(p.counted OR PermanentType[p.refType]) THEN
Log.ErrorTree[unsafeOperation, t];
IF TypeForm[NormalType[rType]] # ref THEN EXIT;
IF (nDerefs ← nDerefs+1) > 63 THEN EXIT};
ENDCASE;
[t, subType] ← DeRef[t, subType];
ENDLOOP;
RETURN [t, rType]};
BaseTree: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [val: Tree.Link] = {
PushTree[t]; PushNode[openx, 1]; SetInfo[type]; SetAttr[1, FALSE];
val ← PopTree[]; MarkShared[val, TRUE]; RETURN};
OpenBase: PUBLIC PROC [t: Tree.Link, name: Name] RETURNS [v: Tree.Link] = {
type, vType: Type;
nType: CSEIndex;
OpenRecord: PROC [indirect: BOOL] = {
subType: CSEIndex = UnderType[type];
WITH seb[subType] SELECT FROM
record => {
v ← BaseTree[v, vType];
IF name # nullName THEN PushHtCtx[name, v, indirect]
ELSE PushRecordCtx[LOOPHOLE[subType, RecordSEIndex], v, indirect]};
ENDCASE => IF subType # typeANY THEN Log.ErrorTree[typeClash, v]};
v ← Exp[t, typeANY];
type ← vType ← RType[]; nType ← NormalType[vType]; RPop[];
WITH seb[nType] SELECT FROM
definition, transfer => {
ctx: CTXIndex = InterfaceCtx[nType, v];
IF ctx = CTXNull THEN OpenRecord[FALSE]
ELSE IF name # nullName THEN PushHtCtx[name, v, FALSE]
ELSE PushCtx[ctx]};
ref => {
[v, type] ← OpenPointer[v, vType]; vType ← OperandType[v];
OpenRecord[TRUE]};
ENDCASE => OpenRecord[FALSE];
RETURN};
CloseBase: PUBLIC PROC [t: Tree.Link, name: Name] = {
type: CSEIndex;
CloseRecord: PROC = {WITH seb[type] SELECT FROM record => PopCtx[]; ENDCASE};
type ← NormalType[OperandType[t]];
WITH seb[type] SELECT FROM
definition => PopCtx[];
ref => {type ← UnderType[refType]; CloseRecord[]};
ENDCASE => CloseRecord[]};
-- initialization/finalization
IdInit: PUBLIC PROC [scratchZone: UNCOUNTED ZONE] = {
(dataPtr.table).AddNotify[IdNotify];
zone ← scratchZone;
refStack ← zone.NEW[RefSequence[16]];
refIndex ← 0;
ctxStack ← MakeStack[2*ContextIncr]; ctxIndex ← -1};
IdReset: PUBLIC Tree.Scan = {
ScanList[t, CheckDirectoryIds];
zone.FREE[@ctxIdTable]; zone.FREE[@ctxStack];
zone.FREE[@refStack];
zone ← NIL;
(dataPtr.table).DropNotify[IdNotify]};
}.