From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Fri, 5 Nov 1993 00:47:50 +0000 (+0000)
Subject: Separate AVL tree code from primutl.c and make it into a separate
X-Git-Tag: 20090517-FFI~7596
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e99dc069f20c9db244cf2f6b973241fa79b74143;p=mit-scheme.git

Separate AVL tree code from primutl.c and make it into a separate
utilities file (avltree.[ch]) for use by other parts, in particular
the C back end code block management.
---

diff --git a/v7/src/microcode/dosutl/makefile b/v7/src/microcode/dosutl/makefile
index 3ac690db6..492bac1f0 100644
--- a/v7/src/microcode/dosutl/makefile
+++ b/v7/src/microcode/dosutl/makefile
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-###	$Id: makefile,v 1.9 1993/08/23 01:42:02 gjr Exp $
+###	$Id: makefile,v 1.10 1993/11/05 00:46:57 gjr Exp $
 ###
 ###	Copyright (c) 1992-1993 Massachusetts Institute of Technology
 ###
@@ -75,6 +75,7 @@ SCHEME_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(TERMCAP_LIBS) -lm
 CORE_SOURCES = \
 $(MACHINE_SOURCES) \
 artutl.c \
+avltree.c \
 bignum.c \
 bigprm.c \
 bitstr.c \
@@ -190,6 +191,7 @@ HEAD_FILES = scheme.tch prims.h zones.h locks.h bignum.h \
 CORE_OBJECTS = \
 $(MACHINE_OBJECTS) \
 artutl.obj \
+avltree.obj \
 bignum.obj \
 bigprm.obj \
 bitstr.obj \
@@ -328,7 +330,8 @@ foo $(USER_PRIM_OBJECTS) : $(HEAD_FILES)
 interp.obj : scheme.tch locks.h trap.h lookup.h history.h cmpint.h zones.h prmcon.h
 hooks.obj : scheme.tch prims.h winder.h history.h
 utils.obj : scheme.tch prims.h winder.h history.h cmpint.h syscall.h
-primutl.obj : scheme.tch prims.h prename.h syscall.h
+primutl.obj : scheme.tch os.h prims.h usrdef.h prename.h syscall.h \
+	avltree.h $(GC_HEAD_FILES)
 hunk.obj list.obj step.obj vector.obj sysprim.obj daemon.obj prim.obj extern.obj : \
 	scheme.tch prims.h
 lookup.obj debug.obj intern.obj : scheme.tch prims.h lookup.h trap.h locks.h
@@ -342,6 +345,7 @@ purify.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
 purutl.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
 comutl.obj : scheme.tch prims.h
 artutl.obj : scheme.tch
+avltree.obj : ansidecl.h avltree.h
 bignum.obj : scheme.tch bignmint.h limits.h
 bigprm.obj flonum.obj intprm.obj : scheme.tch prims.h zones.h
 generic.obj : scheme.tch prims.h
diff --git a/v7/src/microcode/ntutl/makefile b/v7/src/microcode/ntutl/makefile
index 95cc590e3..6f514fd8d 100644
--- a/v7/src/microcode/ntutl/makefile
+++ b/v7/src/microcode/ntutl/makefile
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-###	$Id: makefile,v 1.13 1993/09/20 17:07:55 gjr Exp $
+###	$Id: makefile,v 1.14 1993/11/05 00:47:50 gjr Exp $
 ###
 ###	Copyright (c) 1992-1993 Massachusetts Institute of Technology
 ###
@@ -87,6 +87,7 @@ SCHEME_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(TERMCAP_LIBS) -lm
 CORE_SOURCES = \
 $(MACHINE_SOURCES) \
 artutl.c \
+avltree.c \
 bignum.c \
 bigprm.c \
 bitstr.c \
@@ -193,6 +194,7 @@ HEAD_FILES = scheme.tch prims.h zones.h locks.h bignum.h \
 CORE_OBJECTS = \
 $(MACHINE_OBJECTS) \
 artutl.obj \
+avltree.obj \
 bignum.obj \
 bigprm.obj \
 bitstr.obj \
@@ -347,7 +349,8 @@ interp.obj : scheme.tch locks.h trap.h lookup.h history.h cmpint.h zones.h prmco
 
 hooks.obj : scheme.tch prims.h winder.h history.h
 utils.obj : scheme.tch prims.h winder.h history.h cmpint.h syscall.h
