[Cyan]<Cedar6.1>Compiler>Pass3I.mesa!2

Pass3I.mesa

Satterthwaite, June 25, 1986 11:09:10 am PDT

Donahue, 8-Dec-81 15:29:30

Russ Atkinson (RRA) March 6, 1985 10:42:03 pm PST

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, ErrorTreeOp, WarningSei],

P3: TYPE USING [Attr, fullAttr, voidAttr, mark, MergeNP, phraseNP, And, Exp, FirstId, InterfaceCtx, ItemType, MakeRefType, ResolveType, ResolveValue, RPop, RPush, RType, SetDefaultImport, VariantUnionType, VoidExp],

P3S: TYPE USING [currentBody, currentScope, safety],

SourceMap: TYPE USING [Loc],

Symbols: TYPE USING [seType, ctxType, mdType, Base, CTXRecord, ExtensionType, MDIndex, HTIndex, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, CTXIndex, IncludedCTXIndex, Closure, HTNull, nullType, ISENull, CSENull, RecordSENull, CTXNull, IncludedCTXNull, lG, lZ, StandardContext, typeTYPE, typeANY],

SymbolOps: TYPE USING [ArgCtx, ConstantId, CtxLevel, 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 = REF RefSequence;

refStack: RefStack;

refIndex: CARDINAL;

AdjustRefStack: PROC[n: CARDINAL] = {

oldStack: RefStack ← refStack;

refStack ← NEW[RefSequence[n]];

FOR i: CARDINAL IN [0..refIndex) DO refStack[i] ← oldStack[i] ENDLOOP;

oldStack ← NIL};

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 CtxLevel[seb[sei].idCtx] # 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]};

type table management

EnterType: PUBLIC PROC[type: Type, canonical: BOOL←TRUE] = {

SymLiteralOps.EnterType[type, canonical];

CompleteRCType[TypeRoot[type]]};

CompleteContext: PROC[ctx: CTXIndex] = {

WITH c: ctxb[ctx] SELECT FROM

simple =>

IF c.copied < $rc THEN {

c.copied ← $rc;

FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO

type: Type = seb[sei].idType;

CompleteRCType[IF type = typeTYPE THEN sei ELSE TypeRoot[type]];

ENDLOOP;

};

included =>

IF CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], $rc];

ENDCASE

};

CompleteRCType: PROC[type: Type] = {

IF RCType[type] # none THEN {

subType: CSEIndex = UnderType[type];

WITH t: seb[subType] SELECT FROM

record => CompleteContext[t.fieldCtx];

array => CompleteRCType[TypeRoot[t.componentType]];

union => CompleteContext[t.caseCtx];

sequence => CompleteRCType[TypeRoot[t.componentType]];

ENDCASE => NULL

}

};

EnterStructure: PROC[type: Type] = {EnterType[UnderType[type], TRUE]};

EnterComposite: PUBLIC PROC[type: Type, t: Tree.Link, init: BOOL] = {

SELECT OpName[t] FROM

loophole, cast, safen, pad => {

t1: Tree.Link = NthSon[t, 1];

EnterComposite[OperandType[t1], t1, init];

IF RCType[type] = composite THEN EnterStructure[type]};

construct =>

IF RCType[type] = composite THEN {

node: Tree.Index = GetNode[t];

EnterFieldTypes[

RecordRoot[LOOPHOLE[UnderType[tb[node].info]]], tb[node].son[2], init];

IF ~init THEN EnterStructure[type] -- 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 = LOOPHOLE[UnderType[tb[node].info]];

cSei: CSEIndex = UnderType[seb[aSei].componentType];

EnterElement: Tree.Scan = {EnterComposite[cSei, t, init]};

IF RCType[cSei] # none THEN {

ScanList[tb[node].son[2], EnterElement];

IF ~init THEN EnterStructure[type]}

};

all => {

node: Tree.Index = GetNode[t];

aSei: ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]];

cSei: CSEIndex = UnderType[seb[aSei].componentType];

IF RCType[cSei] # none THEN {

EnterComposite[cSei, NthSon[t, 1], FALSE];

IF ~init THEN EnterStructure[type]}

};

