72 lines
2.0 KiB
Factor
72 lines
2.0 KiB
Factor
|
! 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 ;
|