-primutl.obj : scheme.tch prims.h prename.h syscall.h
+primutl.obj : scheme.tch os.h prims.h usrdef.h prename.h syscall.h \
+	avltree.h $(GC_HEAD_FILES)
 hunk.obj list.obj step.obj vector.obj sysprim.obj daemon.obj prim.obj extern.obj : \
 	scheme.tch prims.h
 lookup.obj debug.obj intern.obj : scheme.tch prims.h lookup.h trap.h locks.h
@@ -361,6 +364,7 @@ purify.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
 purutl.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
 comutl.obj : scheme.tch prims.h
 artutl.obj : scheme.tch
+avltree.obj : ansidecl.h avltree.h
 bignum.obj : scheme.tch bignmint.h limits.h
 bigprm.obj flonum.obj intprm.obj : scheme.tch prims.h zones.h
 generic.obj : scheme.tch prims.h
diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c
index 2e3fc05e9..e577f431a 100644
--- a/v7/src/microcode/primutl.c
+++ b/v7/src/microcode/primutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: primutl.c,v 9.68 1993/10/27 22:15:59 gjr Exp $
+$Id: primutl.c,v 9.69 1993/11/05 00:44:57 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -47,6 +47,7 @@ MIT in each case. */
 #include "usrdef.h"
 #include "prename.h"
 #include "syscall.h"
+#include "avltree.h"
 #include "cmpgc.h"
 #include <ctype.h>
 
@@ -140,210 +141,6 @@ DEFUN_VOID (Prim_unimplemented)
   signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
   /*NOTREACHED*/
 }
