cpu.x86.assembler: move operands to operands sub-vocabulary, clean up small-reg-...

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 727131aa25d26d984b7a9d2db94b5285bef67572..76699c1306c09b142622f0d18d96ffaaf60ccd80 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -1,13 +1,12 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: locals alien.c-types alien.syntax arrays kernel fry
-math namespaces sequences system layouts io vocabs.loader
-accessors init combinators command-line cpu.x86.assembler
-cpu.x86 cpu.architecture make compiler compiler.units
+USING: locals alien.c-types alien.syntax arrays kernel fry math
+namespaces sequences system layouts io vocabs.loader accessors init
+combinators command-line make compiler compiler.units
 compiler.constants compiler.alien compiler.codegen
-compiler.codegen.fixup compiler.cfg.instructions
-compiler.cfg.builder compiler.cfg.intrinsics
-compiler.cfg.stack-frame ;
+compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder
+compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler
+cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
 IN: cpu.x86.32
 
 ! We implement the FFI for Linux, OS X and Windows all at once.

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 8eb04eb2b5e5eec8f12d9b75cce9fe8d0decf91d..f837c7de7300cd3542fc7fde298653a4e1b4b359 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -1,12 +1,11 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math namespaces make sequences
-system layouts alien alien.c-types alien.accessors alien.structs
-slots splitting assocs combinators locals cpu.x86.assembler
-cpu.x86 cpu.architecture compiler.constants
-compiler.codegen compiler.codegen.fixup
-compiler.cfg.instructions compiler.cfg.builder
-compiler.cfg.intrinsics compiler.cfg.stack-frame ;
+USING: accessors arrays kernel math namespaces make sequences system
+layouts alien alien.c-types alien.accessors alien.structs slots
+splitting assocs combinators locals compiler.constants
+compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
+compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
+cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
 IN: cpu.x86.64
 
 M: x86.64 machine-registers

diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index eea960d03dba6fe2e851acfe8fb123c7af286234..7ab25b6d3f2f04ed944178e4f807a39fd7872461 100644 (file)
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences math splitting make assocs
-kernel layouts system alien.c-types alien.structs
-cpu.architecture cpu.x86.assembler cpu.x86
-compiler.codegen compiler.cfg.registers ;
+USING: accessors arrays sequences math splitting make assocs kernel
+layouts system alien.c-types alien.structs cpu.architecture
+cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
+compiler.cfg.registers ;
 IN: cpu.x86.64.unix
 
 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;

diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor
index 66adee6bf6d59e524322813949fbac7f21d2377c..962309c67e302d0e2d712e54ecdf916c44a7e69f 100644 (file)
--- a/basis/cpu/x86/assembler/assembler-tests.factor
+++ b/basis/cpu/x86/assembler/assembler-tests.factor
@@ -1,4 +1,5 @@
-USING: cpu.x86.assembler kernel tools.test namespaces make ;
+USING: cpu.x86.assembler cpu.x86.operands
+kernel tools.test namespaces make ;
 IN: cpu.x86.assembler.tests
 
 [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test

diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor
index e91ebdcb1aae78e76bfc3c33ff639ff25aa40479..f15704a015b4c7ba4a23e7aad41994dd80f48a89 100644 (file)
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/basis/cpu/x86/assembler/assembler.factor
@@ -1,89 +1,16 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! 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
 namespaces make sequences words system layouts math.order accessors
-cpu.x86.assembler.syntax ;
+cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
 QUALIFIED: sequences
 IN: cpu.x86.assembler
 
 ! A postfix assembler for x86-32 and x86-64.
 
-! In 32-bit mode, { 1234 } is absolute indirect addressing.
-! In 64-bit mode, { 1234 } is RIP-relative.
-! Beware!
-
-! Register operands -- eg, ECX
-REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
-
-ALIAS: AH SPL
-ALIAS: CH BPL
-ALIAS: DH SIL
-ALIAS: BH DIL
-
-REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
-
-REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
-
-REGISTERS: 64
-RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
-
-REGISTERS: 128
-XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
-XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
-
-TUPLE: byte value ;
-
-C: <byte> byte
-
 <PRIVATE
 
 #! Extended AMD64 registers (R8-R15) return true.
-GENERIC: extended? ( op -- ? )
-
-M: object extended? drop f ;
-
-PREDICATE: register < word
-    "register" word-prop ;
-
-PREDICATE: register-8 < register
-    "register-size" word-prop 8 = ;
-
-PREDICATE: register-16 < register
-    "register-size" word-prop 16 = ;
-
-PREDICATE: register-32 < register
-    "register-size" word-prop 32 = ;
-
-PREDICATE: register-64 < register
-    "register-size" word-prop 64 = ;
-
-PREDICATE: register-128 < register
-    "register-size" word-prop 128 = ;
-
-M: register extended? "register" word-prop 7 > ;
-
-! Addressing modes
-TUPLE: indirect base index scale displacement ;
-
-M: indirect extended? base>> extended? ;
-
-: canonicalize-EBP ( indirect -- indirect )
-    #! { EBP } ==> { EBP 0 }
-    dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
-    [ 0 >>displacement ] when ;
-
-ERROR: bad-index indirect ;
-
-: check-ESP ( indirect -- indirect )
-    dup index>> { ESP RSP } memq? [ bad-index ] when ;
-
-: canonicalize ( indirect -- indirect )
-    #! Modify the indirect to work around certain addressing mode
-    #! quirks.
-    canonicalize-EBP check-ESP ;
-
-: <indirect> ( base index scale displacement -- indirect )
-    indirect boa canonicalize ;
 
 : reg-code ( reg -- n ) "register" word-prop 7 bitand ;
 
@@ -168,18 +95,6 @@ M: register displacement, drop ;
 : addressing ( reg# indirect -- )
     [ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
 
-! Utilities
-UNION: operand register indirect ;
-
-GENERIC: operand-64? ( operand -- ? )
-
-M: indirect operand-64?
-    [ base>> ] [ index>> ] bi [ operand-64? ] either? ;
-
-M: register-64 operand-64? drop t ;
-
-M: object operand-64? drop f ;
-
 : rex.w? ( rex.w reg r/m -- ? )
     {
         { [ dup register-128? ] [ drop operand-64? ] }
@@ -276,15 +191,6 @@ M: object operand-64? drop f ;
 
 PRIVATE>
 
-: [] ( reg/displacement -- indirect )
-    dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
-
-: [+] ( reg displacement -- indirect )
-    dup integer?
-    [ dup zero? [ drop f ] when [ f f ] dip ]
-    [ f f ] if
-    <indirect> ;
-
 ! Moving stuff
 GENERIC: PUSH ( op -- )
 M: register PUSH f HEX: 50 short-operand ;

diff --git a/basis/cpu/x86/assembler/authors.txt b/basis/cpu/x86/assembler/authors.txt
index 1901f27a24507e2512d93a1f956aaaa0d2f05714..580f882c8d78327fd1fc737a4da0624407fe0e7a 100755 (executable)
--- a/basis/cpu/x86/assembler/authors.txt
+++ b/basis/cpu/x86/assembler/authors.txt
@@ -1 +1,2 @@
 Slava Pestov
+Joe Groff

diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor
new file mode 100644 (file)
index 0000000..733c576
--- /dev/null
+++ b/basis/cpu/x86/assembler/operands/operands.factor
@@ -0,0 +1,118 @@
+! Copyright (C) 2008, 2009 Slava Pestov, Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel words math accessors sequences cpu.x86.assembler.syntax ;
+IN: cpu.x86.assembler.operands
+
+! In 32-bit mode, { 1234 } is absolute indirect addressing.
+! In 64-bit mode, { 1234 } is RIP-relative.
+! Beware!
+
+REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
+
+ALIAS: AH SPL
+ALIAS: CH BPL
+ALIAS: DH SIL
+ALIAS: BH DIL
+
+REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
+
+REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
+
+REGISTERS: 64
+RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
+
+REGISTERS: 128
+XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
+XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
+
+<PRIVATE
+
+GENERIC: extended? ( op -- ? )
+
+M: object extended? drop f ;
+
+PREDICATE: register < word
+    "register" word-prop ;
+
+PREDICATE: register-8 < register
+    "register-size" word-prop 8 = ;
+
+PREDICATE: register-16 < register
+    "register-size" word-prop 16 = ;
+
+PREDICATE: register-32 < register
+    "register-size" word-prop 32 = ;
+
+PREDICATE: register-64 < register
+    "register-size" word-prop 64 = ;
+
+PREDICATE: register-128 < register
+    "register-size" word-prop 128 = ;
+
+M: register extended? "register" word-prop 7 > ;
+
+! Addressing modes
+TUPLE: indirect base index scale displacement ;
+
+M: indirect extended? base>> extended? ;
+
+: canonicalize-EBP ( indirect -- indirect )
+    #! { EBP } ==> { EBP 0 }
+    dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
+    [ 0 >>displacement ] when ;
+
+ERROR: bad-index indirect ;
+
+: check-ESP ( indirect -- indirect )
+    dup index>> { ESP RSP } memq? [ bad-index ] when ;
+
+: canonicalize ( indirect -- indirect )
+    #! Modify the indirect to work around certain addressing mode
+    #! quirks.
+    canonicalize-EBP check-ESP ;
+
+: <indirect> ( base index scale displacement -- indirect )
+    indirect boa canonicalize ;
+
+! Utilities
+UNION: operand register indirect ;
+
+GENERIC: operand-64? ( operand -- ? )
+
+M: indirect operand-64?
+    [ base>> ] [ index>> ] bi [ operand-64? ] either? ;
+
+M: register-64 operand-64? drop t ;
+
+M: object operand-64? drop f ;
+
+PRIVATE>
+
+: [] ( reg/displacement -- indirect )
+    dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
+
+: [+] ( reg displacement -- indirect )
+    dup integer?
+    [ dup zero? [ drop f ] when [ f f ] dip ]
+    [ f f ] if
+    <indirect> ;
+
+TUPLE: byte value ;
+
+C: <byte> byte
+
+<PRIVATE
+
+: 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
+    [ drop f ] when ;
+
+PRIVATE>
+
+: 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ;
+: 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ;
+: 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ;
+: 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ;
+: native-version-of ( register -- register' ) cell-bits n-bit-version-of ;
\ No newline at end of file

diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor
index 631dcaa8f7d3536fae6f9d169f407a523a3c20bb..5b65c19155055aa3b9b9db9a0113fef44f168a18 100644 (file)
--- a/basis/cpu/x86/assembler/syntax/syntax.factor
+++ b/basis/cpu/x86/assembler/syntax/syntax.factor
@@ -1,14 +1,23 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words words.symbol sequences lexer parser fry ;
+USING: kernel words words.symbol sequences lexer parser fry
+namespaces combinators assocs ;
 IN: cpu.x86.assembler.syntax
 
-: define-register ( name num size -- )
-    [ "cpu.x86.assembler" create dup define-symbol ] 2dip
-    [ dupd "register" set-word-prop ] dip
-    "register-size" set-word-prop ;
+SYMBOL: registers
 
-: define-registers ( names size -- )
-    '[ _ define-register ] each-index ;
+registers [ H{ } clone ] initialize
 
-SYNTAX: REGISTERS: scan-word ";" parse-tokens swap define-registers ;
+: define-register ( name num size -- word )
+    [ "cpu.x86.assembler.operands" create ] 2dip {
+        [ 2drop ]
+        [ 2drop define-symbol ]
+        [ drop "register" set-word-prop ]
+        [ nip "register-size" set-word-prop ]
+    } 3cleave ;
+
+: define-registers ( size names -- )
+    [ swap '[ _ define-register ] map-index ] [ drop ] 2bi
+    registers get set-at ;
+
+SYNTAX: REGISTERS: scan-word ";" parse-tokens define-registers ;

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 258f84259877d7579f5a4a20aee2dd147067528b..337232c2594949567c401e37d0f80aa7b79ea061 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs alien alien.c-types arrays strings
-cpu.x86.assembler cpu.x86.assembler.private cpu.architecture
-kernel kernel.private math memory namespaces make sequences
-words system layouts combinators math.order fry locals
+cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
+cpu.architecture kernel kernel.private math memory namespaces make
+sequences words system layouts combinators math.order fry locals
 compiler.constants
 compiler.cfg.registers
 compiler.cfg.instructions
@@ -264,67 +264,6 @@ M:: x86 %box-alien ( dst src temp -- )
         "end" resolve-label
     ] with-scope ;
 
-: small-reg-8 ( reg -- reg' )
-    H{
-        { EAX RAX }
-        { ECX RCX }
-        { EDX RDX }
-        { EBX RBX }
-        { ESP RSP }
-        { EBP RBP }
-        { ESI RSP }
-        { EDI RDI }
-
-        { RAX RAX }
-        { RCX RCX }
-        { RDX RDX }
-        { RBX RBX }
-        { RSP RSP }
-        { RBP RBP }
-        { RSI RSP }
-        { RDI RDI }
-    } at ; inline
-
-: small-reg-4 ( reg -- reg' )
-    small-reg-8 H{
-        { RAX EAX }
-        { RCX ECX }
-        { RDX EDX }
-        { RBX EBX }
-        { RSP ESP }
-        { RBP EBP }
-        { RSI ESP }
-        { RDI EDI }
-    } at ; inline
-
-: small-reg-2 ( reg -- reg' )
-    small-reg-4 H{
-        { EAX AX }
-        { ECX CX }
-        { EDX DX }
-        { EBX BX }
-        { ESP SP }
-        { EBP BP }
-        { ESI SI }
-        { EDI DI }
-    } at ; inline
-
-: small-reg-1 ( reg -- reg' )
-    small-reg-4 {
-        { EAX AL }
-        { ECX CL }
-        { EDX DL }
-        { EBX BL }
-    } at ; inline
-
-: small-reg ( reg size -- reg' )
-    {
-        { 1 [ small-reg-1 ] }
-        { 2 [ small-reg-2 ] }
-        { 4 [ small-reg-4 ] }
-        { 8 [ small-reg-8 ] }
-    } case ;
-
 HOOK: small-regs cpu ( -- regs )
 
 M: x86.32 small-regs { EAX ECX EDX EBX } ;
@@ -336,7 +275,7 @@ M: x86.32 small-reg-native small-reg-4 ;
 M: x86.64 small-reg-native small-reg-8 ;
 
 : small-reg-that-isn't ( exclude -- reg' )
-    small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ;
+    small-regs swap [ native-version-of ] map '[ _ memq? not ] find nip ;
 
 : with-save/restore ( reg quot -- )
     [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
@@ -346,7 +285,7 @@ M: x86.64 small-reg-native small-reg-8 ;
     #! 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-native small-regs memq? [ dst quot call ] [
+    dst small-regs memq? [ dst quot call ] [
         exclude small-reg-that-isn't
         [ quot call ] with-save/restore
     ] if ; inline
@@ -362,7 +301,7 @@ M: x86.64 small-reg-native small-reg-8 ;
             src2 CL quot call
             dst src2 XCHG
         ] [
-            ECX small-reg-native [
+            ECX native-version-of [
                 CL src2 MOV
                 drop dst CL quot call
             ] with-save/restore
@@ -380,8 +319,8 @@ M:: x86 %string-nth ( dst src index temp -- )
         ! 8th bit indicates whether we have to load from
         ! the aux vector or not.
         temp src index [+] LEA
-        new-dst 1 small-reg temp string-offset [+] MOV
-        new-dst new-dst 1 small-reg MOVZX
+        new-dst 8-bit-version-of temp string-offset [+] MOV
+        new-dst new-dst 8-bit-version-of MOVZX
         ! Do we have to look at the aux vector?
         new-dst HEX: 80 CMP
         "end" get JL
@@ -392,8 +331,8 @@ M:: x86 %string-nth ( dst src index temp -- )
         new-dst index ADD
         new-dst index ADD
         ! Load high 16 bits
-        new-dst 2 small-reg new-dst byte-array-offset [+] MOV
-        new-dst new-dst 2 small-reg MOVZX
+        new-dst 16-bit-version-of new-dst byte-array-offset [+] MOV
+        new-dst new-dst 16-bit-version-of MOVZX
         new-dst 7 SHL
         ! Compute code point
         new-dst temp XOR
@@ -405,12 +344,12 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
     ch { index str temp } [| new-ch |
         new-ch ch ?MOV
         temp str index [+] LEA
-        temp string-offset [+] new-ch 1 small-reg MOV
+        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 small-reg dup src [] MOV
+        new-dst dup size 8 * n-bit-version-of dup src [] MOV
         quot call
         dst new-dst ?MOV
     ] with-small-register ; inline
@@ -437,7 +376,7 @@ M: x86 %alien-double [] MOVSD ;
 :: %alien-integer-setter ( ptr value size -- )
     value { ptr } [| new-value |
         new-value value ?MOV
-        ptr [] new-value size small-reg MOV
+        ptr [] new-value size 8 * n-bit-version-of MOV
     ] with-small-register ; inline
 
 M: x86 %set-alien-integer-1 1 %alien-integer-setter ;