- Make assignments use their own caches, distinct from those use by

references.
- Turn uuo links on by default.
- Partly implement the CONSTANT declaration.
- Add some more declaration language (ALL and NONE).
- Make the variable set be computed at the right point during graph
construction.

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index 773f3c416d01eb8a93c24fe53823f6c39c14bee2..51249f7d3ad1d9ee471828174431f8a46e045485 100644 (file)
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.41 1987/08/07 17:10:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.42 1987/10/05 20:39:46 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -48,6 +48,7 @@ MIT in each case. |#
      (fluid-let ((*next-constant* 0)
                 (*interned-constants* '())
                 (*interned-variables* '())
+                (*interned-assignments* '())
                 (*interned-uuo-links* '())
                 (*block-start-label* (generate-label)))
        (for-each cgen-rgraph rgraphs)
@@ -55,6 +56,7 @@ MIT in each case. |#
                 (generate/quotation-header *block-start-label*
                                            *interned-constants*
                                            *interned-variables*
+                                           *interned-assignments*
                                            *interned-uuo-links*))))))
 
 (define (cgen-rgraph rgraph)

diff --git a/v7/src/compiler/back/lapgn3.scm b/v7/src/compiler/back/lapgn3.scm
index dfe52b741f400ef6eb0610950af6c25f2c93fff0..aa9ed4740b811fd0578be32477f73a8f76693c0a 100644 (file)
--- a/v7/src/compiler/back/lapgn3.scm
+++ b/v7/src/compiler/back/lapgn3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 1.3 1987/08/07 17:11:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 1.4 1987/10/05 20:41:28 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -41,6 +41,7 @@ MIT in each case. |#
 (define *next-constant*)
 (define *interned-constants*)
 (define *interned-variables*)
+(define *interned-assignments*)
 (define *interned-uuo-links*)
 
 (define (allocate-constant-label)
@@ -70,6 +71,16 @@ MIT in each case. |#
                      *interned-variables*))
          label))))
 
