From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Jan 1987 19:41:39 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: 20090517-FFI~13771
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ba88b6631c6adf67054d9316dfa1e829332ea60e;p=mit-scheme.git

*** empty log message ***
---

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index e269e3393..c46972255 100644
--- 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 31cb1c707..6a2598a6f 100644
--- 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))))))
+
+(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)))))))
 
 ;;;; Procedure/Continuation Entries