-
-static char * tree_error_message = ((char *) NULL);
-static char * tree_error_noise   = ((char *) NULL);
-
-static void
-DEFUN (tree_error, (message, noise), char * message AND char * noise)
-{
-  tree_error_message = message;
-  tree_error_noise   = noise;
-  return;
-}
-
-/* AVL trees.  o(log n) lookup, insert (and delete, not implemented here).
-   AVL condition: for every node
-     abs (height (node.left) - height (node.right)) < 2
-   This guarantees that the least-balanced AVL tree has Fibonacci-sized
-   branches, and therefore the height is at most the log base phi of the
-   number of nodes, where phi is the golden ratio.
-   With random insertion (or when created as below),
-   they are better, approaching log base 2.
-
-   This version does not allow duplicate entries.
- */   
-
-typedef struct node_s * node;
-
-struct node_s
-{
-  int height;
-  node left;
-  node rite;
-  char * name;
-  int value;
-};
-
-#define BRANCH_HEIGHT(tree) (((tree) == ((node) NULL)) ? 0 : (tree)->height)
-
-#ifndef MAX
-#  define MAX(a,b) (((a) >= (b)) ? (a) : (b))
-#endif
-
-static void
-DEFUN (update_height, (tree), node tree)
-{
-  tree->height = (1 + (MAX ((BRANCH_HEIGHT (tree->left)),
-			    (BRANCH_HEIGHT (tree->rite)))));
-  return;
-}
-
-static node
-DEFUN (leaf_make, (name, value),
-       char * name AND int value)
-{
-  node leaf = ((node) (malloc (sizeof (struct node_s))));
-  if (leaf == ((node) NULL))
-  {
-    tree_error ("leaf_make: malloc failed.\n", NULL);
-    return (leaf);
-  }
-  leaf->name = name;
-  leaf->value = value;
-  leaf->height = 1;
-  leaf->left = ((node) NULL);
-  leaf->rite = ((node) NULL);
-  return (leaf);
-}
-
-static node
-DEFUN (rotate_left, (tree), node tree)
-{
-  node rite = tree->rite;
-  node beta = rite->left;
-  tree->rite = beta;
-  rite->left = tree;
-  update_height (tree);
-  update_height (rite);
-  return (rite);
-}
-
-static node
-DEFUN (rotate_rite, (tree), node tree)
-{
-  node left = tree->left;
-  node beta = left->rite;
-  tree->left = beta;
-  left->rite = tree;
-  update_height (tree);
-  update_height (left);
-  return (left);
-}
-
-static node
-DEFUN (rebalance_left, (tree), node tree)
-{
-  if ((1 + (BRANCH_HEIGHT (tree->rite))) >= (BRANCH_HEIGHT (tree->left)))
-  {
-    update_height (tree);
-    return (tree);
-  }
-  else
-  {
-    node q = tree->left;
-    if ((BRANCH_HEIGHT (q->rite)) > (BRANCH_HEIGHT (q->left)))
-      tree->left = (rotate_left (q));
-    return (rotate_rite (tree));
-  }
-}
-
-static node
-DEFUN (rebalance_rite, (tree), node tree)
-{
-  if ((1 + (BRANCH_HEIGHT (tree->left))) >= (BRANCH_HEIGHT (tree->rite)))
-  {
-    update_height (tree);
-    return (tree);
-  }
-  else
-  {
-    node q = tree->rite;
-    if ((BRANCH_HEIGHT (q->left)) > (BRANCH_HEIGHT (q->rite)))
-      tree->rite = (rotate_rite (q));
-    return (rotate_left (tree));
-  }
-}
-
-static node
-DEFUN (tree_insert, (tree, name, value),
-       node tree
-       AND char * name
-       AND int value)
-{
-  if (tree == ((node) NULL))
-    return (leaf_make (name, value));
-  switch (strcmp_ci (name, tree->name))
-  {
-    case 0:
-      tree_error ("tree_insert: Duplicate entry %s.\n", name);
-      return (tree);
-      
-    case -1:
-    {
-      /* To the left */
-      tree->left = (tree_insert (tree->left, name, value));
-      return (rebalance_left (tree));
-    }
-
-    case 1:
-    {
-      /* To the right */
-      tree->rite = (tree_insert (tree->rite, name, value));
-      return (rebalance_rite (tree));
-    }
-  }
-}
-
-static node
-DEFUN (tree_lookup, (tree, name), node tree AND char * name)
-{
-  while (tree != ((node) NULL))
-    switch (strcmp_ci (name, tree->name))
-    {
-      case 0:
-	return (tree);
-
-      case -1:
-	tree = tree->left;
-	break;
-
-      case 1:
-	tree = tree->rite;
-	break;
-    }
-  return (tree);
-}
-
-static node
-DEFUN (tree_build, (high, names, value),
-       int high AND char ** names AND int value)
-{
-  static int bias = 0;
-
-  if (high > 1)
-  {
-    node tree;
-    int middle = (high / 2);
-    int next;
-
-    if ((high & 1) == 0)
-    {
-      middle -= bias;
-      bias = (1 - bias);
-    }
-    next = (middle + 1);
-    tree = (leaf_make (names[middle], (value + middle)));
-    tree->left = (tree_build (middle, names, value));
-    tree->rite = (tree_build ((high - next), &names[next], (value + next)));
-    update_height (tree);
-    return (tree);
-  }
-  else if (high == 1)
-    return (leaf_make (* names, value));
-  else
-    return ((node) NULL);
-}
 
 static void
 DEFUN (initialization_error, (reason, item), char * reason AND char * item)
@@ -406,12 +203,12 @@ DEFUN_VOID (grow_primitive_tables)
   return (result);
 }
 
