Eliminate BTREE data structure, replacing it with RB-TREE

implementation that is built in to the runtime system.  This
replacement improves overall performance by a factor of three.

diff --git a/v7/src/cref/conpkg.scm b/v7/src/cref/conpkg.scm
index c1f32cdc3f3f1fe72269ea6f1f9ba3a0d60cf509..561596c6acabfde626deef445acdc9ba1f1a2225 100644 (file)
--- a/v7/src/cref/conpkg.scm
+++ b/v7/src/cref/conpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/conpkg.scm,v 1.3 1991/11/04 20:33:57 cph Exp $
+$Id: conpkg.scm,v 1.4 1993/10/11 23:31:39 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -83,10 +83,10 @@ MIT in each case. |#
                    ,(package-reference (binding/package source))
                    ',(binding/name source))))
              (binding/links binding)))
-       (btree-fringe (package/bindings package)))))
+       (package/sorted-bindings package))))
 
 (define (package/source-bindings package)
-  (list-transform-positive (btree-fringe (package/bindings package))
+  (list-transform-positive (package/sorted-bindings package)
     (lambda (binding)
       (eq? (binding/source-binding binding) binding))))
 

diff --git a/v7/src/cref/cref.pkg b/v7/src/cref/cref.pkg
index 2a6768d84f99f5cc5a5926d99afee060718fc0bd..79fe17d8efb01fd42ebcd11b76009ae7e38cc681 100644 (file)
--- a/v7/src/cref/cref.pkg
+++ b/v7/src/cref/cref.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/cref.pkg,v 1.4 1991/03/01 20:19:34 cph Exp $
+$Id: cref.pkg,v 1.5 1993/10/11 23:31:40 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -48,16 +48,6 @@ MIT in each case. |#
          cref/generate-cref-unusual
          cref/generate-trivial-constructor))
 
-(define-package (cross-reference balanced-binary-tree)
-  (files "btree")
-  (parent ())
-  (export (cross-reference)
-         btree-delete!
-         btree-fringe
-         btree-insert!
-         btree-lookup
-         make-btree))
-
 (define-package (cross-reference analyze-file)
   (files "anfile")
   (parent (cross-reference))

diff --git a/v7/src/cref/cref.sf b/v7/src/cref/cref.sf
index 8237695b9174a772657ce57e46b32df23d49e546..830dfc721fa593987e6a715b802d0f97087d1beb 100644 (file)
--- a/v7/src/cref/cref.sf
+++ b/v7/src/cref/cref.sf
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/cref.sf,v 1.5 1992/06/04 03:02:47 mhwu Exp $
+$Id: cref.sf,v 1.6 1993/10/11 23:31:40 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,22 +36,15 @@ MIT in each case. |#
 (sf-conditionally "object")
 (sf-directory ".")
 
-;; Before runtime system is built this next thunk is the one
-;; used.
-(with-working-directory-pathname "../cref" ; this is rather useless
-  (lambda ()
-    (if (not (file-exists? "cref.bcon"))
-       (sf "triv.con" "cref.bcon"))
-    (if (not (file-exists? "cref.bldr"))
-       (sf "triv.ldr" "cref.bldr"))))
-
-;; After the runtime system is built, more elaborate work is done
-(with-working-directory-pathname "../cref" ; this is rather useless
-  (lambda ()
-    (if (file-exists? "../runtime/runtim.glob")
-       (begin
-         (if (not (name->package '(CROSS-REFERENCE)))
-             (load "make"))
-         (cref/generate-constructors "cref")
-         (sf "cref.con" "cref.bcon")
-         (sf "cref.ldr" "cref.bldr")))))
\ No newline at end of file
+(if (not (file-exists? "cref.bcon"))
+    (sf "triv.con" "cref.bcon"))
+(if (not (file-exists? "cref.bldr"))
+    (sf "triv.ldr" "cref.bldr"))
+
+(if (file-exists? "../runtime/runtim.glob")
+    (begin
+      (if (not (name->package '(CROSS-REFERENCE)))
+         (load "make"))
+      (cref/generate-constructors "cref")
+      (sf "cref.con" "cref.bcon")
+      (sf "cref.ldr" "cref.bldr")))
\ No newline at end of file

diff --git a/v7/src/cref/forpkg.scm b/v7/src/cref/forpkg.scm
index 7260af8a3d71cac47be7f778a02d3f55e36bdea4..5398036d305cd1c41db76a9a4f1a1e885d033c89 100644 (file)
--- a/v7/src/cref/forpkg.scm
+++ b/v7/src/cref/forpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/forpkg.scm,v 1.7 1991/11/04 20:34:03 cph Exp $
+$Id: forpkg.scm,v 1.8 1993/10/11 23:31:41 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -62,7 +62,7 @@ MIT in each case. |#
     (let ((free-references
           (append-map! (lambda (package)
                          (list-transform-negative
-                             (btree-fringe (package/references package))
+                             (package/sorted-references package)
                            reference/binding))
                        packages)))
       (if (not (null? free-references))
@@ -98,7 +98,7 @@ MIT in each case. |#
         (classify-bindings-by-package
          (lambda (binding)
            (binding/package (binding/source-binding binding)))
-         (btree-fringe (package/bindings package)))))
+         (package/sorted-bindings package))))
     (let ((class (assq package classes)))
       (if class
          (format-package/bindings port indentation width package (cdr class)))
@@ -157,7 +157,7 @@ MIT in each case. |#
                            (set! unlinked (cons value-cell unlinked)))
                           ((not (memq value-cell linked))
                            (set! linked (cons value-cell linked))))))
