Attr3b.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, April 7, 1986 1:01:07 pm PST
Donahue, 10-Dec-81 11:23:00
Russ Atkinson (RRA) March 6, 1985 10:38:47 pm PST
DIRECTORY
A3: TYPE USING [AccessMode, CanonicalType, LhsMode, LifeTime],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [typeINT, typeSTRING],
P3: TYPE USING [phraseNP, RecordLhs, SetNP],
P3S: TYPE USING [currentBody],
Symbols: TYPE USING [Base, Type, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CBTIndex, CSENull, CTXNull, CBTNull, lG, lZ, typeANY, bodyType, ctxType, seType],
SymbolOps: TYPE USING [CtxLevel, XferMode],
Tree: TYPE USING [Base, Index, Link, NullIndex, treeType],
TreeOps: TYPE USING [GetInfo, ListLength, NthSon, OpName];
Attr3b: PROGRAM
IMPORTS A3, P3, P3S, SymbolOps, TreeOps, dataPtr: ComData
EXPORTS A3 = {
OPEN SymbolOps, Symbols, TreeOps, A: A3;
tb: Tree.Base; -- tree base address (local copy)
seb: Base; -- se table base address (local copy)
ctxb: Base; -- context table base address (local copy)
bb: Base; -- body table base address (local copy)
TreeNotify: PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType];
tb ← base[Tree.treeType]};
tree manipulation utilities
TypeForTree: PUBLIC PROC[t: Tree.Link] RETURNS[Type] = {
N.B. assumes t evaluated by P3.TypeLink or P3.Exp
RETURN[WITH t SELECT FROM
symbol => index,
subtree =>
SELECT tb[index].name FROM
cdot, discrimTC => TypeForTree[tb[index].son[2]],
ENDCASE => tb[index].info,
ENDCASE => typeANY]};
InterfaceVar: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE {
RETURN[WITH t SELECT FROM
symbol => (ctxb[seb[index].idCtx].ctxType = imported),
ENDCASE => FALSE]};
WritableRef: PROC[t: Tree.Link] RETURNS[A.LhsMode] = {
P3.phraseNP ← P3.SetNP[P3.phraseNP];
RETURN[A.AccessMode[A.CanonicalType[OperandType[t]]]]};
VarLhsMode: ARRAY A.LhsMode OF A.LhsMode = [
none: $none, uncounted: $counted, counted: $counted];
OperandLhs: PUBLIC PROC[t: Tree.Link] RETURNS[A.LhsMode] = {
WITH t SELECT FROM
symbol => {
sei: ISEIndex = index;
ctx: CTXIndex = seb[sei].idCtx;
level: ContextLevel;
IF ctx = CTXNull THEN level ← lZ
ELSE {
ctxb[ctx].varUpdated ← TRUE;
IF (level ← CtxLevel[ctx]) < P3S.currentBody.level THEN
P3.phraseNP ← P3.SetNP[P3.phraseNP]};
P3.RecordLhs[sei];
RETURN[SELECT TRUE FROM
seb[sei].immutable => $none,
(level = lG) => $counted,
ENDCASE => $uncounted]};
subtree => {
node: Tree.Index = index;
RETURN[IF node = Tree.NullIndex THEN $none ELSE
SELECT tb[node].name FROM
$dot =>
WITH tb[node].son[2] SELECT FROM
symbol =>
SELECT TRUE FROM
seb[index].immutable => $none,
(CtxLevel[seb[index].idCtx] = lG) =>
VarLhsMode[WritableRef[tb[node].son[1]]],
ENDCASE => WritableRef[tb[node].son[1]],
ENDCASE => none,
$uparrow =>
IF InterfaceVar[tb[node].son[1]]
THEN VarLhsMode[WritableRef[tb[node].son[1]]]
ELSE WritableRef[tb[node].son[1]],
$dindex => WritableRef[tb[node].son[1]],
$reloc => WritableRef[tb[node].son[2]],
$dollar =>
WITH tb[node].son[2] SELECT FROM
symbol =>
IF ~seb[index].immutable
THEN OperandLhs[tb[node].son[1]]
ELSE $none,
ENDCASE => $none,
$index, $seqindex, $loophole, $cast, $openx, $pad, $chop =>
OperandLhs[tb[node].son[1]],
$base, $length =>
IF ~tb[node].attr1 THEN $none ELSE OperandLhs[tb[node].son[1]],
$cdot => OperandLhs[tb[node].son[2]],
$apply => IF ListLength[tb[node].son[1]] = 1 THEN $uncounted ELSE $none,
ENDCASE => $none]};
ENDCASE => RETURN[$none]};
OperandInline: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
bti: CBTIndex;
RETURN[SELECT XferMode[OperandType[t]] FROM
$proc => (bti𡤋odyForTree[t]) # CBTNull AND bb[bti].inline,
ENDCASE => FALSE]};
OperandLevel: PUBLIC PROC[t: Tree.Link] RETURNS[level: A.LifeTime] = {
SELECT OpName[t] FROM
$cdot, $nil => level ← $global;
ENDCASE => {
bti: CBTIndex = BodyForTree[t];
level ← SELECT TRUE FROM
(bti = CBTNull) => $unknown,
(bb[bti].level <= lG+1) => $global,
ENDCASE => $local};
RETURN};
OperandInternal: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
WITH t SELECT FROM
symbol => {
bti: CBTIndex = BodyForTree[t];
RETURN[bti # CBTNull AND bb[bti].internal]};
subtree =>
RETURN[SELECT OpName[t] FROM
$dot, $cdot, $assignx => OperandInternal[NthSon[t, 2]],
$ifx => OperandInternal[NthSon[t, 2]] OR OperandInternal[NthSon[t, 3]],
ENDCASE => FALSE]; -- should check casex, bindx also
ENDCASE => RETURN[FALSE]};
OperandType: PUBLIC PROC[t: Tree.Link] RETURNS[Type] = {
RETURN[WITH e:t SELECT FROM
symbol => seb[e.index].idType,
literal =>
WITH e.index SELECT FROM
string => dataPtr.typeSTRING,
ENDCASE => dataPtr.typeINT,
subtree => tb[e.index].info,
ENDCASE => CSENull]
};
LongPath: PUBLIC PROC[t: Tree.Link] RETURNS[long: BOOL] = {
WITH t SELECT FROM
subtree => {
node: Tree.Index = index;
long ← IF node = Tree.NullIndex
THEN FALSE
ELSE SELECT tb[node].name FROM
$loophole, $cast, $openx, $pad, $chop => LongPath[tb[node].son[1]],
-- $dot, $uparrow, $dindex, $reloc, $seqindex, $dollar, $index => --
ENDCASE => tb[node].attr2};
ENDCASE => long ← FALSE;
RETURN};
BodyForTree: PUBLIC PROC[t: Tree.Link] RETURNS[CBTIndex] = {
node: Tree.Index;
WITH t SELECT FROM
symbol => {
sei: ISEIndex = index;
SELECT TRUE FROM
seb[sei].mark4 =>
RETURN[IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull];
seb[sei].immutable => {
node ← seb[sei].idValue;
IF OpName[tb[node].son[3]] = $body THEN RETURN[GetInfo[tb[node].son[3]]]};
ENDCASE};
subtree => {
node ← index;
SELECT tb[node].name FROM
$cdot, $dot, $dollar => RETURN[BodyForTree[tb[node].son[2]]];
ENDCASE};
ENDCASE;
RETURN[CBTNull]};
}.