Move bundle implementation to early in the cold load.

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index 0fc2cdb337f97593210c84e43c0473509baf96ca..771407a5d0a14e9ad5f4177eb565b2d67b5c92c3 100644 (file)
--- a/src/runtime/bundle.scm
+++ b/src/runtime/bundle.scm
@@ -116,28 +116,21 @@ USA.
 \f
 (define (bundle? object)
   (and (entity? object)
-       (bundle-metadata? (entity-extra object))))
-
-(add-boot-init!
- (lambda ()
-   (register-predicate! bundle? 'bundle '<= entity?)))
+       (let ((extra (entity-extra object)))
+        (and (vector? extra)
+             (fix:= 2 (vector-length extra))
+             (bundle-interface-tag? (vector-ref extra 0))))))
 
 (define (%make-bundle tag values)
   (make-entity (lambda (self operator . args)
                 (apply (bundle-ref self operator) args))
-              (make-bundle-metadata tag values)))
-
-(define-record-type <bundle-metadata>
-    (make-bundle-metadata tag values)
-    bundle-metadata?
-  (tag bundle-metadata-tag)
-  (values bundle-metadata-values))
+              (vector tag values)))
 
-(define (%bundle-tag bundle)
-  (bundle-metadata-tag (entity-extra bundle)))
+(define-integrable (%bundle-tag bundle)
+  (vector-ref (entity-extra bundle) 0))
 
-(define (%bundle-values bundle)
-  (bundle-metadata-values (entity-extra bundle)))
+(define-integrable (%bundle-values bundle)
+  (vector-ref (entity-extra bundle) 1))
 
 (define (bundle-interface bundle)
   (guarantee bundle? bundle 'bundle-interface)

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index c40fa1eedc940e0ebe0a52084376c7a6714996da..a7f65ab1f18e63f90f24c892055e1f4e6d35c3cc 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -371,7 +371,8 @@ USA.
         ("gentag" . (runtime tagged-dispatch))
         ("thread-low" . (RUNTIME THREAD))
         ("poplat" . (RUNTIME POPULATION))
-        ("record" . (RUNTIME RECORD))))
+        ("record" . (RUNTIME RECORD))
+        ("bundle" . (runtime bundle))))
       (files2
        '(("syntax-items" . (RUNTIME SYNTAX ITEMS))
         ("syntax-transforms" . (RUNTIME SYNTAX TRANSFORMS))
@@ -409,6 +410,7 @@ USA.
   (package-initialize '(runtime tagged-dispatch) #f #t)
   (package-initialize '(RUNTIME POPULATION) #f #t)
   (package-initialize '(runtime record) #f #t)
+  (package-initialize '(runtime bundle) #f #t)
 
   (load-files-with-boot-inits files2)
   (package-initialize '(RUNTIME 1D-PROPERTY) #f #t)         ;First population.
@@ -479,7 +481,6 @@ USA.
    (RUNTIME HASH)
    (RUNTIME DYNAMIC)
    (RUNTIME REGULAR-SEXPRESSION)
-   (RUNTIME BUNDLE)
    ;; Microcode data structures
    (RUNTIME HISTORY)
    (RUNTIME SCODE)

diff --git a/src/runtime/predicate.scm b/src/runtime/predicate.scm
index 028e140c06bf0118096f987cae307c36337f58ec..89279ce8587b0de91cc364725613d36502dc5d27 100644 (file)
--- a/src/runtime/predicate.scm
+++ b/src/runtime/predicate.scm
@@ -232,7 +232,8 @@ USA.
    (register-predicate! procedure-arity? 'procedure-arity)
    (register-predicate! thunk? 'thunk '<= procedure?)
    (register-predicate! unary-procedure? 'unary-procedure '<= procedure?)
-   (register-predicate! unparser-method? 'unparser-method '<= procedure?)))
+   (register-predicate! unparser-method? 'unparser-method '<= procedure?)
+   (register-predicate! bundle? 'bundle '<= entity?)))
 \f
 (add-boot-init!
  (lambda ()