Add %HASH-NUMBER field to group data structure. This is used to cache

the OBJECT-HASH of the group to speed up regular expression searching.

diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 28fbb435dd18e5c5b76d1c0b4b9916d4dcbfd457..1356325d47602a6376b33b872c5661dfa681d179 100644 (file)
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: regexp.scm,v 1.63 1992/12/01 14:47:07 gjr Exp $
+;;;    $Id: regexp.scm,v 1.64 1993/08/13 23:40:21 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-1992 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -47,7 +47,8 @@
 (declare (usual-integrations))
 \f
 (define registers (make-vector 20))
-(define match-group (object-hash false))
+(define hash-of-false (object-hash false))
+(define match-group hash-of-false)
 
 (define-integrable (re-match-start-index i)
   (vector-ref registers i))
@@ -100,7 +101,7 @@
        unspecific)
      thunk
      (lambda ()
-       (set! match-group (object-hash group))
+       (set! match-group (if group (group-hash-number group) hash-of-false))
        (set! registers
             (if group
                 (vector-map marks
@@ -188,7 +189,7 @@
          (syntax-table-argument syntax-table)
          registers
          group start end)))
-    (set! match-group (object-hash (and index group)))
+    (set! match-group (compute-match-group group index))
     index))
 
 (define (re-search-buffer-backward pattern case-fold-search syntax-table
@@ -200,7 +201,7 @@
          (syntax-table-argument syntax-table)
          registers
          group start end)))
-    (set! match-group (object-hash (and index group)))
+    (set! match-group (compute-match-group group index))
     index))
 
 (define (re-match-buffer-forward pattern case-fold-search syntax-table
@@ -212,16 +213,21 @@
          (syntax-table-argument syntax-table)
          registers
          group start end)))
-    (set! match-group (object-hash (and index group)))
+    (set! match-group (compute-match-group group index))
     index))
 
+(define (compute-match-group group index)
+  (if index
+      (group-hash-number group)
+      hash-of-false))
+
 (define (re-match-string-forward pattern case-fold-search syntax-table string)
   (re-match-substring-forward pattern case-fold-search syntax-table
                              string 0 (string-length string)))
 
 (define (re-match-substring-forward pattern case-fold-search syntax-table
                                    string start end)
-  (set! match-group (object-hash false))
+  (set! match-group hash-of-false)
   ((ucode-primitive re-match-substring)
    pattern
    (re-translation-table case-fold-search)
@@ -235,7 +241,7 @@
 
 (define (re-search-substring-forward pattern case-fold-search syntax-table
                                     string start end)
-  (set! match-group (object-hash false))
+  (set! match-group hash-of-false)
   ((ucode-primitive re-search-substring-forward)
    pattern
    (re-translation-table case-fold-search)
@@ -250,7 +256,7 @@
 
 (define (re-search-substring-backward pattern case-fold-search syntax-table
                                      string start end)
-  (set! match-group (object-hash false))
+  (set! match-group hash-of-false)
   ((ucode-primitive re-search-substring-backward)
    pattern
    (re-translation-table case-fold-search)

diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm
index 69236bf1a75987a511aa85cc0bb10226137ebeca..df2b99170fa17d7e30682781fcde9806ba51cff7 100644 (file)
--- a/v7/src/edwin/struct.scm
+++ b/v7/src/edwin/struct.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: struct.scm,v 1.87 1993/08/13 23:19:57 cph Exp $
+;;;    $Id: struct.scm,v 1.88 1993/08/13 23:40:14 cph Exp $
 ;;;
 ;;;    Copyright (c) 1985, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -108,7 +108,8 @@
   point
   buffer
   shrink-length
-  text-properties)
+  text-properties
+  %hash-number)
 
 (define-integrable (set-group-marks! group marks)
   (vector-set! group group-index:marks marks))
@@ -145,6 +146,9 @@
 
 (define-integrable (set-group-text-properties! group properties)
   (vector-set! group group-index:text-properties properties))
+
+(define-integrable (set-group-%hash-number! group n)
+  (vector-set! group group-index:%hash-number n))
 \f
 (define (make-group buffer)
   (let ((group (%make-group)))
@@ -170,6 +174,7 @@
     (vector-set! group group-index:buffer buffer)
     (vector-set! group group-index:shrink-length 0)
     (vector-set! group group-index:text-properties false)
+    (vector-set! group group-index:%hash-number #f)
     group))
 
 (define (group-length group)
@@ -244,6 +249,12 @@
 
 (define (group-absolute-end group)
   (make-temporary-mark group (group-length group) true))
+
+(define (group-hash-number group)
+  (or (group-%hash-number group)
+      (let ((n (object-hash group)))
+       (set-group-%hash-number! group n)
+       n)))
 \f
 ;;;; Text Clipping