From df0ca7c5ad8e9d24230f0a405c8dd8badbc4e754 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 21 Feb 2018 23:34:53 -0800
Subject: [PATCH] Change compiled-code environments to be records.

---
 src/runtime/environment.scm | 39 +++++++++++++++++++++----------------
 src/runtime/predicate.scm   | 15 +-------------
 src/runtime/runtime.pkg     |  3 ---
 3 files changed, 23 insertions(+), 34 deletions(-)

diff --git a/src/runtime/environment.scm b/src/runtime/environment.scm
index f6062f2b5..8727c189b 100644
--- 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.
 
 ;;;; 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)))
 
-(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 4de7f0b21..bf67390d2 100644
--- 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?)))
 
 (add-boot-init!
  (lambda ()
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 048f51eb1..8ca902377 100644
--- 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)
-- 
2.25.1