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

cpu.x86: update %box-displaced-alien for introduction of address field

db4
Slava Pestov 2009-11-03 02:42:27 -06:00
parent 91ccc30a54
commit 51e9a891a8
5 changed files with 80 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/compiler/cfg/instructions/instructions.factor
View File

@ -512,13 +512,12 @@ temp: temp/int-rep ;
PURE-INSN: ##box-displaced-alien
def: dst/int-rep
use: displacement/int-rep base/int-rep
temp: temp1/int-rep temp2/int-rep
temp: temp/int-rep
literal: base-class ;
PURE-INSN: ##unbox-any-c-ptr
def: dst/int-rep
use: src/int-rep
temp: temp/int-rep ;
use: src/int-rep ;
: ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
@ -527,12 +526,12 @@ PURE-INSN: ##unbox-alien
def: dst/int-rep
use: src/int-rep ;
: ##unbox-c-ptr ( dst src class temp -- )
: ##unbox-c-ptr ( dst src class -- )
{
{ [ over \ f class<= ] [ 2drop ##unbox-f ] }
{ [ over alien class<= ] [ 2drop ##unbox-alien ] }
{ [ over byte-array class<= ] [ 2drop ##unbox-byte-array ] }
[ nip ##unbox-any-c-ptr ]
{ [ dup \ f class<= ] [ drop ##unbox-f ] }
{ [ dup alien class<= ] [ drop ##unbox-alien ] }
{ [ dup byte-array class<= ] [ drop ##unbox-byte-array ] }
[ drop ##unbox-any-c-ptr ]
} cond ;
! Alien accessors

2
basis/compiler/cfg/intrinsics/alien/alien.factor
View File

@ -33,7 +33,7 @@ IN: compiler.cfg.intrinsics.alien
bi and ;
: ^^unbox-c-ptr ( src class -- dst )
[ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
[ next-vreg dup ] 2dip ##unbox-c-ptr ;
: prepare-alien-accessor ( info -- ptr-vreg offset )
class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add 0 ;

2
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -440,7 +440,7 @@ M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ;
:: rewrite-unbox-displaced-alien ( insn expr -- insns )
[
next-vreg :> temp
temp expr base>> vn>vreg expr base-class>> insn temp>> ##unbox-c-ptr
temp expr base>> vn>vreg expr base-class>> ##unbox-c-ptr
insn dst>> temp expr displacement>> vn>vreg ##add
] { } make ;

4
basis/cpu/architecture/architecture.factor
View File

@ -386,9 +386,9 @@ M: object %horizontal-shl-vector-imm-reps { } ;
M: object %horizontal-shr-vector-imm-reps { } ;
HOOK: %unbox-alien cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
HOOK: %unbox-any-c-ptr cpu ( dst src -- )
HOOK: %box-alien cpu ( dst src temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 base-class -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- )
HOOK: %alien-unsigned-1 cpu ( dst src offset -- )
HOOK: %alien-unsigned-2 cpu ( dst src offset -- )

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

@ -177,20 +177,20 @@ M: x86 %fixnum-mul ( label dst src1 src2 -- )
M: x86 %unbox-alien ( dst src -- )
alien-offset [+] MOV ;
M:: x86 %unbox-any-c-ptr ( dst src temp -- )
M:: x86 %unbox-any-c-ptr ( dst src -- )
[
"end" define-label
! Compute tag in temp register
temp src MOV
temp tag-mask get AND
dst 0 MOV
dst dst XOR
! Is the object f?
src \ f type-number CMP
"end" get JE
! Compute tag in dst register
dst src MOV
dst tag-mask get AND
! Is the object an alien?
dst alien type-number CMP
! Add an offset to start of byte array's data
dst src byte-array-offset [+] LEA
! Is the object an alien?
temp alien type-number CMP
"end" get JNE
! If so, load the offset and add it to the address
dst src alien-offset [+] MOV
@ -203,7 +203,7 @@ M:: x86 %box-alien ( dst src temp -- )
[
"end" define-label
dst \ f type-number MOV
src 0 CMP
src src TEST
"end" get JE
dst 5 cells alien temp %allot
dst 1 alien@ \ f type-number MOV ! base
@ -213,32 +213,73 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label
] with-scope ;
M:: x86 %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
M:: x86 %box-displaced-alien ( dst displacement base temp base-class -- )
! This is ridiculous
[
"end" define-label
"ok" define-label
"not-f" define-label
"not-alien" define-label
! If displacement is zero, return the base
dst base MOV
displacement 0 CMP
displacement displacement TEST
"end" get JE
! Quickly use displacement' before its needed for real, as allot temporary
dst 4 cells alien displacement' %allot
! If base is already a displaced alien, unpack it
base' base MOV
displacement' displacement MOV
! Displacement is non-zero, we're going to be allocating a new
! object
dst 5 cells alien temp %allot
! Set expired to f
dst 2 alien@ \ f type-number MOV
! Is base f?
base \ f type-number CMP
"ok" get JE
! XXX
base 0 [+] alien type-number tag-fixnum CMP
"ok" get JNE
! displacement += base.displacement
displacement' base 3 alien@ ADD
! base = base.base
base' base 1 alien@ MOV
"ok" resolve-label
dst 1 alien@ base' MOV ! alien
dst 2 alien@ \ f type-number MOV ! expired
dst 3 alien@ displacement' MOV ! displacement
"not-f" get JNE
! Yes, it is f. Fill in new object
dst 1 alien@ base MOV
dst 3 alien@ displacement MOV
dst 4 alien@ displacement MOV
"end" get JMP
"not-f" resolve-label
! Check base type
temp base MOV
temp tag-mask get AND
! Is base an alien?
temp alien type-number CMP
"not-alien" get JNE
! Yes, it is an alien. Set new alien's base to base.base
temp base 1 alien@ MOV
dst 1 alien@ temp MOV
! Compute displacement
temp base 3 alien@ MOV
temp displacement ADD
dst 3 alien@ temp MOV
! Compute address
temp base 4 alien@ MOV
temp displacement ADD
dst 4 alien@ temp MOV
! We are done
"end" get JMP
! Is base a byte array? It has to be, by now...
"not-alien" resolve-label
dst 1 alien@ base MOV
dst 3 alien@ displacement MOV
temp base MOV
temp byte-array-offset ADD
temp displacement ADD
dst 4 alien@ temp MOV
"end" resolve-label
] with-scope ;