Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-10-21 23:44:02 -05:00
commit 1d750b26d2
3 changed files with 38 additions and 12 deletions

View File

@ -4,9 +4,9 @@ IN: cpu.x86.assembler.tests
[ { 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
! [ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
! [ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
! [ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
[ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
[ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
[ { HEX: f2 HEX: 0f HEX: 2c HEX: c0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
[ { HEX: f2 HEX: 48 HEX: 0f HEX: 2c HEX: c0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
@ -39,3 +39,21 @@ IN: cpu.x86.assembler.tests
[ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
[ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1a } ] [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1b } ] [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1c } ] [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 48 HEX: 89 HEX: 04 HEX: 1c } ] [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 48 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test
[ { HEX: 4a HEX: 89 HEX: 04 HEX: 23 } ] [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test
[ { HEX: 4a HEX: 89 HEX: 04 HEX: 2b } ] [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test
[ { HEX: 4b HEX: 89 HEX: 44 HEX: 25 HEX: 00 } ] [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test
[ { HEX: 4b HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test
[ [ R12 RSP [+] RAX MOV ] { } make ] must-fail

View File

@ -64,18 +64,18 @@ M: indirect extended? base>> extended? ;
: canonicalize-EBP ( indirect -- indirect )
#! { EBP } ==> { EBP 0 }
dup base>> { EBP RBP R13 } member? [
dup displacement>> [ 0 >>displacement ] unless
] when ;
dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
[ 0 >>displacement ] when ;
: canonicalize-ESP ( indirect -- indirect )
#! { ESP } ==> { ESP ESP }
dup base>> { ESP RSP R12 } member? [ ESP >>index ] 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 canonicalize-ESP ;
canonicalize-EBP check-ESP ;
: <indirect> ( base index scale displacement -- indirect )
indirect boa canonicalize ;
@ -91,7 +91,7 @@ M: indirect extended? base>> extended? ;
GENERIC: sib-present? ( op -- ? )
M: indirect sib-present?
[ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
[ base>> { ESP RSP R12 } member? ] [ index>> ] [ scale>> ] tri or or ;
M: register sib-present? drop f ;
@ -254,7 +254,8 @@ M: object operand-64? drop f ;
reg-code swap addressing ;
: direction-bit ( dst src op -- dst' src' op' )
pick register? [ BIN: 10 opcode-or swapd ] when ;
pick register? pick register? not and
[ BIN: 10 opcode-or swapd ] when ;
: operand-size-bit ( dst src op -- dst' src' op' )
over register-8? [ BIN: 1 opcode-or ] unless ;

View File

@ -81,6 +81,7 @@ ARTICLE: "fs-meta" "File metadata"
{ $subsection link-info }
{ $subsection exists? }
{ $subsection directory? }
"File types:"
{ $subsection "file-types" } ;
@ -322,6 +323,12 @@ HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: file-system-info
{ $values
{ "path" "a pathname string" }
{ "file-system-info" file-system-info } }
{ $description "Returns a platform-specific object describing the file-system that contains the path. The cross-platform slot is " { $slot "free-space" } "." } ;
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
{ $description "Resolve a path relative to the Factor source code location." } ;