From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 16 Mar 2018 05:52:24 +0000 (-0700)
Subject: Use proxy instances for set-record-type-fasdumpable!.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~208
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9da20e91223c3fac437c074285125cb62de27640;p=mit-scheme.git

Use proxy instances for set-record-type-fasdumpable!.
---

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index fa8af7d29..0821af908 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -188,26 +188,21 @@ USA.
        (let ((v (object-new-type (ucode-type fixnum) object)))
 	 (and (fix:>= v #x100)
 	      (fix:< v #x200)))))
+(register-predicate! %record-type-proxy? 'record-type-proxy)
 
-(define (set-record-type-fasdumpable! type index)
+(define (set-record-type-fasdumpable! type proxy)
   (guarantee record-type? type 'set-record-type-fasdumpable!)
-  (guarantee index-fixnum? index 'set-record-type-fasdumpable!)
-  (if (not (fix:< index #x100))
-      (error:bad-range-argument index 'set-record-type-fasdumpable!))
+  (guarantee %record-type-proxy? proxy 'set-record-type-fasdumpable!)
   (if (%record-type-applicator type)
       (error "Record types can't be applicable and fasdumpable:" type))
-  (let ((proxy (%index->record-type-proxy index)))
-    (cond ((%record-type-fasdumpable? type)
-	   (if (not (eq? proxy (%record-type-instance-marker type)))
-	       (error "Can't re-register record type:" type)))
-	  ((vector-ref %proxied-record-types index)
-	   => (lambda (rt)
-		(if (not (eq? rt type))
-		    (error "Registered record-type index already in use:"
-			   index))))
-	  (else
-	   (vector-set! %proxied-record-types index type)
-	   (%set-record-type-instance-marker! type proxy)))))
+  (without-interrupts
+   (lambda ()
+     (if (%record-type-fasdumpable? type)
+	 (error "Record type already fasdumpable:" type))
+     (if (%proxy->record-type proxy)
+	 (error "Record-type proxy already in use:" proxy))
+     (%set-proxied-record-type! proxy type)
+     (%set-record-type-instance-marker! type proxy))))
 
 (define-integrable (%record-type-proxy->index marker)
   (fix:- (object-new-type (ucode-type fixnum) marker) #x100))
@@ -218,11 +213,17 @@ USA.
 (define-integrable (%proxy->record-type proxy)
   (vector-ref %proxied-record-types (%record-type-proxy->index proxy)))
 
+(define-integrable (%set-proxied-record-type! proxy type)
+  (vector-set! %proxied-record-types (%record-type-proxy->index proxy) type))
+
 (define %proxied-record-types)
 (add-boot-init!
  (lambda ()
    (set! %proxied-record-types (make-vector #x100 #f))
    unspecific))
+
+(define record-type-proxy:pathname (%index->record-type-proxy 0))
+(define record-type-proxy:host (%index->record-type-proxy 1))
 
 ;;;; Constructors
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f3d764c2a..905eaf321 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3735,6 +3735,8 @@ USA.
 	  error:no-such-slot
 	  error:uninitialized-slot
 	  record-type-field-index
+	  record-type-proxy:host
+	  record-type-proxy:pathname
 	  set-record-type-fasdumpable!)
   (export (runtime unparser)
 	  named-list-with-unparser?