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

First cut at x86 inline allocators

slava 2006-11-07 05:35:06 +00:00
parent d54e3baac8
commit dae3b2da75
5 changed files with 79 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -8,6 +8,8 @@
- callback scheduling issue
- sometimes fep when closing window
- %allot-bignum-signed-2: handle carry in negation
- x86: load-allot-ptr doesn't have a stack effect? why?
- remove useless-coerce optimization
+ ui:

31
library/compiler/pentium4/intrinsics.factor
View File

@ -9,37 +9,8 @@ M: float-regs (%peek)
fp-scratch swap %move-int>int
fp-scratch %move-int>float ;
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
dup 0 MOV
"generations" f rel-absolute-cell rel-dlsym
dup [] MOV ;
: load-allot-ptr ( vreg -- )
dup load-zone-ptr dup cell [+] MOV ;
: inc-allot-ptr ( vreg n -- )
>r dup load-zone-ptr cell [+] r> ADD ;
: with-inline-alloc ( prequot postquot spec -- )
#! both quotations are called with the vreg
[
alloc-tmp-reg PUSH
alloc-tmp-reg load-allot-ptr
alloc-tmp-reg [] \ tag-header get call tag-header MOV
>r call alloc-tmp-reg \ tag get call OR
r> call alloc-tmp-reg \ size get call inc-allot-ptr
alloc-tmp-reg POP
] bind ; inline
M: float-regs (%replace)
drop
[ alloc-tmp-reg 8 [+] rot v>operand MOVSD ]
[ v>operand alloc-tmp-reg MOV ] H{
{ tag-header [ float-tag ] }
{ tag [ float-tag ] }
{ size [ 16 ] }
} with-inline-alloc ;
drop swap %allot-float ;
! Floats
: define-float-op ( word op -- )

71
library/compiler/x86/allot.factor Normal file
View File

@ -0,0 +1,71 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: kernel assembler kernel-internals namespaces math ;
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
dup 0 MOV
"generations" f rel-absolute-cell rel-dlsym
dup [] MOV ;
: load-allot-ptr ( reg -- )
dup load-zone-ptr dup cell [+] MOV ;
: inc-allot-ptr ( reg n -- )
>r dup load-zone-ptr cell [+] r> ADD ;
: %allot ( header size quot -- )
swap >r >r
alloc-tmp-reg PUSH
alloc-tmp-reg load-allot-ptr
alloc-tmp-reg [] rot tag-header MOV
r> call
alloc-tmp-reg r> 8 align inc-allot-ptr
alloc-tmp-reg POP ; inline
: %allot-float ( loc vreg -- )
#! Only called by pentium4 backend
float-tag 16 [
alloc-tmp-reg 8 [+] rot v>operand MOVSD
alloc-tmp-reg float-tag OR
v>operand alloc-tmp-reg MOV
] %allot ;
M: float-regs (%replace)
drop swap %allot-float ;
: %allot-bignum ( #digits quot -- )
#! 1 cell header, 1 cell length, 1 cell sign, + digits
#! length is the # of digits + sign
bignum-tag pick 3 + cells [
>r alloc-tmp-reg cell [+] swap 1+ tag-bits shift MOV r>
call
] %allot ; inline
: %allot-bignum-signed-1 ( reg -- )
#! on entry, reg is a signed 32-bit quantity
#! exits with tagged ptr to bignum in reg
[
1 [
! todo: neg
alloc-tmp-reg 2 cells [+] 0 MOV ! positive sign
alloc-tmp-reg 3 cells [+] over MOV
alloc-tmp-reg bignum-tag OR
MOV
] %allot-bignum
] with-scope ;
: %allot-bignum-signed-2 ( reg1 reg2 -- )
#! on entry, reg1 and reg2 together form a signed 64-bit
#! quantity.
#! exits with tagged ptr to bignum in reg1
[
2 [
alloc-tmp-reg 2 cells [+] 0 MOV ! positive sign
alloc-tmp-reg 3 cells [+] swap MOV
alloc-tmp-reg 4 cells [+] over MOV
alloc-tmp-reg bignum-tag OR
MOV
] %allot-bignum
] with-scope ;

33
library/compiler/x86/intrinsics.factor
View File

@ -153,10 +153,7 @@ IN: compiler
{ +output+ { "out" } }
} define-intrinsic
: ?MOV ( dst src -- ) 2dup = [ 2drop ] [ MOV ] if ;
: simple-overflow ( word -- )
finalize-contents
"z" operand "x" operand MOV
"z" operand "y" operand pick execute
! If the previous arithmetic operation overflowed, then we
@ -166,10 +163,8 @@ IN: compiler
! There was an overflow. Recompute the original operand.
{ "y" "x" } [ tag-bits SAR ] unique-operands
"x" operand "y" operand rot execute
"s48_long_to_bignum" f "x" operand 1array compile-c-call*
! An untagged pointer to the bignum is now in EAX; tag it
T{ int-regs } return-reg bignum-tag OR
"z" operand T{ int-regs } return-reg ?MOV
"x" operand %allot-bignum-signed-1
"z" operand "x" operand MOV
"end" resolve-label ; inline
: simple-overflow-template ( word insn -- )
@ -184,19 +179,11 @@ IN: compiler
\ fixnum- \ SUB simple-overflow-template
\ fixnum* [
finalize-contents
"y" operand tag-bits SAR
"y" operand IMUL
"end" define-label
"end" get JNO
"s48_fixnum_pair_to_bignum" f
"x" operand remainder-reg 2array compile-c-call*
! now we have to shift it by three bits to remove the second
! tag
"s48_bignum_arithmetic_shift" f
"x" operand tag-bits neg 2array compile-c-call*
! an untagged pointer to the bignum is now in EAX; tag it
T{ int-regs } return-reg bignum-tag OR
"x" operand remainder-reg %allot-bignum-signed-2
"end" resolve-label
] H{
{ +input+ { { 0 "x" } { 1 "y" } } }
@ -217,19 +204,7 @@ IN: compiler
"x" operand 1 tag-bits shift IMUL2
! Did it overflow?
"end" get JNO
! There was an overflow, so make ECX into a bignum. we must
! save EDX since its volatile.
remainder-reg PUSH
! Align the stack -- only needed on Mac OS X
stack-reg 16 cell - SUB
"s48_long_to_bignum" f
"y" operand 1array compile-c-call*
! An untagged pointer to the bignum is now in EAX; tag it
T{ int-regs } return-reg bignum-tag OR
! Align the stack -- only needed on Mac OS X
stack-reg 16 cell - ADD
! the remainder is now in EDX
remainder-reg POP
"y" operand %allot-bignum-signed-1
"end" resolve-label ;
\ fixnum/i [ generate-fixnum/mod ] H{

1
library/compiler/x86/load.factor
View File

@ -2,5 +2,6 @@ PROVIDE: library/compiler/x86
{ +files+ {
"assembler.factor"
"architecture.factor"
"allot.factor"
"intrinsics.factor"
} } ;