Use BTS to affix single-bit type tags.

diff --git a/src/compiler/machines/x86-64/rules1.scm b/src/compiler/machines/x86-64/rules1.scm
index 8dd0daddc7ca6403f6bca8173eb5c2c362f50909..68614917f3715ff2d20370de1f916c2235f19f9e 100644 (file)
--- a/src/compiler/machines/x86-64/rules1.scm
+++ b/src/compiler/machines/x86-64/rules1.scm
@@ -110,8 +110,15 @@ USA.
          (CONS-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? datum))))
   (if (zero? type)
       (assign-register->register target datum)
-      (let* ((target (standard-move-to-target! datum target))
-            (temp (temporary-register-reference)))
+      (affix-type (standard-move-to-target! datum target) type)))
+
+(define (affix-type target type)
+  (if (= 1 (bit-count type))
+      (let ((bit (first-set-bit type)))
+       (assert (<= 0 bit))
+       (assert (< bit scheme-type-width))
+       (LAP (BTS Q ,target (&U ,(+ scheme-datum-width bit)))))
+      (let ((temp (temporary-register-reference)))
        (LAP (MOV Q ,temp (&U ,(make-non-pointer-literal type 0)))
             (OR Q ,target ,temp)))))
 
@@ -201,27 +208,23 @@ USA.
                        (ENTRY:CONTINUATION (? label))))
   (assert (= type type-code:compiled-return))
   (let* ((target (target-register-reference target))
-        (temp (temporary-register-reference))
         (pushed (generate-label 'PUSHED)))
     (LAP (CALL (@PCR ,pushed))
         (JMP (@PCRO ,label 8))
        (LABEL ,pushed)
         (POP Q ,target)
-        (MOV Q ,temp (&U ,(make-non-pointer-literal type 0)))
-        (OR Q ,target ,temp))))
+        ,@(affix-type target type))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 4) -1)
          (CONS-POINTER (MACHINE-CONSTANT (? type))
                        (ENTRY:CONTINUATION (? label))))
   (assert (= type type-code:compiled-return))
-  (let* ((temp (temporary-register-reference))
-        (pushed (generate-label 'PUSHED)))
+  (let ((pushed (generate-label 'PUSHED)))
     (LAP (CALL (@PCR ,pushed))
         (JMP (@PCRO ,label 8))
        (LABEL ,pushed)
-        (MOV Q ,temp (&U ,(make-non-pointer-literal type 0)))
-        (OR Q (@R 4) ,temp))))
+        ,@(affix-type (INST-EA (@R 4)) type))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name)))
@@ -430,6 +433,9 @@ USA.
     (LAP (LEA Q ,target ,source))))  
 
 (define (load-pc-relative-address/typed target type label offset)
+  (LAP (LEA Q ,target (@PCRO ,label ,offset))
+       ,@(affix-type target type))
+  #|
   ;++ This is pretty horrid, especially since it happens for every
   ;++ continuation pushed!  None of the alternatives is much good.
   ;; Twenty bytes, but only three instructions and no extra memory.
@@ -437,6 +443,7 @@ USA.
     (LAP (MOV Q ,temp (&U ,(make-non-pointer-literal type 0)))
         (LEA Q ,target (@PCRO ,label ,offset))
         (OR Q ,target ,temp)))
+  |#
   #|
   ;; Nineteen bytes, but rather complicated (and needs syntax for an
   ;; addressing mode not presently supported).