From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 10 Feb 2019 00:20:33 +0000 (-0800)
Subject: Put char-set microcode table back in data structure.  Edwin needs this.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~12
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=933a0f9dd635544ff93d5d976a922b92c809fb30;p=mit-scheme.git

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 b110776ea..fc73b5ec5 100644
--- 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 ed719f017..3eea2d925 100644
--- 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)))
 
 ;;;; String search
 
diff --git a/src/runtime/char-set.scm b/src/runtime/char-set.scm
index bca760cb0..bed378e3a 100644
--- 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 b4272c014..8820d7981 100644
--- 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")