-static node prim_procedure_tree = ((node) NULL);
+static tree_node prim_procedure_tree = ((tree_node) NULL);
 
 void
 DEFUN_VOID (initialize_primitives)
 {
-  int counter;
+  unsigned long counter;
 
   /* MAX_STATIC_PRIMITIVE is the index of the last primitive */
 
@@ -429,12 +226,14 @@ DEFUN_VOID (initialize_primitives)
 
   for (counter = 0; counter < N_PRIMITIVE_ALIASES; counter++)
   {
-    int index;
-    node new;
-    node orig = (tree_lookup (prim_procedure_tree,
-			      primitive_aliases[counter].name));
+    unsigned long index;
+    tree_node new;
+    tree_node orig = (tree_lookup (prim_procedure_tree,
+				   primitive_aliases[counter].name));
 
-    if (orig == ((node) NULL))
+    if (orig != ((tree_node) NULL))
+      index = orig->value;
+    else
     {
       SCHEME_OBJECT old = (make_primitive (primitive_aliases[counter].name,
 					   UNKNOWN_PRIMITIVE_ARITY));
@@ -447,8 +246,6 @@ DEFUN_VOID (initialize_primitives)
       }
       index = (PRIMITIVE_NUMBER (old));
     }
-    else
-      index = orig->value;
 
     new = (tree_insert (prim_procedure_tree,
 			primitive_aliases[counter].alias,
@@ -474,12 +271,12 @@ DEFUN (declare_primitive_internal,
        AND char * docstr)
 /* nargs_lo ignored, for now */
 {
-  int index;
+  unsigned long index;
   SCHEME_OBJECT primitive;
   char * ndocstr = docstr;
-  node prim = (tree_lookup (prim_procedure_tree, name));
+  tree_node prim = (tree_lookup (prim_procedure_tree, name));
 
-  if (prim != ((node) NULL))
+  if (prim != ((tree_node) NULL))
   {
     index = prim->value;
     primitive = (MAKE_PRIMITIVE_OBJECT (prim->value));
@@ -591,10 +388,10 @@ DEFUN (find_primitive, (sname, intern_p, allow_p, arity),
        SCHEME_OBJECT sname AND Boolean intern_p
        AND Boolean allow_p AND int arity)
 {
-  node prim = (tree_lookup (prim_procedure_tree,
-			    ((char *) (STRING_LOC (sname, 0)))));
+  tree_node prim = (tree_lookup (prim_procedure_tree,
+				 ((char *) (STRING_LOC (sname, 0)))));
 
-  if (prim != ((node) NULL))
+  if (prim != ((tree_node) NULL))
   {
     SCHEME_OBJECT primitive = (MAKE_PRIMITIVE_OBJECT (prim->value));
 
diff --git a/v7/src/microcode/unxutl/ymkfile b/v7/src/microcode/unxutl/ymkfile
index f2127296c..f684fd076 100644
--- a/v7/src/microcode/unxutl/ymkfile
+++ b/v7/src/microcode/unxutl/ymkfile
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ymkfile,v 1.83 1993/10/31 19:24:09 gjr Exp $
+$Id: ymkfile,v 1.84 1993/11/05 00:45:25 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -275,7 +275,7 @@ const.h \
 interp.h \
 prim.h \
 $(GC_HEAD_FILES)
-cmpauxmd.o : cmpauxmd.c liarc.tch prims.h bignum.h bitstr.h
+cmpauxmd.o : cmpauxmd.c liarc.tch prims.h bignum.h bitstr.h avltree.h
 compinit.o : compinit.c liarc.tch compinit.h
 /* The following includes liarc.tch in case COMPILED_SOURCES is empty,
    to prevent fgrep from reading stdin.
@@ -385,6 +385,7 @@ SCHEME_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(X_LIB) $(TERMCAP_LIBS) LIB_MATH LIB
 CORE_SOURCES = \
 $(MACHINE_SOURCES) \
 artutl.c \
+avltree.c \
 bignum.c \
 bigprm.c \
 bitstr.c \
@@ -481,6 +482,7 @@ HEAD_FILES = scheme.tch prims.h zones.h locks.h bignum.h \
 CORE_OBJECTS = \
 $(MACHINE_OBJECTS) \
 artutl.o \
+avltree.o \
 bignum.o \
 bigprm.o \
 bitstr.o \
@@ -696,7 +698,8 @@ foo $(USER_PRIM_OBJECTS) : $(HEAD_FILES)
 interp.o : scheme.tch locks.h trap.h lookup.h history.h cmpint.h zones.h prmcon.h
 hooks.o : scheme.tch prims.h winder.h history.h
 utils.o : scheme.tch prims.h winder.h history.h cmpint.h syscall.h
-primutl.o : scheme.tch prims.h prename.h $(GC_HEAD_FILES) syscall.h
+primutl.o : scheme.tch os.h prims.h usrdef.h prename.h syscall.h \
+	avltree.h $(GC_HEAD_FILES)
 
 hunk.o list.o step.o vector.o sysprim.o daemon.o prim.o extern.o : \
 	scheme.tch prims.h
@@ -716,6 +719,7 @@ comutl.o : scheme.tch prims.h
 gctype.o : config.h
 
 artutl.o : scheme.tch
+avltree.o : ansidecl.h avltree.h
 bignum.o : scheme.tch bignmint.h limits.h
 bigprm.o flonum.o intprm.o : scheme.tch prims.h zones.h
 generic.o : scheme.tch prims.h