Change `environment?' to be true of `system-global-environment'. Add

new procedures `ic-environment?' and `system-global-environment?' to
distinguish the interesting cases.

diff --git a/v7/src/runtime/dbgutl.scm b/v7/src/runtime/dbgutl.scm
index 7fb8c4fb8e819f284b8415454a02834c1bba3d8c..834ebd429758d8feb9ddd7aa8e737407d09bebde 100644 (file)
--- a/v7/src/runtime/dbgutl.scm
+++ b/v7/src/runtime/dbgutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgutl.scm,v 14.2 1988/06/13 11:43:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgutl.scm,v 14.3 1988/08/01 23:09:37 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -68,7 +68,7 @@ MIT in each case. |#
 (define rename-list)
 \f
 (define (show-frame frame depth)
-  (if (eq? system-global-environment frame)
+  (if (system-global-environment? frame)
       (begin
        (newline)
        (write-string "This frame is the system global environment"))

diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index 0c3359366ad3a6548a577e04b4af8dc3bb029d47..86573c63420b712106d8c87ad11253aeabf877fd 100644 (file)
--- a/v7/src/runtime/debug.scm
+++ b/v7/src/runtime/debug.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.3 1988/07/14 07:39:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.4 1988/08/01 23:08:34 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -227,7 +227,7 @@ MIT in each case. |#
   ;;; procedure name
   (write-string
    (string-pad-right
-    (if (or (not (environment? environment))
+    (if (or (not (ic-environment? environment))
            (special-name? (environment-name environment)))
        ""
        (write-to-truncated-string (environment-name environment) 20))
@@ -538,7 +538,7 @@ MIT in each case. |#
 (define (if-valid-environment environment receiver)
   (cond ((debugging-info/undefined-environment? environment)
         (print-undefined-environment))
-       ((eq? environment system-global-environment)
+       ((system-global-environment? environment)
         (newline)
         (write-string
          "System global environment at this subproblem/reduction level"))

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index 161251c4569542c444d35cca690438b2d73ac125..24cb5a822cbfceee8b70a655c59bf15cb0297c46 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.4 1988/07/14 07:40:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.5 1988/08/01 23:09:21 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -448,8 +448,7 @@ MIT in each case. |#
     environment))
 
 (define (->environment object)
-  (cond ((or (eq? object system-global-environment)
-            (environment? object))
+  (cond ((environment? object)
         object)
        ((compound-procedure? object)    (procedure-environment object))
        ((promise? object)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index efe04245e484073fb6cbeca50dccb8238060a5b5..15d9e77fd8864b7d058cacaf8f759cfd67266211 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.16 1988/07/19 20:42:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.17 1988/08/01 23:09:01 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -407,8 +407,10 @@ MIT in each case. |#
          environment-parent
          environment-procedure
          environment?
+         ic-environment?
          remove-environment-parent!
-         set-environment-parent!))
+         set-environment-parent!
+         system-global-environment?))
 
 (define-package (runtime environment-inspector)
   (files "where")

diff --git a/v7/src/runtime/scode.scm b/v7/src/runtime/scode.scm
index cf4fb7346bd0368d6570c077808fa1de03beaf2e..07cbb867b2c33a9f2f7729bdbb9d92b40a17c149 100644 (file)
--- a/v7/src/runtime/scode.scm
+++ b/v7/src/runtime/scode.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.2 1988/06/16 06:29:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.3 1988/08/01 23:10:12 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -281,7 +281,7 @@ MIT in each case. |#
 
 (define (absolute-reference? object)
   (and (access? object)
-       (eq? (access-environment object) system-global-environment)))
+       (system-global-environment? (access-environment object))))
 
 (define-integrable (absolute-reference-name reference)
   (access-name reference))

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index 0fae1fe3d58f19d15d928aef146ba71d82fdccf4..7f1fcf9cfdfe75f338f89c5f585f465de149bbd0 100644 (file)
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.2 1988/06/13 11:58:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.3 1988/08/01 23:08:20 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -39,15 +39,24 @@ MIT in each case. |#
 \f
 ;;;; Environment
 
-(define-integrable (environment? object)
+(define (environment? object)
+  (if (system-global-environment? object)
+      true
+      (ic-environment? object)))
+
+(define-integrable (system-global-environment? object)
+  (eq? system-global-environment object))
+
+(define-integrable (ic-environment? object)
   (object-type? (ucode-type environment) object))
 
 (define (environment-procedure environment)
   (select-procedure (environment->external environment)))
 
 (define (environment-has-parent? environment)
-  (not (eq? (select-parent (environment->external environment))
-           null-environment)))
+  (and (ic-environment? environment)
+       (not (eq? (select-parent (environment->external environment))
+                null-environment))))
 
 (define (environment-parent environment)
   (select-parent (environment->external environment)))

diff --git a/v7/src/runtime/where.scm b/v7/src/runtime/where.scm
index a0fc7a2abbe9dbb7a020663dc0133b595045125e..e4a87b669b02f49a2cf529bd5dd63062ac853702 100644 (file)
--- a/v7/src/runtime/where.scm
+++ b/v7/src/runtime/where.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.2 1988/07/14 07:41:03 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 14.3 1988/08/01 23:09:58 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -88,23 +88,17 @@ MIT in each case. |#
   (show-frame current-frame current-frame-depth))
 
 (define (show-all)
-  (let s1 ((env env)
-          (depth 0))
-    (if (eq? system-global-environment env)
-       *the-non-printing-object*
+  (let s1 ((env env) (depth 0))
+    (if (not (system-global-environment? env))
        (begin (show-frame env depth)
               (if (environment-has-parent? env)
-                  (s1 (environment-parent env) (1+ depth))
-                  *the-non-printing-object*)))))
-\f
+                  (s1 (environment-parent env) (1+ depth))))))
+  *the-non-printing-object*)
+
 ;;;; Motion Commands
 
 (define (parent)
-  (cond ((eq? system-global-environment current-frame)
-        (newline)
-        (write-string 
-"The current frame is the system global environment, it has no parent."))
-       ((environment-has-parent? current-frame)
+  (cond ((environment-has-parent? current-frame)
         (set! current-frame (environment-parent current-frame))
         (set! current-frame-depth (1+ current-frame-depth))
         (show))

diff --git a/v8/src/runtime/dbgutl.scm b/v8/src/runtime/dbgutl.scm
index 46fd1478a4e80234bc07724c613a7778aa9e6d3c..6c1b8fe0e4eb3376d4476dc020399a4d7c19a7d0 100644 (file)
--- a/v8/src/runtime/dbgutl.scm
+++ b/v8/src/runtime/dbgutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/dbgutl.scm,v 14.2 1988/06/13 11:43:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/dbgutl.scm,v 14.3 1988/08/01 23:09:37 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -68,7 +68,7 @@ MIT in each case. |#
 (define rename-list)
 \f
 (define (show-frame frame depth)
-  (if (eq? system-global-environment frame)
+  (if (system-global-environment? frame)
       (begin
        (newline)
        (write-string "This frame is the system global environment"))

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index dba3f9b888acc78d56b4fdcd8c204bd58a27f241..c30126083e6a02966d4fc075a0856fb024f2210c 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.16 1988/07/19 20:42:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.17 1988/08/01 23:09:01 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -407,8 +407,10 @@ MIT in each case. |#
          environment-parent
          environment-procedure
          environment?
+         ic-environment?
          remove-environment-parent!
-         set-environment-parent!))
+         set-environment-parent!
+         system-global-environment?))
 
 (define-package (runtime environment-inspector)
   (files "where")

diff --git a/v8/src/runtime/uenvir.scm b/v8/src/runtime/uenvir.scm
index d7ff76c1a1990da97b8ea8320712803872daf0cd..10ea3895eb5a0cdca6290698fa3cce9d76f96d60 100644 (file)
--- a/v8/src/runtime/uenvir.scm
+++ b/v8/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.2 1988/06/13 11:58:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.3 1988/08/01 23:08:20 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -39,15 +39,24 @@ MIT in each case. |#
 \f
 ;;;; Environment
 
-(define-integrable (environment? object)
+(define (environment? object)
+  (if (system-global-environment? object)
+      true
+      (ic-environment? object)))
+
+(define-integrable (system-global-environment? object)
+  (eq? system-global-environment object))
+
+(define-integrable (ic-environment? object)
   (object-type? (ucode-type environment) object))
 
 (define (environment-procedure environment)
   (select-procedure (environment->external environment)))
 
 (define (environment-has-parent? environment)
-  (not (eq? (select-parent (environment->external environment))
-           null-environment)))
+  (and (ic-environment? environment)
+       (not (eq? (select-parent (environment->external environment))
+                null-environment))))
 
 (define (environment-parent environment)
   (select-parent (environment->external environment)))