ENDCASE =>

SELECT TypeForm[type] FROM

$union => Log.ErrorTree[unimplemented, t];

$sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];

ENDCASE => IF RCType[type] = composite THEN EnterStructure[type]

};

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 s: seb[subType] SELECT FROM

record => {

IF s.hints.variant AND RCType[subType] = composite THEN

EnterType[subType, TRUE];

EnterComposite[subType, t, init]};

ENDCASE => EnterComposite[subType, t, init]};

sei ← NextSe[sei]};

ScanList[t, EnterField]};

EnterMarkedType: PROC[type: Type] = INLINE {

EnterType[MarkedType[UnderType[type]]]};

EnterDiscriminator: PROC[t: Tree.Link] = INLINE { -- guarantee that union is copied

[] ← VariantUnionType[OpenedType[OperandType[t]]]};

EnterTags: PROC[type: Type] = INLINE {

subType: CSEIndex ← OpenedType[type];

next: CSEIndex ← UnderType[TypeLink[subType]];

IF next = CSENull THEN EXIT;

[] ← VariantUnionType[next]; -- guarantee that union is copied

subType ← next;

ENDLOOP

};

identifier look-up

Id: PUBLIC PROC[hti: HTIndex] RETURNS[val: Tree.Link] = {

sei: ISEIndex;

type: Type;

ctx: CTXIndex;

baseV: Tree.Link;

attr: Attr ← voidAttr;

indirect: BOOL;

[sei, baseV, indirect] ← FindSe[hti];

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 ~dataPtr.interface AND 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 CtxLevel[ctx] = 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[hti: HTIndex, type: RecordSEIndex]

RETURNS[n: CARDINAL, sei: ISEIndex] = {

[n, sei] ← SearchRecord[hti, type];

IF n # 0 THEN {

IF ~seb[sei].mark3 THEN ResolveIdType[sei];

IF ~ConstResolved[sei] THEN ResolveIdValue[sei];

BumpCount[sei]};

RETURN};

InterfaceId: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]

RETURNS[found: BOOL, sei: ISEIndex] = {

[found, sei] ← SearchCtxList[hti, 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[hti: HTIndex, ctx: CTXIndex]

RETURNS[found: BOOL, sei: ISEIndex] = {

WITH c: ctxb[ctx] SELECT FROM

simple => [found, sei] ← SearchCtxList[hti, ctx];

included => {

mdi: MDIndex = c.module;

IF mdb[mdi].defaultImport = CTXNull THEN { -- avoid creating spurious principal imports

IF SearchCtxList[hti, ctx].found THEN

[found, sei] ← SearchCtxList[hti, DefaultImport[LOOPHOLE[ctx], FALSE]]

ELSE {found ← FALSE; sei ← ISENull}}

ELSE [found, sei] ← SearchCtxList[hti, 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.NullIndex) 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 CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], depth];

ENDCASE

};

ArrangeKeys: PUBLIC PROC[

expList: Tree.Link,

nextKey: PROC RETURNS [HTIndex],

omittedValue: PROC RETURNS [Tree.Link]]

RETURNS [nItems: CARDINAL] = {

Pair: TYPE = RECORD[key: HTIndex, val: Tree.Link];

PairList: TYPE = RECORD[SEQUENCE length: CARDINAL OF Pair];

a: REF PairList;

n: CARDINAL;

duplicate: BOOL;

ListItem: Tree.Map = {

node: Tree.Index = GetNode[t];

hti: HTIndex = GetHash[tb[node].son[1]];

FOR i: CARDINAL IN [0 .. n) DO

IF hti = a[i].key THEN GO TO Duplicate;

REPEAT

Duplicate => {duplicate ← TRUE; v ← t};

FINISHED => {

a[n] ← [key:hti, 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: HTIndex;

m: CARDINAL;

n ← ListLength[expList]; nItems ← 0;

a ← NEW[PairList[n]];

n ← 0; duplicate ← FALSE; expList ← UpdateList[expList, ListItem]; m ← n;

UNTIL (key ← nextKey[]) = HTNull 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 ← HTNull; 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 # HTNull THEN {

Log.ErrorHti[unknownKey, a[i].key]; [] ← FreeTree[P3.VoidExp[a[i].val]]};

ENDLOOP;

[] ← FreeTree[expList]; a ← NIL;

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[UnderType[subType], tb[node].son[3], TRUE]};

listcons =>

IF tb[node].attr3 THEN {

rSei: Type = ReferentType[tb[node].info];

cSei: CSEIndex = UnderType[ItemType[rSei]];

EnterElement: Tree.Scan = {EnterComposite[cSei, t, TRUE]};

EnterType[TypeRoot[rSei], FALSE];

ScanList[tb[node].son[2], EnterElement]};

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, listcons => P3S.currentBody.noXfers ← attr.noXfer ← FALSE;

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: HTIndex], -- a single identifier

ENDCASE

];

ContextSequence: TYPE = RECORD[SEQUENCE length: NAT OF ContextEntry];

ContextStack: TYPE = REF ContextSequence;

ctxStack: ContextStack;

ctxIndex: INTEGER;

ContextIncr: CARDINAL = 16;

ExpandStack: PROC = {

oldstack: ContextStack ← ctxStack;

ctxStack ← NEW[ContextSequence[oldstack.length + ContextIncr]];

FOR i: CARDINAL IN [0 .. oldstack.length) DO ctxStack[i] ← oldstack[i] ENDLOOP;

oldstack ← NIL};

PushCtx: PUBLIC PROC[ctx: CTXIndex] = {

IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];

ctxStack[ctxIndex] ← [base:Tree.Null, indirect:FALSE, info:list[ctx]]};

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[hti: HTIndex, base: Tree.Link, indirect: BOOL] = {

IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];

ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:hash[hti]]};

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[hti: HTIndex] 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[hti, s.ctx];

