Simplify INVOCATION:PRIMITIVE for x86-64.
authorTaylor R Campbell <campbell@mumble.net>
Mon, 2 Nov 2009 21:43:49 +0000 (16:43 -0500)
committerTaylor R Campbell <campbell@mumble.net>
Mon, 2 Nov 2009 21:43:49 +0000 (16:43 -0500)
No generated code changes; the code implementing the rule has just
been reduced by factoring out common parts of conditional branches.

src/compiler/machines/x86-64/rules3.scm

index 99bef0f7b960dc93266968e727cfd162256df54f..54c101e86ed4406317782a90fd25d47584a05e9a 100644 (file)
@@ -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))))))))
-\f
+      (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