+(define (free-assignment-label name)
+  (let ((entry (assq name *interned-assignments*)))
+    (if entry
+       (cdr entry)
+       (let ((label (allocate-constant-label)))
+         (set! *interned-assignments*
+               (cons (cons name label)
+                     *interned-assignments*))
+         label))))
+
 (define (free-uuo-link-label name)
   (let ((entry (assq name *interned-uuo-links*)))
     (if entry

diff --git a/v7/src/compiler/fggen/declar.scm b/v7/src/compiler/fggen/declar.scm
index 0b0d50a4e18b333c8942a5d5bba7cfab0435b649..0b5ad9c880f45cce13749fa311f0b3c43731dc91 100644 (file)
--- a/v7/src/compiler/fggen/declar.scm
+++ b/v7/src/compiler/fggen/declar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.1 1987/07/03 18:54:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.2 1987/10/05 20:44:08 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -36,6 +36,14 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
+(define (process-top-level-declarations! block declarations)
+  (process-declarations!
+   block
+   ;; Kludge!
+   (if (assq 'UUO-LINK declarations)
+       declarations
+       (cons '(UUO-LINK ALL) declarations))))
+
 (define (process-declarations! block declarations)
   (for-each (lambda (declaration)
              (process-declaration! block declaration))
@@ -75,6 +83,10 @@ MIT in each case. |#
   (let loop ((specification specification))
     (cond ((eq? specification 'BOUND) (block-bound-variables block))
          ((eq? specification 'FREE) (block-free-variables block))
+         ((eq? specification 'NONE) '())
+         ((eq? specification 'ALL)
+          (append (block-bound-variables block)
+                  (block-free-variables block)))
          ((and (pair? specification)
                (assq (car specification) binary-operators)
                (pair? (cdr specification))

diff --git a/v7/src/compiler/fgopt/folcon.scm b/v7/src/compiler/fgopt/folcon.scm
index fafbed6f9bcd330ec2d0c18fc7675fb865ac4e88..62c1a0122e2545a872533e019e123af7c7451a1e 100644 (file)
--- a/v7/src/compiler/fgopt/folcon.scm
+++ b/v7/src/compiler/fgopt/folcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 1.1 1987/06/09 19:53:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 1.2 1987/10/05 20:45:00 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -59,7 +59,9 @@ MIT in each case. |#
                           ;; should be a noop if there is only one
                           ;; value.
                           (and (variable? vnode)
-                               (variable-assigned? vnode))))
+                               (variable-assigned? vnode)
+                               (not (memq 'CONSTANT
+                                          (variable-declarations vnode))))))
                  (let ((procedures (vnode-procedures vnode))
                        (values (vnode-values vnode)))
                    (if (null? values)

diff --git a/v7/src/compiler/fgopt/outer.scm b/v7/src/compiler/fgopt/outer.scm
index d4ea406b7bf810e6d41b6a17895c83ed2e831597..68c4e0223e28ac3d34565c58a07be4b9fbf0c71a 100644 (file)
--- a/v7/src/compiler/fgopt/outer.scm
+++ b/v7/src/compiler/fgopt/outer.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/outer.scm,v 1.1 1987/06/09 19:53:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/outer.scm,v 1.2 1987/10/05 20:44:28 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -72,9 +72,9 @@ MIT in each case. |#
 (define (analyze-block block)
   (if (ic-block? block)
       (begin (if (block-outer? block)
-                (for-each make-vnode-externally-visible!
+                (for-each make-vnode-externally-assignable!
                           (block-free-variables block)))
-            (for-each make-vnode-externally-visible!
+            (for-each make-vnode-externally-accessible!
                       (block-bound-variables block)))))
 \f
 (define (prepare-combination combination)
@@ -105,12 +105,19 @@ MIT in each case. |#
     (set-combination-procedures! combination '())
     (for-each make-procedure-externally-visible! procedures)))
 \f
+(define (make-vnode-externally-assignable! vnode)
+  (make-vnode-unknowable! vnode)
+  (make-vnode-externally-visible! vnode))
+
+(define (make-vnode-externally-accessible! vnode)
+  (cond ((not (memq 'CONSTANT (variable-declarations vnode)))
+        (make-vnode-externally-assignable! vnode))
+       ((not (vnode-externally-visible? vnode))
+        (make-vnode-externally-visible! vnode))))
+
 (define (make-vnode-externally-visible! vnode)
   (if (not (vnode-externally-visible? vnode))
-      (begin (set! more-unknowable-vnodes? true)
-            (vnode-externally-visible! vnode)
-            (vnode-unknowable! vnode)
-            (make-vnode-forward-links-unknowable! vnode)
+      (begin (vnode-externally-visible! vnode)
             (for-each make-procedure-externally-visible!
                       (vnode-procedures vnode)))))
 

diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm
index 9468ab70fa3bd40ff05e975ab80e79d3f5d228b9..079364c7401058f4dc1c1e448a64f630ac9ea44b 100644 (file)
--- a/v7/src/compiler/machines/bobcat/machin.scm
+++ b/v7/src/compiler/machines/bobcat/machin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.50 1987/07/08 22:09:50 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.51 1987/10/05 20:35:26 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -83,6 +83,7 @@ MIT in each case. |#
     ((REGISTER) 4)                     ;move.l reg,reg
     ((UNASSIGNED) 12)                  ;move.l #data,reg
     ((VARIABLE-CACHE) 16)              ;move.l d(pc),reg
+    ((ASSIGNMENT-CACHE) 16)            ;move.l d(pc),reg
     (else (error "Unknown expression type" expression))))
 \f
 (define (rtl:machine-register? rtl-register)

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index af0bd0603e0d3ae8b9571b09123e5f6bb2621aa7..fc447e4739434d2c84e763a2e8a5b05229922829 100644 (file)
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.43 1987/09/03 05:13:32 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.44 1987/10/05 20:35:38 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -46,11 +46,11 @@ MIT in each case. |#
     (make-environment
       (define :name "Liar (Bobcat 68020)")
       (define :version 3)
-      (define :modification 1)
+      (define :modification 2)
       (define :files)
 
 ;      (parse-rcs-header
-;       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.43 1987/09/03 05:13:32 jinx Exp $"
+;       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.44 1987/10/05 20:35:38 jinx Exp $"
 ;       (lambda (filename version date time zone author state)
 ;       (set! :version (car version))
 ;       (set! :modification (cadr version))))

diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm
index 30fc9c551f49a3b7a314e99bb8206748432cbbff..bee3510b11810be6621eb7ee61873d1d0fac3840 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules1.scm
+++ b/v7/src/compiler/machines/bobcat/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 1.6 1987/07/08 22:08:21 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 1.7 1987/10/05 20:35:54 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -77,6 +77,13 @@ MIT in each case. |#
            (@PCR ,(free-reference-label name))
            ,(reference-assignment-alias! target 'DATA))))
 
+(define-rule statement
+  (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name)))
+  (QUALIFIER (pseudo-register? target))
+  (LAP (MOV L
+           (@PCR ,(free-assignment-label name))
+           ,(reference-assignment-alias! target 'DATA))))
+
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (REGISTER (? source)))
   (QUALIFIER (pseudo-register? target))

diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm
index b68c3015a9235ec7401ffd7a06d2783c62ee779e..5f78b9d7a3da1dc1b59c9a5de1eea20e2e9f554c 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules3.scm
+++ b/v7/src/compiler/machines/bobcat/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.14 1987/09/03 05:14:52 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.15 1987/10/05 20:38:51 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -234,38 +234,45 @@ MIT in each case. |#
                   ,@(inner (cdr constants))))))
       (inner constants))
 
-    (lambda (block-label constants references uuo-links)
+    (define (declare-references references entry:single entry:multiple)
+      (if (null? references)
+         (LAP)
+         (LAP (LEA (@PCR ,(cdar references)) (A 1))
+              ,@(if (null? (cdr references))
+                    (LAP (JSR ,entry:single))
+                    (LAP ,(load-dnw (length references) 1)
+                         (JSR ,entry:multiple)))
+              ,@(make-external-label (generate-label)))))
+
+    (lambda (block-label constants references assignments uuo-links)
       (declare-constants references
-       (declare-constants uuo-links
-       (declare-constants constants
-        (LAP
-         ;; Place holder for the debugging info filename
-         ,@(let ((debugging-information-label (allocate-constant-label)))
-             (LAP (SCHEME-OBJECT ,debugging-information-label DEBUGGING-INFO)))
-         ,@(let ((environment-label (allocate-constant-label)))
-             (LAP (SCHEME-OBJECT ,environment-label ENVIRONMENT)
-                  (LEA (@PCR ,environment-label) (A 0))))
-         ,@(if (or (not (null? references))
-                   (not (null? uuo-links)))
-               (LAP (MOV L ,reg:environment (@A 0))
-                    (LEA (@PCR ,block-label) (A 0))
-                    ,@(if (null? references)
-                          (LAP)
-                          (LAP (LEA (@PCR ,(cdar references)) (A 1))
-                               ,@(if (null? (cdr references))
-                                     (LAP (JSR ,entry:compiler-cache-variable))
-                                     (LAP ,(load-dnw (length references) 1)
-                                          (JSR ,entry:compiler-cache-variable-multiple)))
-                               ,@(make-external-label (generate-label))))
-                    ,@(if (null? uuo-links)
-                          (LAP)
-                          (LAP (LEA (@PCR ,(cdar uuo-links)) (A 1))
-                               ,@(if (null? (cdr uuo-links))
-                                     (LAP (JSR ,entry:compiler-uuo-link))
-                                     (LAP ,(load-dnw (length uuo-links) 1)
-                                          (JSR ,entry:compiler-uuo-link-multiple)))
-                               ,@(make-external-label (generate-label)))))
-               (LAP ,(load-constant 0 '(@A 0)))))))))))
+       (declare-constants assignments
+       (declare-constants uuo-links
+        (declare-constants
+         constants
+         (let ((debugging-information-label (allocate-constant-label))
+               (environment-label (allocate-constant-label)))
+           (LAP
+            ;; Place holder for the debugging info filename
+            (SCHEME-OBJECT ,debugging-information-label DEBUGGING-INFO)
+            (SCHEME-OBJECT ,environment-label ENVIRONMENT)
+            (LEA (@PCR ,environment-label) (A 0))
+            ,@(if (and (null? references) (null? assignments) (null? uuo-links))
+                  (LAP ,(load-constant 0 '(@A 0)))
+                  (LAP (MOV L ,reg:environment (@A 0))
+                       (LEA (@PCR ,block-label) (A 0))
+                       ,@(declare-references
+                          references
+                          entry:compiler-cache-variable
+                          entry:compiler-cache-variable-multiple)
+                       ,@(declare-references
+                          assignments
+                          entry:compiler-cache-assignment
+                          entry:compiler-cache-assignment-multiple)
+                       ,@(declare-references
+                          uuo-links
+                          entry:compiler-uuo-link
+                          entry:compiler-uuo-link-multiple))))))))))))
 \f
 ;;;; Procedure/Continuation Entries