IF found THEN GO TO Found};

record => {

[nHits, sei] ← SearchRecord[hti, s.rSei];

SELECT nHits FROM

= 1 => GO TO Found;

> 1 => GO TO Ambiguous;

ENDCASE};

hash => IF hti = s.ctxHti THEN {sei ← ISENull; GO TO Found};

ENDCASE;

REPEAT

Found => RETURN[sei, ctxStack[i].base, ctxStack[i].indirect];

Ambiguous => {

Log.ErrorHti[ambiguousId, hti];

RETURN[dataPtr.seAnon, Tree.Null, FALSE]};

FINISHED => {

IF hti # HTNull THEN Log.ErrorHti[unknownId, hti];

RETURN[dataPtr.seAnon, Tree.Null, FALSE]};

ENDLOOP

};

SearchCtxList: PUBLIC PROC[hti: HTIndex, 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[hti, LOOPHOLE[ctx]]; found ← (sei # ISENull)}

ELSE {

sei ← SearchContext[hti, ctx];

SELECT TRUE FROM

(sei # ISENull) => found ← TRUE;

(~c.closed AND ~c.reset) => [found, sei] ← Copier.SearchFileCtx[hti, LOOPHOLE[ctx]];

ENDCASE => found ← FALSE};

IF found AND ~seb[sei].public AND ~Shared[ctx]

AND sei # dataPtr.seAnon THEN Log.ErrorSei[privateId, sei]};

imported => {

iCtx: IncludedCTXIndex = c.includeLink;

sei ← SearchContext[hti, ctx];

IF sei # ISENull THEN

found ← ~ctxb[iCtx].restricted OR CheckRestrictedCtx[hti, iCtx] # ISENull

ELSE {

[found, sei] ← SearchCtxList[hti, 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[UnderType[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[hti, 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 CtxLevel[ctx] = 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 CtxLevel[oldCtx] # 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: CSEIndex = UnderType[seb[newSei].idType];

WITH s: seb[type] SELECT FROM

ref => IF ~s.var THEN [v, ] ← DeRef[v, type];

ENDCASE};

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, level: NAT] = {

FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO

ImportSe[sei, importCtx, level] ENDLOOP

};

ImportSe: PROC[sei: ISEIndex, importCtx: CTXIndex, level: NAT𡤀] = {

t: Tree.Link;

tag: ExtensionType;

type: CSEIndex = UnderType[seb[sei].idType];

IF level = 0 THEN -- this trick doesn't generalize (really need a marking scheme)

WITH t: seb[type] SELECT FROM

transfer => {

ImportCtx[ArgCtx[t.typeIn], importCtx, level+1];

ImportCtx[ArgCtx[t.typeOut], importCtx, level+1]};

ENDCASE;

IF seb[sei].extended THEN {

[tag, t] ← FindExtension[sei];

EnterExtension[sei, tag, ImportTree[t, importCtx]]}

};

searching records

SearchRecordSegment: PROC[hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOL]

RETURNS [nHits: CARDINAL, sei: ISEIndex] = {

found: BOOL;

n: CARDINAL;

match: ISEIndex;

[found, sei] ← SearchCtxList[hti, seb[rSei].fieldCtx];

nHits ← IF found THEN 1 ELSE 0;

IF seb[rSei].hints.variant THEN {

tSei: CSEIndex = VariantUnionType[rSei];

WITH t: seb[tSei] SELECT FROM

union => {

IF ~suffixed AND ~t.controlled AND t.overlaid THEN {

[n, match] ← SearchOverlays[hti, t.caseCtx];

IF ~found THEN sei ← match;

nHits ← nHits + n};

IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei ← t.tagSei; nHits ← nHits + 1}};

sequence => {

IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei ← t.tagSei; nHits ← nHits + 1}};

ENDCASE => NULL};

RETURN};

SearchOverlays: PROC[hti: HTIndex, ctx: CTXIndex]

RETURNS [nHits: CARDINAL, sei: ISEIndex] = {

WITH ctxb[ctx] SELECT FROM

included => Copier.CompleteContext[LOOPHOLE[ctx]];

ENDCASE;

nHits ← 0; sei ← ISENull;

FOR vSei: ISEIndex ← FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull DO

IF seb[vSei].public OR Shared[ctx] THEN {

type: Type = seb[vSei].idInfo;

WITH r: seb[type] SELECT FROM

id => NULL;

cons =>

WITH r SELECT FROM

record => {

n: CARDINAL;

match: ISEIndex;

[n, match] ← SearchRecordSegment[hti, LOOPHOLE[type], FALSE];

IF nHits = 0 THEN sei ← match;

nHits ← nHits + n};

ENDCASE => ERROR;

ENDCASE};

ENDLOOP;

RETURN};

SearchRecord: PROC[hti: HTIndex, type: RecordSEIndex]

RETURNS [nHits: CARDINAL, sei: ISEIndex] = {

rSei: RecordSEIndex ← type;

suffixed: BOOL ← FALSE;

UNTIL rSei = RecordSENull DO

[nHits, sei] ← SearchRecordSegment[hti, 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, linked: BOOL←FALSE];

CtxIdTable: TYPE = RECORD[SEQUENCE length: CARDINAL OF CtxRestriction];

ctxIdTable: REF CtxIdTable;

CtxHash: PROC[ctx: IncludedCTXIndex] RETURNS[CARDINAL] = INLINE {

RETURN[(LOOPHOLE[ctx, CARDINAL]/CTXRecord.included.SIZE) MOD ctxIdTable.length]};

MakeIdTable: PUBLIC PROC[nIdLists: CARDINAL] = {

ctxIdTable ← 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];

SELECT ctxIdTable[i].ctx FROM

IncludedCTXNull => {ctxIdTable[i] ← [ctx, list]; EXIT};

ctx => ctxIdTable[i].linked ← TRUE;

ENDCASE;

IF (i ← i+1) = ctxIdTable.length THEN i ← 0;

ENDLOOP

};

CheckRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]

RETURNS [sei: ISEIndex] = {

TestId: Tree.Test = {

WITH t SELECT FROM

hash => IF index = hti THEN sei ← dataPtr.seAnon;

symbol => IF seb[index].hash = hti THEN sei ← index;

ENDCASE;

RETURN[sei # ISENull]};

i: CARDINAL ← CtxHash[ctx];

IF ctxIdTable[i].ctx = ctx THEN {

sei ← ISENull; SearchList[ctxIdTable[i].list, TestId];

IF sei # ISENull OR ~ctxIdTable[i].linked THEN EXIT};

IF (i ← i+1) = ctxIdTable.length THEN i ← 0;

ENDLOOP;

IF sei # ISENull AND seb[sei].idCtx = CTXNull THEN seb[sei].idCtx ← ctx;

RETURN};

SearchRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]

RETURNS [sei: ISEIndex] = {

sei ← CheckRestrictedCtx[hti, ctx];

IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {

[ , sei] ← Copier.SearchFileCtx[hti, 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: SourceMap.Loc = dataPtr.textIndex;

dataPtr.textIndex ← tb[node].info;

ScanList[tb[node].son[3], CheckId];

dataPtr.textIndex ← saveIndex};

CheckDisjoint: PUBLIC PROC[ctx1, ctx2: CTXIndex] = {

hti: HTIndex;

saveIndex: SourceMap.Loc = dataPtr.textIndex;

IF ctx1 # CTXNull AND ctx2 # CTXNull THEN

FOR sei: ISEIndex ← FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO

hti ← seb[sei].hash;

IF hti # HTNull AND SearchContext[hti, ctx1] # ISENull THEN {

IF ~seb[sei].mark3 THEN

dataPtr.textIndex ← tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].info;

Log.ErrorHti[duplicateId, hti]};

ENDLOOP;

dataPtr.textIndex ← saveIndex};

basing management

OpenedType: PROC[type: Type] RETURNS[CSEIndex] = {

subType: CSEIndex = NormalType[type];

RETURN[UnderType[WITH t: seb[subType] SELECT FROM

ref => t.refType,

ENDCASE => type]]

};

OpenPointer: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS [Tree.Link, CSEIndex] = {

nType, rType: CSEIndex;

nDerefs: CARDINAL ← 0;

nType ← NormalType[type];

WITH p: seb[nType] SELECT FROM

ref => {

rType ← UnderType[p.refType];

IF P3S.safety = checked AND ~(p.counted OR PermanentType[p.refType]) THEN

Log.ErrorTreeOp[unsafeOp, t, uparrow];

IF seb[NormalType[rType]].typeTag # ref THEN EXIT;

IF (nDerefs ← nDerefs+1) > 63 THEN EXIT};

ENDCASE;

[t, type] ← DeRef[t, type];

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, hti: HTIndex] RETURNS[v: Tree.Link] = {

type, vType: Type;

nType: CSEIndex;

OpenRecord: PROC[indirect: BOOL] = {

sei: CSEIndex = UnderType[type];

WITH seb[sei] SELECT FROM

record => {

v ← BaseTree[v, vType];

IF hti # HTNull THEN PushHtCtx[hti, v, indirect]

ELSE PushRecordCtx[LOOPHOLE[sei, RecordSEIndex], v, indirect]};

ENDCASE => IF sei # typeANY THEN Log.ErrorTree[typeClash, v]

};

v ← Exp[t, typeANY];

type ← vType ← RType[]; nType ← NormalType[vType]; RPop[];

SELECT TypeForm[nType] FROM

$definition, $transfer => {

ctx: CTXIndex = InterfaceCtx[nType, v];

IF ctx = CTXNull THEN OpenRecord[FALSE]

ELSE IF hti # HTNull THEN PushHtCtx[hti, 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, hti: HTIndex] = {

type: Type;

CloseRecord: PROC = {IF TypeForm[type] = $record THEN PopCtx[]};

type ← NormalType[OperandType[t]];

SELECT TypeForm[type] FROM

$definition => PopCtx[];

$ref => {type ← ReferentType[type]; CloseRecord[]};

ENDCASE => CloseRecord[]

};

initialization/finalization

IdInit: PUBLIC PROC = {

(dataPtr.table).AddNotify[IdNotify];

refStack ← NEW[RefSequence[16]];

refIndex ← 0;

ctxStack ← NEW[ContextSequence[2*ContextIncr]];

ctxIndex ← -1};

IdReset: PUBLIC Tree.Scan = {

ScanList[t, CheckDirectoryIds];

ctxIdTable ← NIL;

ctxStack ← NIL;

refStack ← NIL;

(dataPtr.table).DropNotify[IdNotify]};