Put char-set microcode table back in data structure. Edwin needs this.

diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg
index b110776eac190a4b8524579530355b8382c130ec..fc73b5ec5768ed587f6481050f7495a01e0f87ac 100644 (file)
--- a/src/edwin/edwin.pkg
+++ b/src/edwin/edwin.pkg
@@ -155,7 +155,7 @@ USA.
   (files "string")
   (parent (edwin))
   (import (runtime character-set)
-         (char-set-table %char-set-table))
+         char-set-table)
   (export (edwin)
          (set-vector-8b-length! set-string-length!)
          (vector-8b-length string-length)

diff --git a/src/edwin/string.scm b/src/edwin/string.scm
index ed719f0175b4f5de0c15f99e5a5020ab8627ca69..3eea2d925db1a4d002d7b445f801bf513338d6d6 100644 (file)
--- a/src/edwin/string.scm
+++ b/src/edwin/string.scm
@@ -1339,7 +1339,7 @@ USA.
 
 (define-integrable (%substring-find-next-char-in-set string start end char-set)
   ((ucode-primitive substring-find-next-char-in-set)
-   string start end (cached-char-set-table char-set)))
+   string start end (char-set-table char-set)))
 
 (define (string-find-previous-char-in-set string char-set)
   (guarantee-string string 'STRING-FIND-PREVIOUS-CHAR-IN-SET)
@@ -1354,28 +1354,7 @@ USA.
 
 (define (%substring-find-previous-char-in-set string start end char-set)
   ((ucode-primitive substring-find-previous-char-in-set)
-   string start end (cached-char-set-table char-set)))
-
-;; Kludge!  These used to be cached in the record when the char-set was
-;; constructed; now they are not.
-
-(define char-set-table-lock
-  (make-thread-mutex))
-
-(define char-set-table-table
-  (make-weak-eq-hash-table))
-
-(define (cached-char-set-table char-set)
-  (or (begin (lock-thread-mutex char-set-table-lock)
-       (begin0 (hash-table-ref char-set-table-table char-set (lambda () #f))
-         (unlock-thread-mutex char-set-table-lock)))
-      (let ((table (char-set-table char-set)))
-       (lock-thread-mutex char-set-table-lock)
-       ;; If we raced with someone else, no problem -- if there's a
-       ;; duplicate table then it'll be GC'd at the end.
-       (hash-table-set! char-set-table-table char-set table)
-       (unlock-thread-mutex char-set-table-lock)
-       table)))
+   string start end (char-set-table char-set)))
 \f
 ;;;; String search
 

diff --git a/src/runtime/char-set.scm b/src/runtime/char-set.scm
index bca760cb0986aceff68f34f18dcc1a5bda47fcf4..bed378e3a20596e61e119dbd166de495f12950a7 100644 (file)
--- a/src/runtime/char-set.scm
+++ b/src/runtime/char-set.scm
@@ -39,11 +39,13 @@ USA.
 ;;; The HIGH range sequence is a u24 bytevector implementing an inversion list.
 
 (define-record-type <char-set>
-    (%make-char-set low high predicate)
+    (%make-char-set low high predicate table)
     char-set?
   (low %char-set-low)
   (high %char-set-high)
-  (predicate %char-set-predicate))
+  (predicate %char-set-predicate)
+  ;; backwards compatibility for Edwin:
+  (table %char-set-table))
 
 (define (make-char-set low high)
   (letrec
@@ -55,7 +57,16 @@ USA.
                     (and (char? char)
                          (char-in-set? char char-set)))))
              (register-predicate! predicate 'char-set-predicate '<= char?)
-             predicate)))))
+             predicate))
+         (delay
+           (let ((table (make-bytevector #x100)))
+             (do ((cp 0 (fix:+ cp 1)))
+                 ((not (fix:< cp #x100)))
+               (bytevector-u8-set! table cp
+                                   (if (%code-point-in-char-set? cp char-set)
+                                       1
+                                       0)))
+             table)))))
     char-set))
 
 (define-integrable %low-cps-per-byte 8)
@@ -438,6 +449,9 @@ USA.
 (define (char-set-predicate char-set)
   (force (%char-set-predicate char-set)))
 
+(define (char-set-table char-set)
+  (force (%char-set-table char-set)))
+
 (define (char-set=? char-set . char-sets)
   (every (lambda (char-set*)
           (and (bytevector=? (%char-set-low char-set*)
@@ -635,14 +649,6 @@ USA.
       (error:bad-range-argument end 'ascii-range->char-set))
   (char-set (cons start end)))
 
-(define (%char-set-table char-set)
-  (let ((table (make-bytevector #x100)))
-    (do ((cp 0 (fix:+ cp 1)))
-       ((not (fix:< cp #x100)))
-      (bytevector-u8-set! table cp
-                         (if (%code-point-in-char-set? cp char-set) 1 0)))
-    table))
-
 (define (8-bit-char-set? char-set)
   (and (char-set? char-set)
        (let ((high (%char-set-high char-set)))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b4272c01428e457bf672847297e9ac8273bcf032..8820d7981ec8f218be9e8cdaf55538347ec27b6f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1572,9 +1572,7 @@ USA.
          re-compile-char-set
          string->char-set)
   (export (runtime regular-sexpression)
-         normalize-ranges)
-  (export (runtime legacy-string)
-         (char-set-table %char-set-table)))
+         normalize-ranges))
 
 (define-package (runtime compiler-info)
   (files "infstr" "infutl")