TreeOpsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 18, 1989 1:01:01 pm PDT
Satterthwaite, June 18, 1986 12:19:19 pm PDT
Sweet June 4, 1986 9:48:04 am PDT
DIRECTORY
Alloc USING [AddNotify, DropNotify, FreeChunk, GetChunk, Handle, Notifier],
Literals USING [LTIndex, STIndex],
MimZones USING [RegisterForReset, tempZone],
OSMiscOps USING [Copy],
Symbols USING [HTIndex, ISEIndex],
Tree USING [AttrId, Base, Finger, Id, Index, Info, Link, LinkRep, LinkTag, Map, Node, NodeName, Null, nullIndex, nullInfo, Scan, SubInfo, Test, treeType],
TreeOps USING [GetTag];
TreeOpsImpl: PROGRAM
IMPORTS Alloc, MimZones, OSMiscOps, TreeOps
EXPORTS TreeOps = {
initialized: BOOL ¬ FALSE;
table: PRIVATE Alloc.Handle;
LinkSeq: TYPE = RECORD [SEQUENCE length: CARDINAL OF Tree.Link];
LinkStack: TYPE = REF LinkSeq;
defaultStackSize: NAT = 250;
stack: LinkStack;
sI: CARDINAL;
tb: Tree.Base;  -- tree base
UpdateBase: Alloc.Notifier = {tb ¬ base[Tree.treeType]};
Initialize: PUBLIC PROC [ownTable: Alloc.Handle] = {
IF initialized THEN Finalize[];
stack ¬ MimZones.tempZone.NEW[LinkSeq[defaultStackSize]];
sI ¬ 0;
table ¬ ownTable;
table.AddNotify[UpdateBase];
IF MakeNode[$none,0] # Tree.Null THEN ERROR; -- reserve null
initialized ¬ TRUE;
};
Reset: PUBLIC PROC = {
IF stack = NIL OR stack.length > defaultStackSize THEN {
IF stack # NIL THEN MimZones.tempZone.FREE[@stack];
stack ¬ MimZones.tempZone.NEW[LinkSeq[defaultStackSize]];
sI ¬ 0;
};
};
Finalize: PUBLIC PROC = {
IF table # NIL THEN {table.DropNotify[UpdateBase]; table ¬ NIL};
MimZones.tempZone.FREE[@stack];
initialized ¬ FALSE;
};
ExpandStack: PROC = {
len: NAT = stack.length;
newStack: LinkStack = MimZones.tempZone.NEW[LinkSeq[len + defaultStackSize]];
IF len > 0 THEN
OSMiscOps.Copy[
from: @stack[0],
nwords: WORDS[LinkSeq[len]] - WORDS[LinkSeq[0]],
to: @newStack[0]];
MimZones.tempZone.FREE[@stack];
stack ¬ newStack;
};
PushTree: PUBLIC PROC [v: Tree.Link] = {
IF sI >= stack.length THEN ExpandStack[];
stack[sI] ¬ v;
sI ¬ sI+1;
};
PopTree: PUBLIC PROC RETURNS [Tree.Link] = {
RETURN [stack[sI¬sI-1]];
};
InsertTree: PUBLIC PROC [v: Tree.Link, n: CARDINAL] = {
i: CARDINAL;
IF sI >= stack.length THEN ExpandStack[];
i ¬ sI;
sI ¬ sI + 1;
THROUGH [1 .. n) DO stack[i] ¬ stack[i-1]; i ¬ i-1 ENDLOOP;
stack[i] ¬ v;
};
ExtractTree: PUBLIC PROC [n: CARDINAL] RETURNS [v: Tree.Link] = {
i: CARDINAL ¬ sI - n;
v ¬ stack[i];
THROUGH [1 .. n) DO stack[i] ¬ stack[i+1]; i ¬ i+1 ENDLOOP;
sI ¬ sI - 1;
RETURN [v];
};
MakeNode: PUBLIC PROC [name: Tree.NodeName, count: INTEGER] RETURNS [Tree.Link] = {
PushNode[name, count];
RETURN [PopTree[]];
};
MakeList: PUBLIC PROC [size: INTEGER] RETURNS [Tree.Link] = {
PushList[size];
RETURN [PopTree[]];
};
PushNode: PUBLIC PROC [name: Tree.NodeName, count: INTEGER] = {
nSons: NAT = count.ABS;
units: NAT = Tree.Node[nSons].SIZE;
node: Tree.Index = table.GetChunk[units, Tree.treeType];
tp: LONG POINTER TO Tree.Node = @tb[node];
tp.name ¬ name;
tb[node].nSons ¬ nSons;
IF count >= 0
THEN
FOR i: NAT ¬ nSons, i-1 WHILE i >= 1 DO tb[node].son[i] ¬ stack[sI¬sI-1] ENDLOOP
ELSE
FOR i: NAT ¬ 1, i+1 WHILE i <= nSons DO tb[node].son[i] ¬ stack[sI¬sI-1] ENDLOOP;
IF sI >= stack.length THEN ExpandStack[];
stack[sI] ¬ [subtree[index: node]];
sI ¬ sI+1;
};
PushList: PUBLIC PROC [size: INTEGER] = {
nSons: CARDINAL = size.ABS;
node: Tree.Index;
SELECT nSons FROM
1 => NULL;
0 => PushTree[Tree.Null];
ENDCASE => {
node ¬ table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
tb[node].name ¬ $list;
tb[node].info ¬ Tree.nullInfo; tb[node].shared ¬ FALSE;
tb[node].attr1 ¬ tb[node].attr2 ¬ tb[node].attr3 ¬ FALSE;
tb[node].nSons ¬ nSons;
IF size > 0
THEN
FOR i: NAT ¬ nSons, i-1 WHILE i >= 1 DO
tb[node].son[i] ¬ stack[sI¬sI-1];
ENDLOOP
ELSE
FOR i: NAT ¬ 1, i+1 WHILE i <= nSons DO
tb[node].son[i] ¬ stack[sI¬sI-1];
ENDLOOP;
IF sI >= stack.length THEN ExpandStack[];
stack[sI] ¬ [subtree[index: node]];
sI ¬ sI+1;
}
};
PushProperList: PUBLIC PROC [size: INTEGER] = {
IF size IN [-1..1] THEN PushNode[$list, size] ELSE PushList[size];
};
PushHash: PUBLIC PROC [hti: Symbols.HTIndex] = {PushTree[[hash[index: hti]]]};
PushSe: PUBLIC PROC [sei: Symbols.ISEIndex] = {PushTree[[symbol[index: sei]]]};
PushLit: PUBLIC PROC [lti: Literals.LTIndex] = {PushTree[[literal[index: lti]]]};
PushString: PUBLIC PROC [sti: Literals.STIndex] = {PushTree[[string[index: sti]]]};
SetInfo: PUBLIC PROC [info: Tree.Info] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
subtree => IF v # Tree.Null THEN tb[v.index].info ¬ info;
ENDCASE
};
SetSubInfo: PUBLIC PROC [subInfo: Tree.SubInfo] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
subtree => IF v # Tree.Null THEN tb[v.index].subInfo ¬ subInfo;
ENDCASE
};
SetAttr: PUBLIC PROC [attr: Tree.AttrId, value: BOOL] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
subtree => IF v # Tree.Null THEN {
SELECT attr FROM
1 => tb[v.index].attr1 ¬ value;
2 => tb[v.index].attr2 ¬ value;
3 => tb[v.index].attr3 ¬ value;
ENDCASE;
RETURN;
};
ENDCASE;
ERROR;
};
SetAttrs: PUBLIC PROC [attr1, attr2, attr3: BOOL] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
subtree => IF v # Tree.Null THEN {
tp: LONG POINTER TO Tree.Node = @tb[v.index];
tp.attr1 ¬ attr1;
tp.attr2 ¬ attr2;
tp.attr3 ¬ attr3;
RETURN;
};
ENDCASE;
ERROR;
};
Useful for debugging
suspect: Tree.Index ¬ Tree.nullIndex;
SuspectFound: SIGNAL = CODE;
neverFree: BOOL ¬ FALSE;
FreeNode: PUBLIC PROC [node: Tree.Index] = {
IF neverFree THEN RETURN;
IF node = Tree.nullIndex THEN RETURN;
IF node = suspect THEN SIGNAL SuspectFound;
IF NOT tb[node].shared THEN {
n: NAT ¬ tb[node].nSons;
FOR i: NAT IN [1..n] DO
t: Tree.Link ¬ tb[node].son[i];
WITH v: t SELECT TreeOps.GetTag[t] FROM
subtree => FreeNode[v.index];
ENDCASE;
ENDLOOP;
table.FreeChunk[node, Tree.Node[n].SIZE, Tree.treeType];
}
};
FreeTree: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
IF neverFree THEN RETURN [Tree.Null];
WITH t SELECT TreeOps.GetTag[t] FROM subtree => FreeNode[index] ENDCASE;
RETURN [Tree.Null];
};
procedures for tree testing
IsTree: PROC [t: Tree.Link] RETURNS [BOOL] = INLINE {
RETURN [TreeOps.GetTag[t] = Tree.LinkTag.subtree];
};
Narrow: PROC [t: Tree.Link] RETURNS [Tree.Index] = INLINE {
IF TreeOps.GetTag[t] # Tree.LinkTag.subtree THEN ERROR;
RETURN [LOOPHOLE[t]];
};
GetHash: PUBLIC PROC [t: Tree.Link] RETURNS [Symbols.HTIndex] = {
IF TreeOps.GetTag[t] # Tree.LinkTag.hash THEN ERROR;
RETURN [LOOPHOLE[t]];
};
GetNode: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Index] = {
RETURN [Narrow[t]];
};
GetSe: PUBLIC PROC [t: Tree.Link] RETURNS [Symbols.ISEIndex] = {
IF TreeOps.GetTag[t] # Tree.LinkTag.symbol THEN ERROR;
RETURN [LOOPHOLE[t]];
};
GetLit: PUBLIC PROC [t: Tree.Link] RETURNS [Literals.LTIndex] = {
IF TreeOps.GetTag[t] # Tree.LinkTag.literal THEN ERROR;
RETURN [LOOPHOLE[t]];
};
GetStr: PUBLIC PROC [t: Tree.Link] RETURNS [Literals.STIndex] = {
IF TreeOps.GetTag[t] # Tree.LinkTag.string THEN ERROR;
RETURN [LOOPHOLE[t]];
};
NthSon: PUBLIC PROC [t: Tree.Link, n: CARDINAL] RETURNS [Tree.Link] = {
IF t # Tree.Null THEN
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => RETURN [tb[index].son[n]];
ENDCASE;
ERROR;
};
OpName: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.NodeName] = {
IF t # Tree.Null THEN
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => RETURN [tb[index].name];
ENDCASE;
RETURN [$none];
};
GetAttr: PUBLIC PROC [t: Tree.Link, attr: Tree.AttrId] RETURNS [BOOL] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[e.index];
SELECT attr FROM
1 => RETURN [tp.attr1];
2 => RETURN [tp.attr2];
3 => RETURN [tp.attr3];
ENDCASE => ERROR
};
ENDCASE;
ERROR;
};
GetAttrs: PUBLIC PROC [t: Tree.Link] RETURNS [attr1, attr2, attr3: BOOL] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[e.index];
RETURN [tp.attr1, tp.attr2, tp.attr3];
};
ENDCASE;
ERROR;
};
PutAttr: PUBLIC PROC [t: Tree.Link, attr: Tree.AttrId, value: BOOL] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[e.index];
SELECT attr FROM
1 => tp.attr1 ¬ value;
2 => tp.attr2 ¬ value;
3 => tp.attr3 ¬ value;
ENDCASE => ERROR;
RETURN;
};
ENDCASE;
ERROR;
};
PutAttrs: PUBLIC PROC [t: Tree.Link, attr1, attr2, attr3: BOOL] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[e.index];
tp.attr1 ¬ attr1;
tp.attr2 ¬ attr2;
tp.attr3 ¬ attr3;
RETURN;
};
ENDCASE;
ERROR;
};
GetInfo: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Info] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => RETURN [tb[e.index].info];
ENDCASE;
ERROR;
};
PutInfo: PUBLIC PROC [t: Tree.Link, value: Tree.Info] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {tb[e.index].info ¬ value; RETURN};
ENDCASE;
ERROR;
};
GetSubInfo: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.SubInfo] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => RETURN [tb[e.index].subInfo];
ENDCASE;
ERROR;
};
PutSubInfo: PUBLIC PROC [t: Tree.Link, subInfo: Tree.SubInfo] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => {tb[e.index].subInfo ¬ subInfo; RETURN};
ENDCASE;
ERROR;
};
Shared: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] = {
IF t # Tree.Null THEN
WITH e: t SELECT TreeOps.GetTag[t] FROM
subtree => RETURN [tb[e.index].shared];
ENDCASE;
RETURN [FALSE];
};
MarkShared: PUBLIC PROC [t: Tree.Link, shared: BOOL] = {
WITH s: t SELECT TreeOps.GetTag[t] FROM
subtree => IF s # Tree.Null THEN tb[s.index].shared ¬ shared;
ENDCASE
};
procedures for tree traversal
ScanSons: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
action[tb[node].son[i]] ENDLOOP};
ENDCASE;
};
UpdateLeaves: PUBLIC PROC [root: Tree.Link, map: Tree.Map] RETURNS [v: Tree.Link] = {
v ¬ root;
IF root # Tree.Null THEN
WITH e: root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = e.index;
FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
tb[node].son[i] ¬ map[tb[node].son[i]];
ENDLOOP;
};
ENDCASE => v ¬ map[root];
};
procedures for list testing
ListLength: PUBLIC PROC [t: Tree.Link] RETURNS [CARDINAL] = {
IF t = Tree.Null THEN RETURN [0];
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[index];
IF tp.name = list THEN RETURN [tp.nSons];
};
ENDCASE;
RETURN [1];
};
ListHead: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
IF t # Tree.Null THEN
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[index];
IF tp.name = list THEN
IF tp.nSons # 0 THEN RETURN [tp.son[1]] ELSE RETURN [Tree.Null];
};
ENDCASE;
RETURN [t];
};
ListTail: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
IF t # Tree.Null THEN
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: LONG POINTER TO Tree.Node = @tb[index];
IF tp.name = list THEN
IF tp.nSons # 0 THEN RETURN [tp.son[tp.nSons]] ELSE RETURN [Tree.Null];
};
ENDCASE;
RETURN [t];
};
procedures for list traversal
ScanList: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL IN [1..tb[node].nSons] DO action[tb[node].son[i]] ENDLOOP
ELSE action[root]};
ENDCASE => action[root]
};
ReverseScanList: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL DECREASING IN [1..tb[node].nSons] DO
action[tb[node].son[i]] ENDLOOP
ELSE action[root]};
ENDCASE => action[root]
};
SearchList: PUBLIC PROC [root: Tree.Link, test: Tree.Test] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL IN [1..tb[node].nSons] DO
IF test[tb[node].son[i]] THEN RETURN;
ENDLOOP;
};
ENDCASE;
[] ¬ test[root];
};
UpdateList: PUBLIC PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = {
IF root = Tree.Null THEN RETURN [Tree.Null];
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN {
FOR i: CARDINAL IN [1..tb[node].nSons] DO
tb[node].son[i] ¬ map[tb[node].son[i]];
ENDLOOP;
RETURN [root];
};
};
ENDCASE;
RETURN [map[root]];
};
ReverseUpdateList: PUBLIC PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = {
IF root = Tree.Null THEN RETURN [Tree.Null];
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name # $list THEN RETURN [map[root]];
FOR i: CARDINAL DECREASING IN [1..ListLength[root]] DO
tb[node].son[i] ¬ map[tb[node].son[i]];
ENDLOOP;
RETURN [root]};
ENDCASE => RETURN [map[root]] 
};
cross-table tree manipulation
CopyTree: PUBLIC PROC [root: Tree.Id, map: Tree.Map] RETURNS [v: Tree.Link] = {
WITH root.link SELECT TreeOps.GetTag[root.link] FROM
subtree => {
sNode: Tree.Index = index;
IF sNode = Tree.nullIndex
THEN v ¬ Tree.Null
ELSE {
nSons: NAT = root.baseP­[sNode].nSons;
dNode: Tree.Index = table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
OSMiscOps.Copy[
from: @root.baseP­[sNode],
nwords: Tree.Node[0].WORDS,
to: @tb[dNode] ];
tb[dNode].shared ¬ FALSE;
FOR i: CARDINAL IN [1..nSons] DO
tb[dNode].son[i] ¬ map[root.baseP­[sNode].son[i]];
ENDLOOP;
v ¬ [subtree[index: dNode]];
};
};
ENDCASE => v ¬ map[root.link];
};
IdentityMap: PUBLIC Tree.Map = {
RETURN [IF IsTree[t] AND ~Shared[t]
THEN CopyTree[[baseP:@tb, link:t], IdentityMap]
ELSE t];
};
NodeSize: PUBLIC PROC
[baseP: Tree.Finger, node: Tree.Index] RETURNS [size: CARDINAL ¬ 0] = {
IF node # Tree.nullIndex THEN size ¬ Tree.Node[baseP­[node].nSons].SIZE;
};
initialization
MimZones.RegisterForReset[Finalize];
}.