-- file TreePack.Mesa
-- last modified by Satterthwaite, November 15, 1978 3:25 PM
DIRECTORY
SystemDefs: FROM "systemdefs" USING
[AllocateSegment, FreeSegment, SegmentSize],
Table: FROM "table" USING
[Base, Finger, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
Literals: FROM "literals" USING [LTIndex, STIndex],
Symbols: FROM "symbols" USING [HTIndex, ISEIndex],
Tree: FROM "tree" USING [
Id, Index, Link, Map, Node, NodeName, Scan, Test,
MaxNSons, Null, NullIndex, treeType],
TreeOps: FROM "treeops";
TreePack: PROGRAM
IMPORTS SystemDefs, Table
EXPORTS TreeOps =
PUBLIC
BEGIN
EndIndex: Tree.Index = LAST[Tree.Index];
EndMark: Tree.Link = [subtree[index: EndIndex]];
initialized: PRIVATE BOOLEAN ← FALSE;
LinkStack: PRIVATE TYPE = DESCRIPTOR FOR ARRAY OF Tree.Link;
stack: PRIVATE LinkStack;
sI: PRIVATE CARDINAL;
tb: PRIVATE Table.Base; -- tree base
UpdateBase: PRIVATE Table.Notifier = BEGIN tb ← base[Tree.treeType] END;
Initialize: PROCEDURE =
BEGIN
IF initialized THEN Finalize[];
stack ← AllocStack[256]; sI ← 0;
Table.AddNotify[UpdateBase];
IF MakeNode[none,0] # Tree.Null THEN ERROR; -- reserve null
initialized ← TRUE; RETURN
END;
Finalize: PROCEDURE =
BEGIN
initialized ← FALSE;
Table.DropNotify[UpdateBase]; FreeStack[stack]; RETURN
END;
AllocStack: PRIVATE PROCEDURE [size: CARDINAL] RETURNS [s: LinkStack] =
BEGIN
base: POINTER;
base ← SystemDefs.AllocateSegment[size*SIZE[Tree.Link]];
s ← DESCRIPTOR[base, SystemDefs.SegmentSize[base]/SIZE[Tree.Link]];
RETURN
END;
FreeStack: PRIVATE PROCEDURE [s: LinkStack] =
BEGIN
IF LENGTH[s] # 0 THEN SystemDefs.FreeSegment[BASE[s]];
RETURN
END;
ExpandStack: PRIVATE PROCEDURE =
BEGIN
newStack: LinkStack;
i: CARDINAL;
newStack ← AllocStack[LENGTH[stack]+256];
FOR i IN [0 .. LENGTH[stack]) DO newStack[i] ← stack[i] ENDLOOP;
FreeStack[stack]; stack ← newStack; RETURN
END;
PushTree: PROCEDURE [v: Tree.Link] =
BEGIN
IF sI >= LENGTH[stack] THEN ExpandStack[];
stack[sI] ← v; sI ← sI+1; RETURN
END;
PopTree: PROCEDURE RETURNS [Tree.Link] =
BEGIN
RETURN [stack[sI←sI-1]]
END;
InsertTree: PROCEDURE [v: Tree.Link, n: CARDINAL] =
BEGIN
i: CARDINAL;
IF sI >= LENGTH[stack] THEN ExpandStack[];
i ← sI; sI ← sI+1;
THROUGH [1 .. n) DO stack[i] ← stack[i-1]; i ← i-1 ENDLOOP;
stack[i] ← v;
RETURN
END;
ExtractTree: PROCEDURE [n: CARDINAL] RETURNS [v: Tree.Link] =
BEGIN
i: CARDINAL;
i ← sI - n; v ← stack[i];
THROUGH [1 .. n) DO stack[i] ← stack[i+1]; i ← i+1 ENDLOOP;
sI ← sI - 1;
RETURN [v]
END;
MakeNode: PROCEDURE [name: Tree.NodeName, count: INTEGER] RETURNS [Tree.Link] =
BEGIN
PushNode[name, count]; RETURN [PopTree[]]
END;
MakeList: PROCEDURE [size: INTEGER] RETURNS [Tree.Link] =
BEGIN
PushList[size]; RETURN [PopTree[]]
END;
PushNode: PROCEDURE [name: Tree.NodeName, count: INTEGER] =
BEGIN
nSons: CARDINAL = ABS[count];
node: Tree.Index = Table.GetChunk[SIZE[Tree.Node]+nSons];
i: CARDINAL;
tb[node].name ← name; tb[node].nSons ← nSons;
tb[node].info ← 0; tb[node].shared ← FALSE;
tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
IF count >= 0
THEN FOR i ← nSons, i-1 WHILE i >= 1
DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP
ELSE FOR i ← 1, i+1 WHILE i <= nSons
DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP;
IF sI >= LENGTH[stack] THEN ExpandStack[];
stack[sI] ← Tree.Link[subtree[index: node]]; sI ← sI+1; RETURN
END;
PushList: PROCEDURE [size: INTEGER] =
BEGIN
nSons: CARDINAL = ABS[size];
node: Tree.Index;
i: CARDINAL;
SELECT nSons FROM
1 => NULL;
0 => PushTree[Tree.Null];
ENDCASE =>
BEGIN
IF nSons IN (0..Tree.MaxNSons]
THEN node ← Table.GetChunk[SIZE[Tree.Node]+nSons]
ELSE
BEGIN
node ← Table.GetChunk[SIZE[Tree.Node]+(nSons+1)];
tb[node].son[nSons+1] ← EndMark;
END;
tb[node].name ← list;
tb[node].info ← 0; tb[node].shared ← FALSE;
tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
tb[node].nSons ← IF nSons IN (0..Tree.MaxNSons] THEN nSons ELSE 0;
IF size > 0
THEN FOR i ← nSons, i-1 WHILE i >= 1
DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP
ELSE FOR i ← 1, i+1 WHILE i <= nSons
DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP;
IF sI >= LENGTH[stack] THEN ExpandStack[];
stack[sI] ← Tree.Link[subtree[index: node]]; sI ← sI+1;
END;
RETURN
END;
PushProperList: PROCEDURE [size: INTEGER] =
BEGIN
node: Tree.Index;
IF size ~IN [-1..1]
THEN PushList[size]
ELSE
BEGIN
node ← Table.GetChunk[SIZE[Tree.Node] + 1];
tb[node].name ← list;
tb[node].info ← 0; tb[node].shared ← FALSE;
tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
tb[node].nSons ← ABS[size];
tb[node].son[1] ← IF size = 0 THEN EndMark ELSE PopTree[];
PushTree[Tree.Link[subtree[index: node]]];
END;
RETURN
END;
PushHash: PROCEDURE [hti: Symbols.HTIndex] =
BEGIN
PushTree[Tree.Link[hash[index: hti]]]; RETURN
END;
PushSe: PROCEDURE [sei: Symbols.ISEIndex] =
BEGIN
PushTree[Tree.Link[symbol[index: sei]]]; RETURN
END;
PushLit: PROCEDURE [lti: Literals.LTIndex] =
BEGIN
PushTree[Tree.Link[literal[info: [word[lti]]]]]; RETURN
END;
PushStringLit: PROCEDURE [sti: Literals.STIndex] =
BEGIN
PushTree[Tree.Link[literal[info: [string[sti]]]]]; RETURN
END;
SetInfo: PROCEDURE [info: UNSPECIFIED] =
BEGIN
v: Tree.Link = stack[sI-1];
IF v # Tree.Null THEN
WITH v SELECT FROM
subtree => tb[index].info ← info;
ENDCASE => NULL;
RETURN
END;
SetAttr: PROCEDURE [attr: [1..3], value: BOOLEAN] =
BEGIN
v: Tree.Link = stack[sI-1];
node: Tree.Index;
IF v = Tree.Null
THEN ERROR
ELSE
WITH v SELECT FROM
subtree =>
BEGIN node ← index;
SELECT attr FROM
1 => tb[node].attr1 ← value;
2 => tb[node].attr2 ← value;
3 => tb[node].attr3 ← value;
ENDCASE;
END;
ENDCASE => ERROR;
RETURN
END;
FreeNode: PROCEDURE [node: Tree.Index] =
BEGIN
i: CARDINAL;
n: CARDINAL;
t: Tree.Link;
IF node # Tree.NullIndex AND ~tb[node].shared
THEN
BEGIN n ← tb[node].nSons;
IF tb[node].name # list OR n # 0
THEN
FOR i ← 1, i+1 WHILE i <= n
DO
t ← tb[node].son[i];
WITH t SELECT FROM subtree => FreeNode[index]; ENDCASE;
ENDLOOP
ELSE
BEGIN n ← 1;
FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = EndMark
DO
WITH t SELECT FROM subtree => FreeNode[index]; ENDCASE;
n ← n+1;
ENDLOOP;
END;
Table.FreeChunk[node, SIZE[Tree.Node]+n];
END;
RETURN
END;
FreeTree: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
WITH t SELECT FROM subtree => FreeNode[index]; ENDCASE;
RETURN [Tree.Null]
END;
-- procedures for tree testing
GetNode: PROCEDURE [t: Tree.Link] RETURNS [Tree.Index] =
BEGIN
WITH t SELECT FROM subtree => RETURN [index]; ENDCASE => ERROR
END;
Shared: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
BEGIN
RETURN [WITH t SELECT FROM
subtree => IF index = Tree.NullIndex THEN FALSE ELSE tb[index].shared,
ENDCASE => FALSE]
END;
SetShared: PROCEDURE [t: Tree.Link, shared: BOOLEAN] =
BEGIN
WITH t SELECT FROM
subtree => IF index # Tree.NullIndex THEN tb[index].shared ← shared;
ENDCASE;
RETURN
END;
TestTree: PROCEDURE [t: Tree.Link, name: Tree.NodeName] RETURNS [BOOLEAN] =
BEGIN
RETURN [IF t = Tree.Null
THEN FALSE
ELSE
WITH t SELECT FROM subtree => tb[index].name = name, ENDCASE => FALSE]
END;
SonCount: PRIVATE PROCEDURE [node: Tree.Index] RETURNS [CARDINAL] =
BEGIN
RETURN [SELECT node FROM
Tree.NullIndex, EndIndex => 0,
ENDCASE => IF tb[node].name = list AND tb[node].nSons = 0
THEN ListLength[Tree.Link[subtree[index: node]]] + 1
ELSE tb[node].nSons]
END;
-- procedures for tree traversal
UpdateTree: PROCEDURE [root: Tree.Link, map: Tree.Map] RETURNS [v: Tree.Link] =
BEGIN
node: Tree.Index;
i: CARDINAL;
t: Tree.Link;
IF root = Tree.Null
THEN v ← Tree.Null
ELSE
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
FOR i IN [1 .. SonCount[node]]
DO
IF (t←tb[node].son[i]) # EndMark THEN tb[node].son[i] ← map[t];
ENDLOOP;
v ← root;
END;
ENDCASE => v ← map[root];
RETURN
END;
-- procedures for list testing
ListLength: PROCEDURE [t: Tree.Link] RETURNS [CARDINAL] =
BEGIN
node: Tree.Index;
i: CARDINAL;
n: CARDINAL;
IF t = Tree.Null THEN RETURN [0];
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list THEN RETURN [1];
n ← tb[node].nSons;
IF n # 0 THEN RETURN [n];
FOR i ← 1, i+1 UNTIL tb[node].son[i] = EndMark
DO n ← n+1 ENDLOOP;
RETURN [n]
END;
ENDCASE => RETURN [1]
END;
ListHead: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index;
IF t = Tree.Null THEN ERROR;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list THEN RETURN [t];
IF tb[node].son[1] # EndMark THEN RETURN [tb[node].son[1]];
ERROR
END;
ENDCASE => RETURN [t]
END;
ListTail: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index;
IF t = Tree.Null THEN ERROR;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list THEN RETURN [t];
IF tb[node].son[1] # EndMark
THEN RETURN [tb[node].son[ListLength[t]]];
ERROR
END;
ENDCASE => RETURN [t]
END;
-- procedures for list traversal
ScanList: PROCEDURE [root: Tree.Link, action: Tree.Scan] =
BEGIN
node: Tree.Index;
i, n: CARDINAL;
t: Tree.Link;
IF root # Tree.Null
THEN
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list
THEN action[root]
ELSE
IF (n ← tb[node].nSons) # 0
THEN FOR i ← 1, i+1 WHILE i <= n
DO action[tb[node].son[i]] ENDLOOP
ELSE FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = EndMark
DO action[t] ENDLOOP;
END;
ENDCASE => action[root];
RETURN
END;
ReverseScanList: PROCEDURE [root: Tree.Link, action: Tree.Scan] =
BEGIN
node: Tree.Index;
i: CARDINAL;
IF root # Tree.Null
THEN
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list
THEN action[root]
ELSE
FOR i DECREASING IN [1 .. ListLength[root]]
DO action[tb[node].son[i]] ENDLOOP;
END;
ENDCASE => action[root];
RETURN
END;
SearchList: PROCEDURE [root: Tree.Link, test: Tree.Test] =
BEGIN
node: Tree.Index;
i, n: CARDINAL;
t: Tree.Link;
IF root # Tree.Null
THEN
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list
THEN [] ← test[root]
ELSE
IF (n ← tb[node].nSons) # 0
THEN FOR i ← 1, i+1 WHILE i <= n
DO IF test[tb[node].son[i]] THEN EXIT ENDLOOP
ELSE FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = EndMark
DO IF test[t] THEN EXIT ENDLOOP;
END;
ENDCASE => [] ← test[root];
RETURN
END;
UpdateList: PROCEDURE [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index;
i, n: CARDINAL;
t: Tree.Link;
IF root = Tree.Null THEN RETURN [Tree.Null];
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list THEN RETURN [map[root]];
IF (n ← tb[node].nSons) # 0
THEN FOR i ← 1, i+1 WHILE i <= n
DO tb[node].son[i] ← map[tb[node].son[i]] ENDLOOP
ELSE FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = EndMark
DO tb[node].son[i] ← map[t] ENDLOOP;
RETURN [root]
END;
ENDCASE => RETURN [map[root]];
END;
ReverseUpdateList: PROCEDURE [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index;
i: CARDINAL;
IF root = Tree.Null THEN RETURN [Tree.Null];
WITH root SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name # list THEN RETURN [map[root]];
FOR i DECREASING IN [1..ListLength[root]]
DO tb[node].son[i] ← map[tb[node].son[i]] ENDLOOP;
RETURN [root]
END;
ENDCASE => RETURN [map[root]];
END;
-- cross-table tree manipulation
CopyTree: PROCEDURE [root: Tree.Id, map: Tree.Map] RETURNS [v: Tree.Link] =
BEGIN
sNode, dNode: Tree.Index;
size: CARDINAL;
i: CARDINAL;
t: Tree.Link;
WITH root.link SELECT FROM
subtree =>
BEGIN sNode ← index;
IF sNode = Tree.NullIndex
THEN v ← Tree.Null
ELSE
BEGIN
size ← NodeSize[root.baseP, sNode];
dNode ← Table.GetChunk[size];
tb[dNode].name ← root.baseP↑[sNode].name;
tb[dNode].shared ← FALSE;
tb[dNode].nSons ← root.baseP↑[sNode].nSons;
tb[dNode].info ← root.baseP↑[sNode].info;
tb[dNode].attr1 ← root.baseP↑[sNode].attr1;
tb[dNode].attr2 ← root.baseP↑[sNode].attr2;
tb[dNode].attr3 ← root.baseP↑[sNode].attr3;
FOR i IN [1..size-SIZE[Tree.Node]]
DO
tb[dNode].son[i] ← IF (t←root.baseP↑[sNode].son[i]) = EndMark
THEN EndMark
ELSE map[t];
ENDLOOP;
v ← [subtree[index: dNode]];
END;
END;
ENDCASE => v ← map[root.link];
RETURN
END;
IdentityMap: Tree.Map =
BEGIN
RETURN [IF t.tag = subtree AND ~Shared[t]
THEN CopyTree[[baseP:@tb, link:t], IdentityMap]
ELSE t]
END;
NodeSize: PROCEDURE [baseP: Table.Finger, node: Tree.Index] RETURNS [size: CARDINAL] =
BEGIN
i: CARDINAL;
IF node = Tree.NullIndex
THEN size ← 0
ELSE
IF baseP↑[node].name # list OR baseP↑[node].nSons # 0
THEN size ← SIZE[Tree.Node] + baseP↑[node].nSons
ELSE
BEGIN
size ← SIZE[Tree.Node] + 1;
FOR i ← 1, i+1 UNTIL baseP↑[node].son[i] = EndMark
DO size ← size + 1 ENDLOOP;
END;
RETURN
END;
END.