120 lines
3.4 KiB
Factor
120 lines
3.4 KiB
Factor
! Copyright (C) 2006, 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel cpu.architecture cpu.x86.assembler
|
|
cpu.x86.architecture kernel.private namespaces math sequences
|
|
generic arrays compiler.generator compiler.generator.fixup
|
|
compiler.generator.registers system layouts alien ;
|
|
IN: cpu.x86.allot
|
|
|
|
: allot-reg ( -- reg )
|
|
#! We temporarily use the datastack register, since it won't
|
|
#! be accessed inside the quotation given to %allot in any
|
|
#! case.
|
|
ds-reg ;
|
|
|
|
: (object@) ( n -- operand ) allot-reg swap [+] ;
|
|
|
|
: object@ ( n -- operand ) cells (object@) ;
|
|
|
|
: load-zone-ptr ( reg -- )
|
|
#! Load pointer to start of zone array
|
|
0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
|
|
|
|
: load-allot-ptr ( -- )
|
|
allot-reg load-zone-ptr
|
|
allot-reg PUSH
|
|
allot-reg dup cell [+] MOV ;
|
|
|
|
: inc-allot-ptr ( n -- )
|
|
allot-reg POP
|
|
allot-reg cell [+] swap 8 align ADD ;
|
|
|
|
M: x86 %gc ( -- )
|
|
"end" define-label
|
|
temp-reg-1 load-zone-ptr
|
|
temp-reg-2 temp-reg-1 cell [+] MOV
|
|
temp-reg-2 1024 ADD
|
|
temp-reg-1 temp-reg-1 3 cells [+] MOV
|
|
temp-reg-2 temp-reg-1 CMP
|
|
"end" get JLE
|
|
0 frame-required
|
|
%prepare-alien-invoke
|
|
"minor_gc" f %alien-invoke
|
|
"end" resolve-label ;
|
|
|
|
: store-header ( header -- )
|
|
0 object@ swap type-number tag-fixnum MOV ;
|
|
|
|
: %allot ( header size quot -- )
|
|
allot-reg PUSH
|
|
swap >r >r
|
|
load-allot-ptr
|
|
store-header
|
|
r> call
|
|
r> inc-allot-ptr
|
|
allot-reg POP ; inline
|
|
|
|
: %store-tagged ( reg tag -- )
|
|
>r dup fresh-object v>operand r>
|
|
allot-reg swap tag-number OR
|
|
allot-reg MOV ;
|
|
|
|
M: x86 %box-float ( dst src -- )
|
|
#! Only called by pentium4 backend, uses SSE2 instruction
|
|
#! dest is a loc or a vreg
|
|
float 16 [
|
|
8 (object@) swap v>operand MOVSD
|
|
float %store-tagged
|
|
] %allot ;
|
|
|
|
: %allot-bignum-signed-1 ( outreg inreg -- )
|
|
#! on entry, inreg is a signed 32-bit quantity
|
|
#! exits with tagged ptr to bignum in outreg
|
|
#! 1 cell header, 1 cell length, 1 cell sign, + digits
|
|
#! length is the # of digits + sign
|
|
[
|
|
{ "end" "nonzero" "positive" "store" }
|
|
[ define-label ] each
|
|
dup v>operand 0 CMP ! is it zero?
|
|
"nonzero" get JNE
|
|
0 >bignum pick load-literal ! this is our result
|
|
"end" get JMP
|
|
"nonzero" resolve-label
|
|
bignum 4 cells [
|
|
! Write length
|
|
1 object@ 2 v>operand MOV
|
|
! Test sign
|
|
dup v>operand 0 CMP
|
|
"positive" get JGE
|
|
2 object@ 1 MOV ! negative sign
|
|
dup v>operand NEG
|
|
"store" get JMP
|
|
"positive" resolve-label
|
|
2 object@ 0 MOV ! positive sign
|
|
"store" resolve-label
|
|
3 object@ swap v>operand MOV
|
|
! Store tagged ptr in reg
|
|
bignum %store-tagged
|
|
] %allot
|
|
"end" resolve-label
|
|
] with-scope ;
|
|
|
|
M: x86 %box-alien ( dst src -- )
|
|
[
|
|
{ "end" "f" } [ define-label ] each
|
|
dup v>operand 0 CMP
|
|
"f" get JE
|
|
alien 4 cells [
|
|
1 object@ f v>operand MOV
|
|
2 object@ f v>operand MOV
|
|
! Store src in alien-offset slot
|
|
3 object@ swap v>operand MOV
|
|
! Store tagged ptr in dst
|
|
dup object %store-tagged
|
|
] %allot
|
|
"end" get JMP
|
|
"f" resolve-label
|
|
f [ v>operand ] bi@ MOV
|
|
"end" resolve-label
|
|
] with-scope ;
|