From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 12 Aug 1989 08:18:37 +0000 (+0000)
Subject: * Change `environment-link-name' to call `->environment' on its two
X-Git-Tag: 20090517-FFI~11837
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=00a713e48a5a730cbc544d958d614d8dd24205f7;p=mit-scheme.git

* Change `environment-link-name' to call `->environment' on its two
environment arguments.

* Move `vector-binary-search' to the global environment.  Fix a bug in
it -- a confusion between the < used for comparing integers, and that
for comparing keys.

* New variable `load/suppress-loading-message?' prevents the file
loader from printing the "loading -- done" messages.

* Implement `pathname-relative?' which accepts two pathnames; if the
second has a directory part which is a "prefix" of the first, this
returns a copy of the first pathname with the "prefix" removed.
Example:

    (pathname-relative? (->pathname "/usr/bin")
			(->pathname "/usr/"))
	   ==> #[pathname 5 "bin"]
---

diff --git a/v7/src/runtime/vector.scm b/v7/src/runtime/vector.scm
index b662c1c78..6054e71ea 100644
--- a/v7/src/runtime/vector.scm
+++ b/v7/src/runtime/vector.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/vector.scm,v 14.4 1989/06/07 19:15:00 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/vector.scm,v 14.5 1989/08/12 08:18:37 cph Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -127,6 +127,17 @@ MIT in each case. |#
 
 (define-integrable (vector-find-previous-element vector item)
   (subvector-find-previous-element vector 0 (vector-length vector) item))
+
+(define (vector-binary-search vector key<? unwrap-key key)
+  (let loop ((start 0) (end (vector-length vector)))
+    (and (< start end)
+	 (let ((midpoint (quotient (+ start end) 2)))
+	   (let ((item (vector-ref vector midpoint)))
+	     (let ((key* (unwrap-key item)))
+	       (cond ((key<? key key*) (loop start midpoint))
+		     ((key<? key* key) (loop (1+ midpoint) end))
+		     (else item))))))))
+
 (define-integrable (vector-first vector) (vector-ref vector 0))
 (define-integrable (vector-second vector) (vector-ref vector 1))
 (define-integrable (vector-third vector) (vector-ref vector 2))