From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sun, 30 Apr 1995 17:22:37 +0000 (+0000)
Subject: Added a hand-crafted vector-8b based bit-string operation for a fast
X-Git-Tag: 20090517-FFI~6364
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7e2e17ce3682eb739c7cd836c66820e06d664fd0;p=mit-scheme.git
Added a hand-crafted vector-8b based bit-string operation for a fast
connectivity predicate when the in-degree exceeds a certain value.
Speeds up dataflow of large graphs.
---
diff --git a/v8/src/compiler/midend/dataflow.scm b/v8/src/compiler/midend/dataflow.scm
index 61d6cb20e..9aef63d1b 100644
--- a/v8/src/compiler/midend/dataflow.scm
+++ b/v8/src/compiler/midend/dataflow.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: dataflow.scm,v 1.12 1995/04/08 21:00:17 adams Exp $
+$Id: dataflow.scm,v 1.13 1995/04/30 17:22:37 adams Exp $
Copyright (c) 1994 Massachusetts Institute of Technology
@@ -715,9 +715,9 @@ MIT in each case. |#
(illegal expr))))
(define (dataflow/expr* env graph exprs)
- (lmap (lambda (expr)
- (dataflow/expr env graph expr))
- exprs))
+ (map (lambda (expr)
+ (dataflow/expr env graph expr))
+ exprs))
(define (dataflow/remember new old)
old ; ignored for now
@@ -2108,42 +2108,86 @@ MIT in each case. |#
(setter! structure (initial-vector item)))))
(add! to from node/links-in set-node/links-in!)
- (add! from to node/links-out set-node/links-out!))
+ (add! from to node/links-out set-node/links-out!)
+
+ (if (fix:>= (vector-length (node/links-in to)) 75)
+ (if (node/connectivity to)
+ (bit-vector-set! (node/connectivity to) (node/number from))
+ (let ((bs (make-bit-vector *node-count* #F))
+ (links-in (node/links-in to)))
+ (let loop ((i (vector-ref links-in 0)))
+ (cond ((fix:> i 0)
+ (bit-vector-set! bs (node/number (vector-ref links-in i)))
+ (loop (fix:- i 1)))))
+ (set-node/connectivity! to bs))))
+)
-(define (nodes-linked? from to)
- (or (eq? from to)
- (let ((set (node/links-in to)))
- (and set
- (let loop ((i (vector-ref set 0)))
- (and (fix:> i 0)
- ;; Loop unrolled 1 time is safe because the zero slot
- ;; contains a fixnum that will never match a node
- (or (eq? from (vector-ref set i))
- (eq? from (vector-ref set (fix:- i 1)))
- (loop (fix:- i 2)))))))))
+;;(define (nodes-linked? from to)
+;; (or (eq? from to)
+;; (let ((set (node/links-in to)))
+;; (and set
+;; (let loop ((i (vector-ref set 0)))
+;; (and (fix:> i 0)
+;; ;; Loop unrolled 1 time is safe because the zero slot
+;; ;; contains a fixnum that will never match a node
+;; (or (eq? from (vector-ref set i))
+;; (eq? from (vector-ref set (fix:- i 1)))
+;; (loop (fix:- i 2)))))))))
(define (nodes-linked? from to)
(or (eq? from to)
- (let ((set (node/links-in to)))
- (and set
- (let unrolled-loop ((i (vector-ref set 0)))
- (if (fix:>= i 8)
- (or (eq? from (vector-ref set i))
- (eq? from (vector-ref set (fix:- i 1)))
- (eq? from (vector-ref set (fix:- i 2)))
- (eq? from (vector-ref set (fix:- i 3)))
- (eq? from (vector-ref set (fix:- i 4)))
- (eq? from (vector-ref set (fix:- i 5)))
- (eq? from (vector-ref set (fix:- i 6)))
- (eq? from (vector-ref set (fix:- i 7)))
- (unrolled-loop (fix:- i 8)))
- (let end-loop ((i i))
- (and (fix:> i 0)
- ;; Loop unrolled 1 time is safe because the zero slot
- ;; contains a fixnum that will never match a node
- (or (eq? from (vector-ref set i))
- (eq? from (vector-ref set (fix:- i 1)))
- (end-loop (fix:- i 2)))))))))))
+ (if (node/connectivity to)
+ (bit-vector-ref (node/connectivity to) (node/number from))
+ (let ((set (node/links-in to)))
+ (and set
+ (let unrolled-loop ((i (vector-ref set 0)))
+ (if (fix:>= i 8)
+ (or (eq? from (vector-ref set i))
+ (eq? from (vector-ref set (fix:- i 1)))
+ (eq? from (vector-ref set (fix:- i 2)))
+ (eq? from (vector-ref set (fix:- i 3)))
+ (eq? from (vector-ref set (fix:- i 4)))
+ (eq? from (vector-ref set (fix:- i 5)))
+ (eq? from (vector-ref set (fix:- i 6)))
+ (eq? from (vector-ref set (fix:- i 7)))
+ (unrolled-loop (fix:- i 8)))
+ (let end-loop ((i i))
+ (and (fix:> i 0)
+ ;; Loop unrolled 1 time is safe because the zero slot
+ ;; contains a fixnum that will never match a node
+ (or (eq? from (vector-ref set i))
+ (eq? from (vector-ref set (fix:- i 1)))
+ (end-loop (fix:- i 2))))))))))))
+
+
+;; BIT vectors as strings:
+
+(define-integrable (bv-index->byte-index n)
+ (fix:lsh n -3))
+
+(define-integrable (bv-index->mask n)
+ (vector-8b-ref "\001\002\004\010\020\040\100\200" (fix:and n 7)))
+
+(define (make-bit-vector n init)
+ (define-integrable (bv-bits->bytes n)
+ (fix:lsh (fix:+ n 7) -3))
+ (make-string (bv-bits->bytes n)
+ (if init
+ (integer->char 255)
+ (integer->char 0))))
+
+(define-integrable (bit-vector-ref bv n)
+ (fix:= (fix:and (vector-8b-ref bv (bv-index->byte-index n))
+ (bv-index->mask n))
+ (bv-index->mask n)))
+
+(define (bit-vector-set! bv n)
+ (vector-8b-set! bv
+ (bv-index->byte-index n)
+ (fix:or (vector-8b-ref bv (bv-index->byte-index n))
+ (bv-index->mask n))))
+
+
(define (make-empty-node-set)