Add generation and alist slots to lvalue objects, similar in form and

purpose to those used in CFG nodes.  Remove the now-obsolete marks
slot.

diff --git a/v7/src/compiler/base/lvalue.scm b/v7/src/compiler/base/lvalue.scm
index eba12f9e70b8de92d84eb62378d68370ef3bbefc..9a1cb6fa865545d19bd87c145bbd9f02cf3f8b42 100644 (file)
--- a/v7/src/compiler/base/lvalue.scm
+++ b/v7/src/compiler/base/lvalue.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/lvalue.scm,v 4.11 1988/12/13 13:58:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/lvalue.scm,v 4.12 1988/12/15 17:23:26 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -41,6 +41,8 @@ MIT in each case. |#
 ;; deleted!
 
 (define-root-type lvalue
+  generation           ;generation mark for graph walking
+  alist                        ;property list
   initial-forward-links        ;lvalues that sink values directly from here
   initial-backward-links ;lvalues that source values directly to here
   forward-links                ;transitive closure of initial-forward-links
@@ -51,7 +53,6 @@ MIT in each case. |#
   applications         ;applications whose operators are this lvalue
   passed-in?           ;true iff this lvalue gets an unknown value
   passed-out?          ;true iff this lvalue passes its value to unknown place
-  marks                        ;attribute marks list (see `lvalue-mark-set?')
   source-links         ;backward links with circularities removed
   )
 
@@ -64,9 +65,8 @@ MIT in each case. |#
 ;;; (define (make-lvalue tag . extra)
 ;;;   (let ((lvalue
 ;;;     (list->vector
-;;;      (cons* tag '() '() '() '() '() 'NOT-CACHED
-;;;             false '() false false '() '()
-;;;             extra))))
+;;;      (cons* tag false '() '() '() '() '() '() 'NOT-CACHED
+;;;             false '() false false '() extra))))
 ;;;     (set! *lvalues* (cons lvalue *lvalues*))
 ;;;     lvalue))
 
@@ -188,17 +188,43 @@ MIT in each case. |#
              (set-lvalue-values-cache! lvalue 'NOT-CACHED))
            (lvalue-forward-links lvalue)))
 \f
-;;;; Attribute Marking
+;;;; Attributes
 
-(define (lvalue-mark-set! lvalue mark)
-  (if (not (memq mark (lvalue-marks lvalue)))
-      (set-lvalue-marks! lvalue (cons mark (lvalue-marks lvalue)))))
+(package (with-new-lvalue-marks lvalue-marked? lvalue-mark!)
 
-(define (lvalue-mark-clear! lvalue mark)
-  (set-lvalue-marks! lvalue (delq! mark (lvalue-marks lvalue))))
+  (define-export (with-new-lvalue-marks thunk)
+    (fluid-let ((*generation* (make-generation)))
+      (thunk)))
 
-(define-integrable (lvalue-mark-set? lvalue mark)
-  (memq mark (lvalue-marks lvalue)))
+  (define-export (lvalue-marked? lvalue)
+    (eq? (lvalue-generation lvalue) *generation*))
+
+  (define-export (lvalue-mark! lvalue)
+    (set-lvalue-generation! lvalue *generation*))
+
+  (define *generation*)
+
+  (define make-generation
+    (let ((generation 0))
+      (named-lambda (make-generation)
+       (let ((value generation))
+         (set! generation (1+ generation))
+         value)))))
+
+(define (lvalue-get lvalue key)
+  (let ((entry (assq key (lvalue-alist lvalue))))
+    (and entry
+        (cdr entry))))
+
+(define (lvalue-put! lvalue key item)
+  (let ((entry (assq key (lvalue-alist lvalue))))
+    (if entry
+       (set-cdr! entry item)
+       (set-lvalue-alist! lvalue
+                          (cons (cons key item) (lvalue-alist lvalue))))))
+
+(define (lvalue-remove! lvalue key)
+  (set-lvalue-alist! lvalue (del-assq! key (lvalue-alist lvalue))))
 
 (define (variable-assigned! variable assignment)
   (set-variable-assignments!

diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm
index c399dab489d69814e753ac72a964cbcdd81aca02..48eaa8785b4405034bd406522570088035df7697 100644 (file)
--- a/v7/src/compiler/base/macros.scm
+++ b/v7/src/compiler/base/macros.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 4.8 1988/12/12 21:30:16 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 4.9 1988/12/15 17:23:48 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -177,7 +177,7 @@ MIT in each case. |#
  (define-type-definition snode 5 false)
  (define-type-definition pnode 6 false)
  (define-type-definition rvalue 2 rvalue-types)
- (define-type-definition lvalue 13 false))
+ (define-type-definition lvalue 14 false))
 
 ;;; Kludge to make these compile efficiently.
 
@@ -201,9 +201,8 @@ MIT in each case. |#
     (let ((result (generate-uninterned-symbol)))
       `(let ((,result
              ((ACCESS VECTOR ,system-global-environment)
-              ,tag '() '() '() '() '() 'NOT-CACHED
-              FALSE '() FALSE FALSE '() '()
-              ,@extra)))
+              ,tag FALSE '() '() '() '() '() '() 'NOT-CACHED
+              FALSE '() FALSE FALSE '() ,@extra)))
         (SET! *LVALUES* (CONS ,result *LVALUES*))
         ,result))))
 \f