1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel cpu.architecture cpu.x86.assembler
4 cpu.x86.architecture kernel.private namespaces math sequences
5 generic arrays compiler.generator compiler.generator.fixup
6 compiler.generator.registers system layouts alien ;
10 #! We temporarily use the datastack register, since it won't
11 #! be accessed inside the quotation given to %allot in any
15 : (object@) ( n -- operand ) allot-reg swap [+] ;
17 : object@ ( n -- operand ) cells (object@) ;
19 : load-zone-ptr ( reg -- )
20 #! Load pointer to start of zone array
21 0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
23 : load-allot-ptr ( -- )
24 allot-reg load-zone-ptr
26 allot-reg dup cell [+] MOV ;
28 : inc-allot-ptr ( n -- )
30 allot-reg cell [+] swap 8 align ADD ;
34 temp-reg-1 load-zone-ptr
35 temp-reg-2 temp-reg-1 cell [+] MOV
37 temp-reg-1 temp-reg-1 3 cells [+] MOV
38 temp-reg-2 temp-reg-1 CMP
42 "minor_gc" f %alien-invoke
45 : store-header ( header -- )
46 0 object@ swap type-number tag-fixnum MOV ;
48 : %allot ( header size quot -- )
55 allot-reg POP ; inline
57 : %store-tagged ( reg tag -- )
58 >r dup fresh-object v>operand r>
59 allot-reg swap tag-number OR
62 M: x86 %box-float ( dst src -- )
63 #! Only called by pentium4 backend, uses SSE2 instruction
64 #! dest is a loc or a vreg
66 8 (object@) swap v>operand MOVSD
70 : %allot-bignum-signed-1 ( outreg inreg -- )
71 #! on entry, inreg is a signed 32-bit quantity
72 #! exits with tagged ptr to bignum in outreg
73 #! 1 cell header, 1 cell length, 1 cell sign, + digits
74 #! length is the # of digits + sign
76 { "end" "nonzero" "positive" "store" }
78 dup v>operand 0 CMP ! is it zero?
80 0 >bignum pick load-literal ! this is our result
82 "nonzero" resolve-label
85 1 object@ 2 v>operand MOV
89 2 object@ 1 MOV ! negative sign
92 "positive" resolve-label
93 2 object@ 0 MOV ! positive sign
95 3 object@ swap v>operand MOV
96 ! Store tagged ptr in reg
102 M: x86 %box-alien ( dst src -- )
104 { "end" "f" } [ define-label ] each
108 1 object@ f v>operand MOV
109 2 object@ f v>operand MOV
110 ! Store src in alien-offset slot
111 3 object@ swap v>operand MOV
112 ! Store tagged ptr in dst
113 dup object %store-tagged
117 f [ v>operand ] bi@ MOV