Change compiled-code environments to be records.

diff --git a/src/runtime/environment.scm b/src/runtime/environment.scm
index f6062f2b5da2101b5578a5351831fef35425f0ba..8727c189bd46151ea751fdee28099879df9c2efc 100644 (file)
--- a/src/runtime/environment.scm
+++ b/src/runtime/environment.scm
@@ -34,6 +34,7 @@ USA.
       (ic-environment? object)
       (stack-ccenv? object)
       (closure-ccenv? object)))
+(register-predicate! environment? 'environment)
 
 (define (environment-has-parent? environment)
   (cond ((system-global-environment? environment)
@@ -265,6 +266,13 @@ USA.
 (define-integrable (ic-environment? object)
   (object-type? (ucode-type environment) object))
 
+(register-predicate! interpreter-environment? 'top-level-environment
+                    '<= environment?)
+(register-predicate! system-global-environment? 'system-global-environment
+                    '<= top-level-environment?)
+(register-predicate! ic-environment? 'ic-environment
+                    '<= top-level-environment?)
+
 (define (guarantee-interpreter-environment object)
   (if (not (interpreter-environment? object))
       (error:wrong-type-datum object "interpreter environment"))
@@ -452,14 +460,13 @@ USA.
 \f
 ;;;; Compiled Code Environments
 
-(define-structure (stack-ccenv (type vector)
-                              (named
-                               ((ucode-primitive string->symbol)
-                                "#[(runtime environment)stack-ccenv]"))
-                              (conc-name stack-ccenv/))
-  (block #f read-only #t)
-  (frame #f read-only #t)
-  (start-index #f read-only #t))
+(define-record-type <stack-ccenv>
+    (make-stack-ccenv block frame start-index)
+    stack-ccenv?
+  (block stack-ccenv/block)
+  (frame stack-ccenv/frame)
+  (start-index stack-ccenv/start-index))
+(set-predicate<=! stack-ccenv? environment?)
 
 (define (stack-frame/environment frame default)
   (let* ((ret-add (stack-frame/return-address frame))
@@ -721,15 +728,13 @@ USA.
 (define-integrable (dbg-block/length block)
   (vector-length (dbg-block/layout-vector block)))
 \f
-(define-structure (closure-ccenv
-                  (type vector)
-                  (named
-                   ((ucode-primitive string->symbol)
-                    "#[(runtime environment)closure-ccenv]"))
-                  (conc-name closure-ccenv/))
-  (stack-block #f read-only #t)
-  (closure-block #f read-only #t)
-  (closure #f read-only #t))
+(define-record-type <closure-ccenv>
+    (make-closure-ccenv stack-block closure-block closure)
+    closure-ccenv?
+  (stack-block closure-ccenv/stack-block)
+  (closure-block closure-ccenv/closure-block)
+  (closure closure-ccenv/closure))
+(set-predicate<=! closure-ccenv? environment?)
 
 (define (closure-ccenv/bound-names environment)
   (map dbg-variable/name

diff --git a/src/runtime/predicate.scm b/src/runtime/predicate.scm
index 4de7f0b217a55d3bbdb4cb569c3151efe3734a10..bf67390d2132b98a4cd2745f5cd0c0183bcbe95b 100644 (file)
--- a/src/runtime/predicate.scm
+++ b/src/runtime/predicate.scm
@@ -233,20 +233,7 @@ USA.
    (register-predicate! thunk? 'thunk '<= procedure?)
    (register-predicate! unary-procedure? 'unary-procedure '<= procedure?)
    (register-predicate! unparser-method? 'unparser-method '<= procedure?)
-   (register-predicate! bundle? 'bundle '<= entity?)
-
-   ;; MIT/GNU Scheme: environments
-   (register-predicate! environment? 'environment)
-   (register-predicate! top-level-environment? 'top-level-environment
-                       '<= environment?)
-   (register-predicate! system-global-environment? 'system-global-environment
-                       '<= top-level-environment?)
-   (register-predicate! ic-environment? 'ic-environment
-                       '<= top-level-environment?)
-   (register-predicate! closure-ccenv? 'compiled-code-closure-environment
-                       '<= environment?)
-   (register-predicate! stack-ccenv? 'compiled-code-stack-environment
-                       '<= environment?)))
+   (register-predicate! bundle? 'bundle '<= entity?)))
 \f
 (add-boot-init!
  (lambda ()

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 048f51eb1ffe4bb6771d6b4e5d22784fb0b0a24e..8ca90237796cfa48c34c2e9bf8ee76a476224d82 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1968,9 +1968,6 @@ USA.
          ic-environment/procedure)
   (export (runtime debugging-info)
          stack-frame/environment)
-  (export (runtime predicate)
-         closure-ccenv?
-         stack-ccenv?)
   (initialization (initialize-package!)))
 
 (define-package (runtime environment-inspector)