*** empty log message ***

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index e269e3393c5c2c526af891248f4c83f8cba96bed..c46972255fb308c97516f7f0a6d531400f284b3f 100644 (file)
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    Copyright (c) 1986 Massachusetts Institute of Technology
+;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -37,7 +37,7 @@
 
 ;;;; LAP Code Generation
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.23 1986/12/21 19:34:12 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.24 1987/01/01 19:41:05 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -227,6 +227,7 @@
   (need-register! alias))
 
 (define (clear-map!)
+  (delete-dead-registers!)
   (let ((instructions (clear-map)))
     (set! *register-map* (empty-register-map))
     (set! *needed-registers* '())

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index 31cb1c707a4d01709e9e715cf639b93a9b06c878..6a2598a6f14fb8069cd4ea4aeb2e29e7a7beeb6c 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    Copyright (c) 1986 Massachusetts Institute of Technology
+;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -37,7 +37,7 @@
 
 ;;;; RTL Rules for 68020
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.143 1986/12/21 19:46:08 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.144 1987/01/01 19:41:39 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access lap-generator-syntax-table compiler-package)
@@ -283,6 +283,13 @@
     ;; requires that we first mask it.
     `((MOVE L ,source
            ,(register-reference (allocate-alias-register! target 'DATA))))))
+\f
+(define-rule statement
+  (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1))
+  (let ((target* (coerce->any target)))
+    (if (pseudo-register? target)
+       (delete-dead-registers!))
+    `((MOVE L (@A+ 7) ,target*))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
@@ -310,6 +317,11 @@
          (REGISTER (? r)))
   `((MOVE L ,(coerce->any r) ,(indirect-reference! a n))))
 
+(define-rule statement
+  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
+         (POST-INCREMENT (REGISTER 15) 1))
+  `((MOVE L (@A+ 7) ,(indirect-reference! a n))))
+
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? a)) (? n))
          (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
@@ -553,11 +565,12 @@
 
 (define (lookup-call entry environment name)
   (let ((set-environment (expression->machine-register! environment a0)))
-    `(,@set-environment
-      ,@(clear-map!)
-      ,(load-constant name '(A 1))
-      (JSR ,entry)
-      ,@(make-external-label (generate-label)))))
+    (let ((clear-map (clear-map!)))
+      `(,@set-environment
+       ,@clear-map
+       ,(load-constant name '(A 1))
+       (JSR ,entry)
+       ,@(make-external-label (generate-label))))))
 
 (define-rule statement
   (INTERPRETER-CALL:ENCLOSE (? number-pushed))
@@ -588,12 +601,13 @@
 (define (assignment-call:default entry environment name value)
   (let ((set-environment (expression->machine-register! environment a0)))
     (let ((set-value (expression->machine-register! value a2)))
-      `(,@set-environment
-       ,@set-value
-       ,@(clear-map!)
-       ,(load-constant name '(A 1))
-       (JSR ,entry)
-       ,@(make-external-label (generate-label))))))
+      (let ((clear-map (clear-map!)))
+       `(,@set-environment
+         ,@set-value
+         ,@clear-map
+         ,(load-constant name '(A 1))
+         (JSR ,entry)
+         ,@(make-external-label (generate-label)))))))
 
 (define-rule statement
   (INTERPRETER-CALL:DEFINE (? environment) (? name)
@@ -611,14 +625,16 @@
 
 (define (assignment-call:cons-pointer entry environment name type datum)
   (let ((set-environment (expression->machine-register! environment a0)))
-    `(,@set-environment
-      (MOVE L ,(coerce->any datum) ,reg:temp)
-      (MOVE B (& ,type) ,reg:temp)
-      ,@(clear-map!)
-      (MOVE L ,reg:temp (A 2))
-      ,(load-constant name '(A 1))
-      (JSR ,entry)
-      ,@(make-external-label (generate-label)))))
+    (let ((datum (coerce->any datum)))
+      (let ((clear-map (clear-map!)))
+       `(,@set-environment
+         (MOVE L ,datum ,reg:temp)
+         (MOVE B (& ,type) ,reg:temp)
+         ,@clear-map
+         (MOVE L ,reg:temp (A 2))
+         ,(load-constant name '(A 1))
+         (JSR ,entry)
+         ,@(make-external-label (generate-label)))))))
 \f
 ;;;; Procedure/Continuation Entries