! 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 ;