80 lines
2.3 KiB
Factor
80 lines
2.3 KiB
Factor
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: kernel cpu.architecture cpu.arm.assembler
|
||
|
cpu.arm.architecture namespaces math sequences
|
||
|
|
generator generator.registers generator.fixup system layouts
|
||
|
|
alien ;
|
||
|
|
IN: cpu.arm.allot
|
||
|
|
|
||
|
|
: load-zone-ptr ( reg -- ) "nursery" f rot %alien-global ;
|
||
|
|
|
||
|
|
: %allot ( header size -- )
|
||
|
|
#! Store a pointer to 'size' bytes allocated from the
|
||
|
|
#! nursery in R11
|
||
|
|
8 align ! align the size
|
||
|
|
R12 load-zone-ptr ! nusery -> r12
|
||
|
|
R11 R12 cell <+> LDR ! nursery.here -> r11
|
||
|
|
R11 R11 pick ADD ! increment r11
|
||
|
|
R11 R12 cell <+> STR ! r11 -> nursery.here
|
||
|
|
R11 R11 rot SUB ! old value
|
||
|
|
R12 swap type-number tag-fixnum MOV ! compute header
|
||
|
|
R12 R11 0 <+> STR ! store header
|
||
|
|
;
|
||
|
|
|
||
|
|
: %store-tagged ( reg tag -- )
|
||
|
|
>r dup fresh-object v>operand R11 r> tag-number ORR ;
|
||
|
|
|
||
|
|
: %allot-bignum ( #digits -- )
|
||
|
|
#! 1 cell header, 1 cell length, 1 cell sign, + digits
|
||
|
|
#! length is the # of digits + sign
|
||
|
|
bignum over 3 + cells %allot
|
||
|
|
R12 swap 1+ v>operand MOV ! compute the length
|
||
|
|
R12 R11 cell <+> STR ! store the length
|
||
|
|
;
|
||
|
|
|
||
|
|
: %allot-bignum-signed-1 ( dst src -- )
|
||
|
|
#! on entry, reg is a 30-bit quantity sign-extended to
|
||
|
|
#! 32-bits.
|
||
|
|
#! exits with tagged ptr to bignum in reg.
|
||
|
|
[
|
||
|
|
"end" define-label
|
||
|
|
! is it zero?
|
||
|
|
dup v>operand 0 CMP
|
||
|
|
0 >bignum pick EQ load-literal
|
||
|
|
"end" get EQ B
|
||
|
|
! ! it is non-zero
|
||
|
|
1 %allot-bignum
|
||
|
|
! is the fixnum negative?
|
||
|
|
dup v>operand 0 CMP
|
||
|
|
! negative sign
|
||
|
|
R12 1 LT MOV
|
||
|
|
! negate fixnum
|
||
|
|
dup v>operand dup 0 LT RSB
|
||
|
|
! positive sign
|
||
|
|
R12 0 GE MOV
|
||
|
|
! store sign
|
||
|
|
R12 R11 2 cells <+> STR
|
||
|
|
! store the number
|
||
|
|
v>operand R11 3 cells <+> STR
|
||
|
|
! tag the bignum, store it in reg
|
||
|
|
bignum %store-tagged
|
||
|
|
"end" resolve-label
|
||
|
|
] with-scope ;
|
||
|
|
|
||
|
|
M: arm-backend %box-alien ( dst src -- )
|
||
|
|
"end" define-label
|
||
|
|
dup v>operand 0 CMP
|
||
|
|
over v>operand f v>operand EQ MOV
|
||
|
|
"end" get EQ B
|
||
|
|
alien 4 cells %allot
|
||
|
|
! Store offset
|
||
|
|
v>operand R11 3 cells <+> STR
|
||
|
|
R12 f v>operand MOV
|
||
|
|
! Store expired slot
|
||
|
|
R12 R11 1 cells <+> STR
|
||
|
|
! Store underlying-alien slot
|
||
|
|
R12 R11 2 cells <+> STR
|
||
|
|
! Store tagged ptr in reg
|
||
|
|
object %store-tagged
|
||
|
|
"end" resolve-label ;
|