]> gitweb.factorcode.org Git - factor.git/commitdiff
cpu.x86: fix a bug in small-register logic on 32-bit. Also, on 32-bit, we don't need...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 30 Jul 2009 10:04:46 +0000 (05:04 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 30 Jul 2009 10:04:46 +0000 (05:04 -0500)
basis/cpu/x86/x86.factor

index 5dc3ef2e0a8650ab2eda7d0b5d14edc3faa89ec1..6e21b46fd5968d6f4f20b287cfa7a423d1e8a144 100644 (file)
@@ -264,52 +264,48 @@ M:: x86 %box-alien ( dst src temp -- )
         "end" resolve-label
     ] with-scope ;
 
-HOOK: small-reg? cpu ( reg -- regs )
+! The 'small-reg' mess is pretty crappy, but its only used on x86-32.
+! On x86-64, all registers have 8-bit versions. However, a similar
+! problem arises for shifts, where the shift count must be in CL, and
+! so one day I will fix this properly by adding precoloring to the
+! register allocator.
 
-M: x86.32 small-reg? { EAX ECX EDX EBX } memq? ;
-M: x86.64 small-reg? drop t ;
+HOOK: has-small-reg? cpu ( reg size -- ? )
+
+CONSTANT: have-byte-regs { EAX ECX EDX EBX }
+
+M: x86.32 has-small-reg?
+    {
+        { 8 [ have-byte-regs memq? ] }
+        { 16 [ drop t ] }
+        { 32 [ drop t ] }
+    } case ;
+
+M: x86.64 has-small-reg? drop t ;
 
 : small-reg-that-isn't ( exclude -- reg' )
-    [ native-version-of ] map [ small-reg? not ] find nip ;
+    [ have-byte-regs ] dip
+    [ native-version-of ] map
+    '[ _ memq? not ] find nip ;
 
 : with-save/restore ( reg quot -- )
     [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
 
-:: with-small-register ( dst exclude quot: ( new-dst -- ) -- )
-    #! If the destination register overlaps a small register, we
-    #! call the quot with that. Otherwise, we find a small
-    #! register that is not in exclude, and call quot, saving
-    #! and restoring the small register.
-    dst small-reg? [ dst quot call ] [
+:: with-small-register ( dst exclude size quot: ( new-dst -- ) -- )
+    ! If the destination register overlaps a small register with
+    ! 'size' bits, we call the quot with that. Otherwise, we find a
+    ! small register that is not in exclude, and call quot, saving and
+    ! restoring the small register.
+    dst size has-small-reg? [ dst quot call ] [
         exclude small-reg-that-isn't
         [ quot call ] with-save/restore
     ] if ; inline
 
-: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
-
-:: emit-shift ( dst src1 src2 quot -- )
-    src2 shift-count? [
-        dst CL quot call
-    ] [
-        dst shift-count? [
-            dst src2 XCHG
-            src2 CL quot call
-            dst src2 XCHG
-        ] [
-            ECX native-version-of [
-                CL src2 MOV
-                drop dst CL quot call
-            ] with-save/restore
-        ] if
-    ] if ; inline
-
-M: x86 %shl [ SHL ] emit-shift ;
-M: x86 %shr [ SHR ] emit-shift ;
-M: x86 %sar [ SAR ] emit-shift ;
-
 M:: x86 %string-nth ( dst src index temp -- )
+    ! We request a small-reg of size 8 since those of size 16 are
+    ! a superset.
     "end" define-label
-    dst { src index temp } [| new-dst |
+    dst { src index temp } [| new-dst |
         ! Load the least significant 7 bits into new-dst.
         ! 8th bit indicates whether we have to load from
         ! the aux vector or not.
@@ -336,15 +332,15 @@ M:: x86 %string-nth ( dst src index temp -- )
     ] with-small-register ;
 
 M:: x86 %set-string-nth-fast ( ch str index temp -- )
-    ch { index str temp } [| new-ch |
+    ch { index str temp } [| new-ch |
         new-ch ch ?MOV
         temp str index [+] LEA
         temp string-offset [+] new-ch 8-bit-version-of MOV
     ] with-small-register ;
 
 :: %alien-integer-getter ( dst src size quot -- )
-    dst { src } [| new-dst |
-        new-dst dup size 8 * n-bit-version-of dup src [] MOV
+    dst { src } size [| new-dst |
+        new-dst dup size n-bit-version-of dup src [] MOV
         quot call
         dst new-dst ?MOV
     ] with-small-register ; inline
@@ -352,35 +348,56 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
 : %alien-unsigned-getter ( dst src size -- )
     [ MOVZX ] %alien-integer-getter ; inline
 
-M: x86 %alien-unsigned-1 1 %alien-unsigned-getter ;
-M: x86 %alien-unsigned-2 2 %alien-unsigned-getter ;
+M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
+M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
+M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
 
 : %alien-signed-getter ( dst src size -- )
     [ MOVSX ] %alien-integer-getter ; inline
 
-M: x86 %alien-signed-1 1 %alien-signed-getter ;
-M: x86 %alien-signed-2 2 %alien-signed-getter ;
-M: x86 %alien-signed-4 4 %alien-signed-getter ;
-
-M: x86 %alien-unsigned-4 4 [ 2drop ] %alien-integer-getter ;
+M: x86 %alien-signed-1 8 %alien-signed-getter ;
+M: x86 %alien-signed-2 16 %alien-signed-getter ;
+M: x86 %alien-signed-4 32 %alien-signed-getter ;
 
 M: x86 %alien-cell [] MOV ;
 M: x86 %alien-float dupd [] MOVSS dup CVTSS2SD ;
 M: x86 %alien-double [] MOVSD ;
 
 :: %alien-integer-setter ( ptr value size -- )
-    value { ptr } [| new-value |
+    value { ptr } size [| new-value |
         new-value value ?MOV
-        ptr [] new-value size 8 * n-bit-version-of MOV
+        ptr [] new-value size n-bit-version-of MOV
     ] with-small-register ; inline
 
-M: x86 %set-alien-integer-1 1 %alien-integer-setter ;
-M: x86 %set-alien-integer-2 2 %alien-integer-setter ;
-M: x86 %set-alien-integer-4 4 %alien-integer-setter ;
+M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
+M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
+M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
 M: x86 %set-alien-cell [ [] ] dip MOV ;
 M: x86 %set-alien-float dup dup CVTSD2SS [ [] ] dip MOVSS ;
 M: x86 %set-alien-double [ [] ] dip MOVSD ;
 
+: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
+
+:: emit-shift ( dst src1 src2 quot -- )
+    src2 shift-count? [
+        dst CL quot call
+    ] [
+        dst shift-count? [
+            dst src2 XCHG
+            src2 CL quot call
+            dst src2 XCHG
+        ] [
+            ECX native-version-of [
+                CL src2 MOV
+                drop dst CL quot call
+            ] with-save/restore
+        ] if
+    ] if ; inline
+
+M: x86 %shl [ SHL ] emit-shift ;
+M: x86 %shr [ SHR ] emit-shift ;
+M: x86 %sar [ SAR ] emit-shift ;
+
 : load-zone-ptr ( reg -- )
     #! Load pointer to start of zone array
     0 MOV "nursery" f rc-absolute-cell rel-dlsym ;