Eliminate all remnants of danger bits.

- History now uses two distinct types for marked and unmarked versions.
- Stacklets/control points have a separate word used as the reuse flag.

diff --git a/v7/src/runtime/boot.scm b/v7/src/runtime/boot.scm
index f64819b4d215288f879aacabea7f59337d437b83..23ac33ec389ef3f6aa1b9f22f08157f0e0b8780d 100644 (file)
--- a/v7/src/runtime/boot.scm
+++ b/v7/src/runtime/boot.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/boot.scm,v 13.43 1987/04/17 00:58:33 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/boot.scm,v 13.44 1987/10/09 17:13:14 jinx Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -59,7 +59,7 @@
    WITH-INTERRUPT-MASK
    GET-FIXED-OBJECTS-VECTOR WITH-HISTORY-DISABLED
    PRIMITIVE-PROCEDURE-ARITY NOT FALSE?
-   UNSNAP-LINKS!
+   ;; UNSNAP-LINKS!
 
    ;; Environment
    LEXICAL-REFERENCE LEXICAL-ASSIGNMENT LOCAL-ASSIGNMENT
@@ -69,7 +69,6 @@
    EQ?
    PRIMITIVE-SET-TYPE MAKE-NON-POINTER-OBJECT
    PRIMITIVE-TYPE? PRIMITIVE-TYPE PRIMITIVE-DATUM
-   OBJECT-DANGEROUS? MAKE-OBJECT-SAFE MAKE-OBJECT-DANGEROUS
 
    ;; List Operations
    ;; (these appear here for the time being because the compiler

diff --git a/v7/src/runtime/histry.scm b/v7/src/runtime/histry.scm
index f60f3368ea6b87927acc4ca4d981600c45c6539c..b13d0f42d288102b2d6a0c75f773a17639e8fb83 100644 (file)
--- a/v7/src/runtime/histry.scm
+++ b/v7/src/runtime/histry.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.47 1987/06/04 21:08:49 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.48 1987/10/09 17:13:22 jinx Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -51,9 +51,11 @@
        (return-address-pop-from-compiled-code
         (make-return-address
          (microcode-return 'POP-FROM-COMPILED-CODE)))
+       (hunk:make (make-primitive-procedure 'HUNK3-CONS))
+       (type-code:unmarked-history (microcode-type 'unmarked-history))
+       (type-code:marked-history (microcode-type 'marked-history))
 
        ;; VERTEBRA abstraction.
-       (make-vertebra (make-primitive-procedure 'HUNK3-CONS))
        (vertebra-rib system-hunk3-cxr0)
        (shallower-vertebra system-hunk3-cxr2)
        (set-vertebra-rib! system-hunk3-set-cxr0!)
@@ -61,57 +63,84 @@
        (set-shallower-vertebra! system-hunk3-set-cxr2!)
 
        ;; REDUCTION abstraction.
-       (make-reduction (make-primitive-procedure 'HUNK3-CONS))
        (reduction-expression system-hunk3-cxr0)
        (reduction-environment system-hunk3-cxr1)
        (set-reduction-expression! system-hunk3-set-cxr0!)
        (set-reduction-environment! system-hunk3-set-cxr1!)
-       (set-next-reduction! system-hunk3-set-cxr2!)
-       )
+       (set-next-reduction! system-hunk3-set-cxr2!))
 
 (declare (integrate-primitive-procedures
-         (make-vertebra hunk3-cons)
+         (hunk:make hunk3-cons)
          (vertebra-rib system-hunk3-cxr0)
          (shallower-vertebra system-hunk3-cxr2)
          (set-vertebra-rib! system-hunk3-set-cxr0!)
          (set-deeper-vertebra! system-hunk3-set-cxr1!)
          (set-shallower-vertebra! system-hunk3-set-cxr2!)
-         (make-reduction hunk3-cons)
          (reduction-expression system-hunk3-cxr0)
          (reduction-environment system-hunk3-cxr1)
          (set-reduction-expression! system-hunk3-set-cxr0!)
          (set-reduction-environment! system-hunk3-set-cxr1!)
-         (set-next-reduction! system-hunk3-set-cxr2!)))
+         (set-next-reduction! system-hunk3-set-cxr2!))
+
+        (integrate-operator history:mark history:unmark history:marked?))
+
+(define (history:unmark object)
+  (declare (integrate object))
+  (primitive-set-type type-code:unmarked-history object))
+
+(define (history:mark object)
+  (declare (integrate object))
+  (primitive-set-type type-code:marked-history object))
+
+(define (history:marked? object)
+  (declare (integrate object))
+  (primitive-type? type-code:marked-history object))
 \f
+;; Vertebra operations
+
+(declare (integrate-operator make-vertebra))
+
+(define (make-vertebra rib deeper shallower)
+  (declare (integrate rib deeper shallower))
+  (history:unmark (hunk:make rib deeper shallower)))
+
 (define (deeper-vertebra vertebra)
-  (make-object-safe (system-hunk3-cxr1 vertebra)))
+  (system-hunk3-cxr1 vertebra))
 
 (define (marked-vertebra? vertebra)
-  (object-dangerous? (system-hunk3-cxr1 vertebra)))
+  (history:marked? (system-hunk3-cxr1 vertebra)))
 
 (define (mark-vertebra! vertebra)
   (system-hunk3-set-cxr1!
    vertebra
-   (make-object-dangerous (system-hunk3-cxr1 vertebra))))
+   (history:mark (system-hunk3-cxr1 vertebra))))
 
 (define (unmark-vertebra! vertebra)
   (system-hunk3-set-cxr1! vertebra
-                         (make-object-safe (system-hunk3-cxr1 vertebra))))
+                         (history:unmark (system-hunk3-cxr1 vertebra))))
+
+;; Reduction operations
+
+(declare (integrate-operator make-reduction))
+
+(define (make-reduction expression environment next)
+  (declare (integrate expression environment next))
+  (history:unmark (hunk:make expression environment next)))
 
 (define (next-reduction reduction)
-  (make-object-safe (system-hunk3-cxr2 reduction)))
+  (system-hunk3-cxr2 reduction))
 
 (define (marked-reduction? reduction)
-  (object-dangerous? (system-hunk3-cxr2 reduction)))
+  (history:marked? (system-hunk3-cxr2 reduction)))
 
 (define (mark-reduction! reduction)
   (system-hunk3-set-cxr2!
    reduction
-   (make-object-dangerous (system-hunk3-cxr2 reduction))))
+   (history:mark (system-hunk3-cxr2 reduction))))
 
 (define (unmark-reduction! reduction)
   (system-hunk3-set-cxr2! reduction
-                         (make-object-safe (system-hunk3-cxr2 reduction))))
+                         (history:unmark (system-hunk3-cxr2 reduction))))
 
 (define (link-vertebrae previous next)
   (set-deeper-vertebra! previous next)
@@ -252,4 +281,4 @@
   (car history))
 
 ;;; end HISTORY-PACKAGE.
