From 6358c37ebd8b015b0350e573b0468ef9f9922672 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Fri, 9 Oct 1987 17:19:03 +0000 Subject: [PATCH] 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. --- v7/src/runtime/boot.scm | 5 ++-- v7/src/runtime/histry.scm | 63 ++++++++++++++++++++++++++++----------- v7/src/runtime/scode.scm | 15 +++++----- v7/src/sf/gconst.scm | 3 +- v7/src/sf/make.scm | 4 +-- v8/src/sf/make.scm | 4 +-- 6 files changed, 60 insertions(+), 34 deletions(-) diff --git a/v7/src/runtime/boot.scm b/v7/src/runtime/boot.scm index f64819b4d..23ac33ec3 100644 --- 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 f60f3368e..b13d0f42d 100644 --- 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)) +;; 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 aaad262c1..74a291f39 100644 --- 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 e6c06b028..bd57b2bd1 100644 --- 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 afb8ceed5..a14871f25 100644 --- 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 d3955fafa..990af442f 100644 --- 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 -- 2.25.1