steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cpu.x86: fix small register intrinsics on x86-64

db4
Slava Pestov 2009-06-03 03:22:46 -05:00
parent 6d04bf9c4a
commit ade5db2405
2 changed files with 41 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/compiler/tests/codegen.factor
View File

@ -2,7 +2,7 @@ USING: generalizations accessors arrays compiler kernel kernel.private
math hashtables.private math.private namespaces sequences tools.test math hashtables.private math.private namespaces sequences tools.test
namespaces.private slots.private sequences.private byte-arrays alien namespaces.private slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make ; combinators vectors grouping make alien.c-types ;
QUALIFIED: namespaces.private QUALIFIED: namespaces.private
IN: compiler.tests.codegen IN: compiler.tests.codegen
@ -282,3 +282,10 @@ TUPLE: cucumber ;
M: cucumber equal? "The cucumber has no equal" throw ; M: cucumber equal? "The cucumber has no equal" throw ;
[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test [ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
[ 4294967295 B{ 255 255 255 255 } -1 ]
[
-1 <int> -1 <int>
[ [ 0 alien-unsigned-cell swap ] [ 0 alien-signed-2 ] bi ]
compile-call
] unit-test

45
basis/cpu/x86/x86.factor
View File

@ -327,17 +327,29 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label "end" resolve-label
] with-scope ; ] with-scope ;
: small-reg-4 ( reg -- reg' ) : small-reg-8 ( reg -- reg' )
H{ H{
{ EAX EAX } { EAX RAX }
{ ECX ECX } { ECX RCX }
{ EDX EDX } { EDX RDX }
{ EBX EBX } { EBX RBX }
{ ESP ESP } { ESP RSP }
{ EBP EBP } { EBP RBP }
{ ESI ESP } { ESI RSP }
{ EDI EDI } { 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 } { RAX EAX }
{ RCX ECX } { RCX ECX }
{ RDX EDX } { RDX EDX }
@ -373,12 +385,21 @@ M:: x86 %box-alien ( dst src temp -- )
{ 1 [ small-reg-1 ] } { 1 [ small-reg-1 ] }
{ 2 [ small-reg-2 ] } { 2 [ small-reg-2 ] }
{ 4 [ small-reg-4 ] } { 4 [ small-reg-4 ] }
{ 8 [ small-reg-8 ] }
} case ; } case ;
: small-regs ( -- regs ) { EAX ECX EDX EBX } ; inline HOOK: small-regs cpu ( -- regs )
M: x86.32 small-regs { EAX ECX EDX EBX } ;
M: x86.64 small-regs { RAX RCX RDX RBX } ;
HOOK: small-reg-native cpu ( reg -- reg' )
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-reg-that-isn't ( exclude -- reg' )
small-regs swap [ small-reg-4 ] map '[ _ memq? not ] find nip ; small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ;
: with-save/restore ( reg quot -- ) : with-save/restore ( reg quot -- )
[ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
@ -388,7 +409,7 @@ M:: x86 %box-alien ( dst src temp -- )
#! call the quot with that. Otherwise, we find a small #! call the quot with that. Otherwise, we find a small
#! register that is not in exclude, and call quot, saving #! register that is not in exclude, and call quot, saving
#! and restoring the small register. #! and restoring the small register.
dst small-reg-4 small-regs memq? [ dst quot call ] [ dst small-reg-native small-regs memq? [ dst quot call ] [
exclude small-reg-that-isn't exclude small-reg-that-isn't
[ quot call ] with-save/restore [ quot call ] with-save/restore
] if ; inline ] if ; inline