-(the-environment)))
\ No newline at end of file
+(the-environment)))

diff --git a/v7/src/runtime/scode.scm b/v7/src/runtime/scode.scm
index aaad262c1950d31f058b59af88e5ee215a473a45..74a291f39fb116a177e0d873d6f965d825d20a86 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 13.44 1987/05/19 13:16:48 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 13.45 1987/10/09 17:13:54 jinx Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -115,21 +115,20 @@
   (make-primitive-procedure 'STRING->SYMBOL))
 
 (define (symbol->string symbol)
-  (make-object-safe (&pair-car symbol)))
+  (&pair-car symbol))
 
 (define make-symbol string->uninterned-symbol)
 (define make-interned-symbol string->symbol)
 (define symbol-print-name symbol->string)
 
+;; NOTE: Both of these assume that there are no reference traps.
+;; They can cause great harm if used indiscriminately.
+
 (define (symbol-global-value symbol)
-  (make-object-safe (&pair-cdr symbol)))
+  (&pair-cdr symbol))
 
 (define (set-symbol-global-value! symbol value)
-  (&pair-set-cdr! symbol
-                 ((if (object-dangerous? (&pair-cdr symbol))
-                      make-object-dangerous
-                      make-object-safe)
-                  value)))
+  (&pair-set-cdr! symbol value))
 
 (define (make-named-tag name)
   (string->symbol (string-append "#[" name "]")))

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index e6c06b0285c44a65db92dec7839500ff9d71a923..bd57b2bd1ee134ea57d2174fc18db8bf7e970915 100644 (file)
--- a/v7/src/sf/gconst.scm
+++ b/v7/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 3.2 1987/05/09 20:02:49 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 3.3 1987/10/09 17:18:47 jinx Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -57,7 +57,6 @@ MIT in each case. |#
     EQ?
     PRIMITIVE-SET-TYPE MAKE-NON-POINTER-OBJECT
     PRIMITIVE-TYPE? PRIMITIVE-TYPE PRIMITIVE-DATUM
-    OBJECT-DANGEROUS? MAKE-OBJECT-SAFE MAKE-OBJECT-DANGEROUS
 
     ;; Numbers
     ZERO? POSITIVE? NEGATIVE? 1+ -1+

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index afb8ceed5b586551284b4123a2dda5f039e884a1..a14871f25e77a56494821060799db8c78ae614ef 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.12 1987/07/08 04:55:33 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.13 1987/10/09 17:19:03 jinx Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -60,7 +60,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 12)
+      (define :modification 13)
       (define :files)
 
       (define :files-lists

diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index d3955fafa8ae6eb2ad85758ecb04e28f48972e54..990af442fda50bfb26e8360e2702513594fc283b 100644 (file)
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.12 1987/07/08 04:55:33 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.13 1987/10/09 17:19:03 jinx Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -60,7 +60,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 12)
+      (define :modification 13)
       (define :files)
 
       (define :files-lists