From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 13 Aug 1993 23:40:21 +0000 (+0000)
Subject: Add %HASH-NUMBER field to group data structure.  This is used to cache
X-Git-Tag: 20090517-FFI~8067
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ad4e65de569cb11be0bef5bef41cbbcca2201e3f;p=mit-scheme.git

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 28fbb435d..1356325d4 100644
--- 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))
 
 (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 69236bf1a..df2b99170 100644
--- 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))
 
 (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)))
 
 ;;;; Text Clipping