From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 29 Feb 2012 19:36:13 +0000 (-0700)
Subject: svm: Widen invocation:lookup, :cache-reference patterns.
X-Git-Tag: release-9.2.0~278^2~4
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ec1a9945ac3db58db1f412cab4d6c63a6be188bb;p=mit-scheme.git

svm: Widen invocation:lookup, :cache-reference patterns.

The (REGISTER (?...)) patterns work for the entire system, but these
rules provide the same generality as those in other machines' lapgens.
Presume that interpreter-call-temporaries can be allocated in any
order (punting let*).
---

diff --git a/src/compiler/machines/svm/rules.scm b/src/compiler/machines/svm/rules.scm
index 0757fc9ac..51ff58969 100644
--- a/src/compiler/machines/svm/rules.scm
+++ b/src/compiler/machines/svm/rules.scm
@@ -131,6 +131,8 @@ USA.
   (ASSIGN (REGISTER (? target))
 	  (CONS-NON-POINTER (MACHINE-CONSTANT (? type))
 			    (MACHINE-CONSTANT (? datum))))
+  (if (>= datum signed-fixnum/upper-limit)
+      (error "Can't encode non-pointer datum:" datum))
   (inst:load-non-pointer (word-target target)
 			 type
 			 datum))
@@ -638,12 +640,11 @@ USA.
 		     (global-uuo-link-label name frame-size)))))
 
 (define-rule statement
-  (INVOCATION:CACHE-REFERENCE (? frame-size)
-			      (? continuation)
-			      (REGISTER (? extension)))
+  (INVOCATION:CACHE-REFERENCE (? frame-size) (? continuation) (? extension))
+  (QUALIFIER (interpreter-call-argument? extension))
   continuation
   (expect-no-exit-interrupt-checks)
-  (let ((rref:cache-addr (word-source extension))
+  (let ((rref:cache-addr (interpreter-call-temporary extension))
 	(rref:block-addr (word-temporary))
 	(rref:frame-size (word-temporary)))
     (LAP ,@(clear-map!)
@@ -654,13 +655,11 @@ USA.
 
 #| There is no comutil_lookup_apply, no (trap:lookup-apply ...) instruction.
  (define-rule statement
-  (INVOCATION:LOOKUP (? frame-size)
-		     (? continuation)
-		     (REGISTER (? environment))
-		     (? name))
+  (INVOCATION:LOOKUP (? frame-size) (? continuation) (? environment) (? name))
+  (QUALIFIER (interpreter-call-argument? environment))
   continuation
   (expect-no-entry-interrupt-checks)
-  (let ((rref:environment (word-source environment))
+  (let ((rref:environment (interpreter-call-temporary environment))
 	(rref:frame-size (word-temporary))
 	(rref:name (word-temporary)))
     (LAP ,@(clear-map!)
@@ -1350,10 +1349,10 @@ USA.
   (QUALIFIER (and (interpreter-call-argument? extension)
 		  (interpreter-call-argument? value)))
   cont					; ignored
-  (let* ((cache (interpreter-call-temporary extension))
-	 (value (interpreter-call-temporary value)))
-   (LAP ,@(clear-map!)
-	,@(trap:assignment cache value))))
+  (let ((cache (interpreter-call-temporary extension))
+	(value (interpreter-call-temporary value)))
+    (LAP ,@(clear-map!)
+	 ,@(trap:assignment cache value))))
 
 (define-rule statement
   (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension))