cpu.x86.assembler: fix extended 8-bit registers (DIL, SIL, SPL, BPL)

basis/cpu/x86/assembler/assembler-tests.factor

@@ -1,7 +1,9 @@
-USING: cpu.x86.assembler cpu.x86.operands
+USING: cpu.x86.assembler cpu.x86.assembler.operands
 kernel tools.test namespaces make ;
 IN: cpu.x86.assembler.tests
 
+[ { HEX: 40 HEX: 8a HEX: 2a } ] [ [ BPL RDX [] MOV ] { } make ] unit-test
+
 [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
 [ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test
 

basis/cpu/x86/assembler/assembler.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io.binary kernel combinators kernel.private math
+USING: arrays io.binary kernel combinators kernel.private math locals
 namespaces make sequences words system layouts math.order accessors
 cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
 QUALIFIED: sequences
@@ -10,8 +10,6 @@ IN: cpu.x86.assembler
 
 <PRIVATE
 
-#! Extended AMD64 registers (R8-R15) return true.
-
 : reg-code ( reg -- n ) "register" word-prop 7 bitand ;
 
 : indirect-base* ( op -- n ) base>> EBP or reg-code ;
@@ -86,9 +84,7 @@ M: indirect displacement,
     dup displacement>> dup [
         swap base>>
         [ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if
-    ] [
+    ] [ 2drop ] if ;
-        2drop
-    ] if ;
 
 M: register displacement, drop ;
 
@@ -107,22 +103,25 @@ M: register displacement, drop ;
 
 : rex.b ( m op -- n )
     [ extended? [ BIN: 00000001 bitor ] when ] keep
-    dup indirect? [
+    dup indirect? [ index>> extended? [ BIN: 00000010 bitor ] when ] [ drop ] if ;
-        index>> extended? [ BIN: 00000010 bitor ] when
-    ] [
-        drop
-    ] if ;
 
-: rex-prefix ( reg r/m rex.w -- )
+: no-prefix? ( prefix reg r/m -- ? )
+    [ BIN: 01000000 = ]
+    [ extended-8-bit-register? not ]
+    [ extended-8-bit-register? not ] tri*
+    and and ;
+
+:: rex-prefix ( reg r/m rex.w -- )
     #! Compile an AMD64 REX prefix.
-    2over rex.w? BIN: 01001000 BIN: 01000000 ?
+    rex.w reg r/m rex.w? BIN: 01001000 BIN: 01000000 ?
-    swap rex.r swap rex.b
+    r/m rex.r
-    dup BIN: 01000000 = [ drop ] [ , ] if ;
+    reg rex.b
+    dup reg r/m no-prefix? [ drop ] [ , ] if ;
 
 : 16-prefix ( reg r/m -- )
     [ register-16? ] either? [ HEX: 66 , ] when ;
 
-: prefix ( reg r/m rex.w -- ) 2over 16-prefix rex-prefix ;
+: prefix ( reg r/m rex.w -- ) [ drop 16-prefix ] [ rex-prefix ] 3bi ;
 
 : prefix-1 ( reg rex.w -- ) f swap prefix ;
 
@@ -184,10 +183,7 @@ M: register displacement, drop ;
 : 2-operand ( dst src op -- )
     #! Sets the opcode's direction bit. It is set if the
     #! destination is a direct register operand.
-    2over 16-prefix
+    [ drop 16-prefix ] [ direction-bit operand-size-bit (2-operand) ] 3bi ;
-    direction-bit
-    operand-size-bit
-    (2-operand) ;
 
 PRIVATE>
 

basis/cpu/x86/assembler/operands/operands.factor

@@ -102,10 +102,13 @@ TUPLE: byte value ;
 
 C: <byte> byte
 
+: extended-8-bit-register? ( register -- ? )
+    { SPL BPL SIL DIL } memq? ;
+
 : n-bit-version-of ( register n -- register' )
     ! Certain 8-bit registers don't exist in 32-bit mode...
     [ "register" word-prop ] dip registers get at nth
-    dup { SPL BPL SIL DIL } memq? cell 4 = and
+    dup extended-8-bit-register? cell 4 = and
     [ drop f ] when ;
 
 : 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ;