unmaintained/arm/allot/allot.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel cpu.architecture cpu.arm.assembler
   4 cpu.arm.architecture namespaces math sequences
   5 generator generator.registers generator.fixup system layouts
   6 alien ;
   7 IN: cpu.arm.allot
   8
   9 : load-zone-ptr ( reg -- ) "nursery" f rot %alien-global ;
  10
  11 : %allot ( header size -- )
  12     #! Store a pointer to 'size' bytes allocated from the
  13     #! nursery in R11
  14     8 align ! align the size
  15     R12 load-zone-ptr ! nusery -> r12
  16     R11 R12 cell <+> LDR ! nursery.here -> r11
  17     R11 R11 pick ADD ! increment r11
  18     R11 R12 cell <+> STR ! r11 -> nursery.here
  19     R11 R11 rot SUB ! old value
  20     R12 swap type-number tag-fixnum MOV ! compute header
  21     R12 R11 0 <+> STR ! store header
  22     ;
  23
  24 : %store-tagged ( reg tag -- )
  25     >r dup fresh-object v>operand R11 r> tag-number ORR ;
  26
  27 : %allot-bignum ( #digits -- )
  28     #! 1 cell header, 1 cell length, 1 cell sign, + digits
  29     #! length is the # of digits + sign
  30     bignum over 3 + cells %allot
  31     R12 swap 1+ v>operand MOV ! compute the length
  32     R12 R11 cell <+> STR ! store the length
  33     ;
  34
  35 : %allot-bignum-signed-1 ( dst src -- )
  36     #! on entry, reg is a 30-bit quantity sign-extended to
  37     #! 32-bits.
  38     #! exits with tagged ptr to bignum in reg.
  39     [
  40         "end" define-label
  41         ! is it zero?
  42         dup v>operand 0 CMP
  43         0 >bignum pick EQ load-literal
  44         "end" get EQ B
  45         ! ! it is non-zero
  46         1 %allot-bignum
  47         ! is the fixnum negative?
  48         dup v>operand 0 CMP
  49         ! negative sign
  50         R12 1 LT MOV
  51         ! negate fixnum
  52         dup v>operand dup 0 LT RSB
  53         ! positive sign
  54         R12 0 GE MOV
  55         ! store sign
  56         R12 R11 2 cells <+> STR
  57         ! store the number
  58         v>operand R11 3 cells <+> STR
  59         ! tag the bignum, store it in reg
  60         bignum %store-tagged
  61         "end" resolve-label
  62     ] with-scope ;
  63
  64 M: arm-backend %box-alien ( dst src -- )
  65     "end" define-label
  66     dup v>operand 0 CMP
  67     over v>operand f v>operand EQ MOV
  68     "end" get EQ B
  69     alien 4 cells %allot
  70     ! Store offset
  71     v>operand R11 3 cells <+> STR
  72     R12 f v>operand MOV
  73     ! Store expired slot
  74     R12 R11 1 cells <+> STR
  75     ! Store underlying-alien slot
  76     R12 R11 2 cells <+> STR
  77     ! Store tagged ptr in reg
  78     object %store-tagged
  79     "end" resolve-label ;