From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 2 Nov 2009 21:43:49 +0000 (-0500)
Subject: Simplify INVOCATION:PRIMITIVE for x86-64.
X-Git-Tag: 20100708-Gtk~275
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9110f1b411c459aa08c262f461398894e4882f2d;p=mit-scheme.git

Simplify INVOCATION:PRIMITIVE for x86-64.

No generated code changes; the code implementing the rule has just
been reduced by factoring out common parts of conditional branches.
---

diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm
index 99bef0f7b..54c101e86 100644
--- a/src/compiler/machines/x86-64/rules3.scm
+++ b/src/compiler/machines/x86-64/rules3.scm
@@ -173,27 +173,21 @@ USA.
       (LAP ,@(clear-map!)
 	   (MOV Q (R ,rcx) (&U ,frame-size))
 	   ,@(invoke-hook entry:compiler-error))
-      (let ((arity (primitive-procedure-arity primitive)))
-	(cond ((not (negative? arity))
-	       (let ((get-code
-		      (object->machine-register! primitive rcx)))
-		 (LAP ,@get-code
-		      ,@(clear-map!)
-		      ,@(invoke-hook entry:compiler-primitive-apply))))
-	      ((= arity -1)
-	       (let ((get-code (object->machine-register! primitive rcx)))
-		 (LAP ,@get-code
-		      ,@(clear-map!)
-		      (MOV Q ,reg:lexpr-primitive-arity (&U ,(-1+ frame-size)))
-		      ,@(invoke-hook entry:compiler-primitive-lexpr-apply))))
-	      (else
-	       ;; Unknown primitive arity.  Go through apply.
-	       (let ((get-code (object->machine-register! primitive rcx)))
-		 (LAP ,@get-code
-		      ,@(clear-map!)
-		      (MOV Q (R ,rdx) (&U ,frame-size))
-		      ,@(invoke-interface code:compiler-apply))))))))
-
+      (LAP ,@(object->machine-register! primitive rcx)
+	   ,@(clear-map!)
+	   ,@(let ((arity (primitive-procedure-arity primitive)))
+	       (cond ((not (negative? arity))
+		      (invoke-hook entry:compiler-primitive-apply))
+		     ((= arity -1)
+		      (LAP (MOV Q ,reg:lexpr-primitive-arity
+				(&U ,(- frame-size 1)))
+			   ,@(invoke-hook
+			      entry:compiler-primitive-lexpr-apply)))
+		     (else
+		      ;; Unknown primitive arity.  Go through apply.
+		      (LAP (MOV Q (R ,rdx) (&U ,frame-size))
+			   ,@(invoke-interface code:compiler-apply))))))))
+
 (let-syntax
     ((define-primitive-invocation
        (sc-macro-transformer