-                (btree-fringe (package/bindings package))))
+                (package/sorted-bindings package)))
      packages)
     (values unlinked linked)))
 \f

diff --git a/v7/src/cref/make.scm b/v7/src/cref/make.scm
index 93abb780d59dd9e28b3c9e5da663f7ad0741a040..85ce4f27be1607c1f028f75484078320772771c7 100644 (file)
--- a/v7/src/cref/make.scm
+++ b/v7/src/cref/make.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/make.scm,v 1.8 1991/11/04 20:34:10 cph Exp $
+$Id: make.scm,v 1.9 1993/10/11 23:31:42 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,5 +36,6 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
+(load-option 'RB-TREE)
 (package/system-loader "cref" '() false)
-(add-system! (make-system "CREF" 1 8 '()))
\ No newline at end of file
+(add-system! (make-system "CREF" 1 9 '()))
\ No newline at end of file

diff --git a/v7/src/cref/object.scm b/v7/src/cref/object.scm
index d09c26c7ba933ee6554ac8169d65d3e6bb427e55..3a11491ed8e24dcbb52704de04263d16336d1a91 100644 (file)
--- a/v7/src/cref/object.scm
+++ b/v7/src/cref/object.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: object.scm,v 1.5 1992/12/03 03:13:59 cph Exp $
+$Id: object.scm,v 1.6 1993/10/11 23:31:42 cph Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -71,8 +71,8 @@ MIT in each case. |#
   (initialization false read-only true)
   parent
   (children '())
-  (bindings (make-btree) read-only true)
-  (references (make-btree) read-only true))
+  (bindings (make-rb-tree symbol=? symbol<?) read-only true)
+  (references (make-rb-tree symbol=? symbol<?) read-only true))
 
 (define (make-package name file-cases initialization parent)
   (let ((files
@@ -91,10 +91,14 @@ MIT in each case. |#
 (define-integrable (package/root? package)
   (null? (package/name package)))
 
-(define (package/find-binding package name)
-  (btree-lookup (package/bindings package) symbol<? binding/name name
-    identity-procedure
-    (lambda (name) name false)))
+(define-integrable (package/find-binding package name)
+  (rb-tree/lookup (package/bindings package) name #f))
+
+(define-integrable (package/sorted-bindings package)
+  (rb-tree/datum-list (package/bindings package)))
+
+(define-integrable (package/sorted-references package)
+  (rb-tree/datum-list (package/references package)))
 
 (define-integrable (file-case/type file-case)
   (car file-case))
@@ -179,9 +183,6 @@ MIT in each case. |#
   (expressions '())
   (binding false))
 \f
-(define-integrable (symbol<? x y)
-  (string<? (symbol->string x) (symbol->string y)))
-
 (define (symbol-list=? x y)
   (if (null? x)
       (null? y)

diff --git a/v7/src/cref/redpkg.scm b/v7/src/cref/redpkg.scm
index 3c67cdfa459366a1ebed3ea04d30802d0415a2f4..42cf0d533eb6de5eecf68a61533b1c74a3e73188 100644 (file)
--- a/v7/src/cref/redpkg.scm
+++ b/v7/src/cref/redpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/redpkg.scm,v 1.4 1991/11/04 20:34:18 cph Exp $
+$Id: redpkg.scm,v 1.5 1993/10/11 23:31:43 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -171,7 +171,7 @@ MIT in each case. |#
 (define (resolve-references! pmodel)
   (for-each (lambda (package)
              (for-each resolve-reference!
-                       (btree-fringe (package/references package))))
+                       (package/sorted-references package)))
            (pmodel/packages pmodel)))
 
 (define (resolve-reference! reference)
@@ -377,33 +377,31 @@ MIT in each case. |#
      (cons expression (value-cell/expressions value-cell)))))
 
 (define (link! source-package source-name destination-package destination-name)
+  (if (package/find-binding destination-package destination-name)
+      (error "Attempt to reinsert binding" destination-name))
   (let ((source-binding (intern-binding! source-package source-name)))
-    (make-link source-binding
-              (btree-insert! (package/bindings destination-package)
-                             symbol<?
-                             binding/name
-                             destination-name
-                (lambda (destination-name)
-                  (make-binding destination-package
-                                destination-name
-                                (binding/value-cell source-binding)))
-                (lambda (binding)
-                  binding
-                  (error "Attempt to reinsert binding" destination-name))
-                identity-procedure))))
+    (let ((destination-binding
+          (make-binding destination-package
+                        destination-name
+                        (binding/value-cell source-binding))))
+      (rb-tree/insert! (package/bindings destination-package)
+                      destination-name
+                      destination-binding)
+      (make-link source-binding destination-binding))))
 
 (define (intern-binding! package name)
-  (btree-insert! (package/bindings package) symbol<? binding/name name
-    (lambda (name)
-      (let ((value-cell (make-value-cell)))
-       (let ((binding (make-binding package name value-cell)))
-         (set-value-cell/source-binding! value-cell binding)
-         binding)))
-    identity-procedure
-    identity-procedure))
+  (or (package/find-binding package name)
+      (let ((binding
+            (let ((value-cell (make-value-cell)))
+              (let ((binding (make-binding package name value-cell)))
+                (set-value-cell/source-binding! value-cell binding)
+                binding))))
+       (rb-tree/insert! (package/bindings package) name binding)
+       binding)))
 
 (define (make-reference package name expression)
-  (let ((add-reference!
+  (let ((references (package/references package))
+       (add-reference!
         (lambda (reference)
           (set-reference/expressions!
            reference
@@ -411,13 +409,13 @@ MIT in each case. |#
           (set-expression/references!
            expression
            (cons reference (expression/references expression))))))
-    (btree-insert! (package/references package) symbol<? reference/name name
-      (lambda (name)
-       (%make-reference package name))
-      (lambda (reference)
-       (if (not (memq expression (reference/expressions reference)))
-           (add-reference! reference))
-       reference)
-      (lambda (reference)
-       (add-reference! reference)
-       reference))))
\ No newline at end of file
+    (let ((reference (rb-tree/lookup references name #f)))
+      (if reference
+         (begin
+           (if (not (memq expression (reference/expressions reference)))
+               (add-reference! reference))
+           reference)
+         (let ((reference (%make-reference package name)))
+           (rb-tree/insert! references name reference)
+           (add-reference! reference)
+           reference)))))
\ No newline at end of file

diff --git a/v7/src/cref/toplev.scm b/v7/src/cref/toplev.scm
index 7bc706f5ed736f7c7a8c83801c9625e8bbaf68e3..88b6189241fa8a15d26883e47d435ff07c42cbcf 100644 (file)
--- a/v7/src/cref/toplev.scm
+++ b/v7/src/cref/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/toplev.scm,v 1.5 1991/11/04 20:34:26 cph Exp $
+$Id: toplev.scm,v 1.6 1993/10/11 23:31:44 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -109,7 +109,6 @@ MIT in each case. |#
 (define (write-globals pathname pmodel)
   (fasdump (map binding/name
                (list-transform-positive
-                   (btree-fringe
-                    (package/bindings (pmodel/root-package pmodel)))
+                   (package/sorted-bindings (pmodel/root-package pmodel))
                  binding/source-binding))
           (pathname-new-type pathname "glob")))
\ No newline at end of file

diff --git a/v7/src/cref/triv.con b/v7/src/cref/triv.con
index 465c4cec92c8c0963722809c8d31eb42a36a28f7..297729a68be79cdfd78c27875320c81831656519 100644 (file)
--- a/v7/src/cref/triv.con
+++ b/v7/src/cref/triv.con
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/Attic/triv.con,v 1.3 1991/06/06 21:37:19 cph Exp $
+$Id: triv.con,v 1.4 1993/10/11 23:31:44 cph Exp $
 
-Copyright (c) 1989-91 Massachusetts Institute of Technology
+Copyright (c) 1989-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -54,24 +54,6 @@ MIT in each case. |#
   (environment-link-name destination source 'cref/generate-cref-unusual)
   (environment-link-name destination source 'cref/generate-trivial-constructor))
 
-(package/add-child!
- (find-package '(cross-reference))
- 'balanced-binary-tree
- (in-package (package/environment (find-package '(cross-reference)))
-   (let ((btree-delete!)
-        (btree-fringe)
-        (btree-insert!)
-        (btree-lookup)
-        (make-btree))
-     (the-environment))))
-(let ((source (package/environment (find-package '(cross-reference balanced-binary-tree))))
-      (destination (package/environment (find-package '(cross-reference)))))
-  (environment-link-name destination source 'btree-delete!)
-  (environment-link-name destination source 'btree-fringe)
-  (environment-link-name destination source 'btree-insert!)
-  (environment-link-name destination source 'btree-lookup)
-  (environment-link-name destination source 'make-btree))
-
 (package/add-child!
  (find-package '(cross-reference))
  'analyze-file

diff --git a/v7/src/cref/triv.ldr b/v7/src/cref/triv.ldr
index 3f8e7bf7154ce75b271e1385fc49315e17819d56..f5c200abe1dd05a66a021954450f66a09d255f9d 100644 (file)
--- a/v7/src/cref/triv.ldr
+++ b/v7/src/cref/triv.ldr
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/Attic/triv.ldr,v 1.2 1993/08/28 23:30:13 gjr Exp $
+$Id: triv.ldr,v 1.3 1993/10/11 23:31:45 cph Exp $
 
-Copyright (c) 1989 Massachusetts Institute of Technology
+Copyright (c) 1989-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -35,16 +35,13 @@ MIT in each case. |#
 ;;;; "Trivial" loader needed to bootstrap cref.
 
 (declare (usual-integrations))
-\f
+
 (lambda (load alist)
   alist
   (let ((env (package/environment (find-package '(cross-reference)))))
     (load "mset" env)
     (load "object" env)
     (load "toplev" env))
-  (load "btree"
-       (package/environment
-        (find-package '(cross-reference balanced-binary-tree))))
   (load "anfile"
        (package/environment (find-package '(cross-reference analyze-file))))
   (load "conpkg"