[Cyan]<CedarLang>Nucleus>Compiler>Pass3I.mesa!1

file Pass3I.mesa

last modified by Satterthwaite, July 6, 1983 5:20 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, HTIndex, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,

CTXIndex, IncludedCTXIndex, Closure,

HTNull, SENull, 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,

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: SEIndex, canonical: BOOL←TRUE] = {

SymLiteralOps.EnterType[type, canonical];

CompleteRCType[type]};

CompleteRCType: PROC [type: SEIndex] = {

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: CSEIndex, 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 EnterType[type, TRUE]};

construct =>

IF RCType[type] = composite THEN {

node: Tree.Index = GetNode[t];

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

IF ~init THEN EnterType[type, 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: 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 EnterType[type, TRUE]}};

all => {

node: Tree.Index = GetNode[t];

aSei: ArraySEIndex = tb[node].info;

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

IF RCType[cSei] # none THEN {

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

IF ~init THEN EnterType[type, TRUE]}};

ENDCASE =>

SELECT seb[type].typeTag FROM

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

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

ENDCASE => IF RCType[type] = composite THEN EnterType[type, 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 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: SEIndex] = INLINE {

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

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

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

EnterTags: PROC [type: SEIndex] = INLINE {

subType: CSEIndex ← OpenedType[UnderType[type]];

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

IF next = SENull 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: CSEIndex;

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 ← UnderType[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 seb[type].typeTag = 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, seb[OperandType[baseV]].typeTag = 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: CSEIndex, var: BOOL←FALSE]

RETURNS [Tree.Link, CSEIndex] = {

rType: CSEIndex = ReferentType[type];

PushTree[t];

PushNode[uparrow, 1];

SetInfo[rType]; SetAttr[2, seb[type].typeTag = 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.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] = SENull]};

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 [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: LONG POINTER TO 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 ← zone.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]; 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: SEIndex = 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]};

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: SEIndex, 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};

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 = 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 [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.ErrorHti[noAccess, hti]};

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 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;

type: CSEIndex;

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 ← 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] = {

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 [hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOL]

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

tSei: CSEIndex;

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 ← VariantUnionType[rSei];

WITH seb[tSei] SELECT FROM

union => {

IF ~suffixed AND ~controlled AND overlaid THEN {

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

IF ~found THEN sei ← match;

nHits ← nHits + n};

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

sequence => {

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

ENDCASE => NULL};

RETURN};

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

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

vSei: ISEIndex;

rSei: SEIndex;

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[hti, LOOPHOLE[rSei], 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;

suffixed: BOOL;

rSei ← type; suffixed ← 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];

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

IF ctxIdTable[i].ctx = IncludedCTXNull THEN {ctxIdTable[i] ← [ctx, list]; EXIT};

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 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 [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: CARDINAL = 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: CARDINAL = 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: 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: CSEIndex]

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.ErrorTree[unsafeOperation, t];

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: CSEIndex] 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, nType: CSEIndex;

OpenRecord: PROC [indirect: BOOL] = {

WITH seb[type] SELECT FROM

record => {

v ← BaseTree[v, vType];

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

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

ENDCASE => IF type # 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 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: 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]};