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