Use movxz in load-type to avoid byte-register restrictions.
authorCarl Shapiro <cshapiro@common-lisp.net>
Wed, 7 Aug 2013 06:06:09 +0000 (23:06 -0700)
committerCarl Shapiro <cshapiro@common-lisp.net>
Wed, 7 Aug 2013 06:18:30 +0000 (23:18 -0700)
src/compiler/x86/cell.lisp
src/compiler/x86/macros.lisp
src/compiler/x86/system.lisp
src/compiler/x86/values.lisp

index 9283a78..aeb18cd 100644 (file)
   (:args (function :scs (descriptor-reg) :target result)
         (fdefn :scs (descriptor-reg)))
   (:temporary (:sc unsigned-reg) raw)
-  (:temporary (:sc byte-reg) type)
+  (:temporary (:sc unsigned-reg) type)
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (load-type type function (- function-pointer-type))
index d4659c2..bbd5ef5 100644 (file)
              (n-offset offset))
     (ecase (backend-byte-order *target-backend*)
       (:little-endian
-       `(inst mov ,n-target
+       `(inst movzx ,n-target
              (make-ea :byte :base ,n-source :disp ,n-offset)))
       (:big-endian
-       `(inst mov ,n-target
+       `(inst movzx ,n-target
              (make-ea :byte :base ,n-source :disp (+ ,n-offset 3)))))))
 
 (defmacro load-foreign-data-symbol (reg name )
index 71f7bb2..683d9e2 100644 (file)
 (define-vop (get-type)
   (:translate get-type)
   (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:temporary (:sc unsigned-reg :offset eax-offset :to (:result 0)) eax)
-  (:results (result :scs (unsigned-reg)))
+  (:args (object :scs (descriptor-reg) :to (:eval 1)))
+  (:results (result :scs (unsigned-reg) :from (:eval 0)))
   (:result-types positive-fixnum)
   (:generator 6
-    (inst mov eax object)
-    (inst and al-tn lowtag-mask)
-    (inst cmp al-tn other-pointer-type)
+    ;; Pick off objects with headers.
+    (inst mov result object)
+    (inst and result lowtag-mask)
+    (inst cmp result other-pointer-type)
     (inst jmp :e other-ptr)
-    (inst cmp al-tn function-pointer-type)
+    (inst cmp result function-pointer-type)
     (inst jmp :e function-ptr)
 
-    ;; pick off structures and list pointers
-    (inst test al-tn 1)
-    (inst jmp :ne done)
+    ;; Pick off structure and list pointers.
+    (inst test result 1)
+    (inst jmp :nz done)
 
-    ;; pick off fixnums
-    (inst and al-tn 3)
-    (inst jmp :e done)
+    ;; Pick off fixnums.
+    (inst and result 3)
+    (inst jmp :z done)
 
-    ;; must be an other immediate
-    (inst mov eax object)
+    ;; Must be an other immediate.
+    (inst mov result object)
+    (inst and result type-mask)
     (inst jmp done)
-    
+
     FUNCTION-PTR
-    (load-type al-tn object (- vm:function-pointer-type))
+    (load-type result object (- vm:function-pointer-type))
     (inst jmp done)
-    
+
     OTHER-PTR
-    (load-type al-tn object (- vm:other-pointer-type))
-    
-    DONE
-    (inst movzx result al-tn)))
+    (load-type result object (- vm:other-pointer-type))
+
+    DONE))
 \f
 (define-vop (function-subtype)
   (:translate function-subtype)
   (:policy :fast-safe)
   (:args (function :scs (descriptor-reg)))
-  (:temporary (:sc byte-reg :from (:eval 0) :to (:eval 1)) temp)
   (:results (result :scs (unsigned-reg)))
   (:result-types positive-fixnum)
   (:generator 6
-    (load-type temp function (- vm:function-pointer-type))
-    (inst movzx result temp)))
+    (load-type result function (- vm:function-pointer-type))))
 
 (define-vop (set-function-subtype)
   (:translate (setf function-subtype))
index 765c045..7a06496 100644 (file)
   (:results (start :scs (any-reg))
            (count :scs (any-reg)))
   (:temporary (:sc descriptor-reg :from (:argument 0) :to (:result 1)) list)
-  (:temporary (:sc descriptor-reg :to (:result 1)) nil-temp)
-  (:temporary (:sc unsigned-reg :offset eax-offset :to (:result 1)) eax)
+  (:temporary (:sc unsigned-reg :to (:result 1)) temp)
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 0
     (move list arg)
     (move start esp-tn)                        ; WARN pointing 1 below
-    (inst mov nil-temp nil-value)
 
     LOOP
-    (inst cmp list nil-temp)
+    (inst cmp list nil-value)
     (inst jmp :e done)
     (pushw list cons-car-slot list-pointer-type)
     (loadw list list cons-cdr-slot list-pointer-type)
-    (inst mov eax list)
-    (inst and al-tn lowtag-mask)
-    (inst cmp al-tn list-pointer-type)
+    (inst mov temp list)
+    (inst and temp lowtag-mask)
+    (inst cmp temp list-pointer-type)
     (inst jmp :e loop)
     (error-call vop bogus-argument-to-values-list-error list)