From 73862a9a03940999eac37d6374c74011ccc52e3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 21:44:08 -0500 Subject: [PATCH] cpu.x86.assembler: move operands to operands sub-vocabulary, clean up small-reg-* code in compiler backend --- basis/cpu/x86/32/32.factor | 13 +- basis/cpu/x86/64/64.factor | 13 +- basis/cpu/x86/64/unix/unix.factor | 8 +- .../cpu/x86/assembler/assembler-tests.factor | 3 +- basis/cpu/x86/assembler/assembler.factor | 98 +-------------- basis/cpu/x86/assembler/authors.txt | 1 + .../x86/assembler/operands/operands.factor | 118 ++++++++++++++++++ basis/cpu/x86/assembler/syntax/syntax.factor | 27 ++-- basis/cpu/x86/x86.factor | 87 ++----------- 9 files changed, 170 insertions(+), 198 deletions(-) create mode 100644 basis/cpu/x86/assembler/operands/operands.factor diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 727131aa25..76699c1306 100755 --- 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 8eb04eb2b5..f837c7de73 100644 --- 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 eea960d03d..7ab25b6d3f 100644 --- 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 66adee6bf6..962309c67e 100644 --- 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 e91ebdcb1a..f15704a015 100644 --- 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 - ; - -! 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 ; - -: ( 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 ; - -: [+] ( reg displacement -- indirect ) - dup integer? - [ dup zero? [ drop f ] when [ f f ] dip ] - [ f f ] if - ; - ! 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 1901f27a24..580f882c8d 100755 --- 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 index 0000000000..733c57689b --- /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 ; + + ; + +! 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 ; + +: ( 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 ; + +: [+] ( reg displacement -- indirect ) + dup integer? + [ dup zero? [ drop f ] when [ f f ] dip ] + [ f f ] if + ; + +TUPLE: byte value ; + +C: byte + + + +: 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 631dcaa8f7..5b65c19155 100644 --- 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 258f842598..337232c259 100644 --- 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 ;