core/layouts/layouts.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs kernel kernel.private math math.order namespaces ;
   4 IN: layouts
   5
   6 SYMBOL: data-alignment
   7
   8 SYMBOL: tag-mask
   9
  10 SYMBOL: tag-bits
  11
  12 SYMBOL: num-types
  13
  14 SYMBOL: type-numbers
  15
  16 SYMBOL: mega-cache-size
  17
  18 SYMBOL: header-bits
  19
  20 : type-number ( class -- n )
  21     type-numbers get at ;
  22
  23 : tag-fixnum ( n -- tagged )
  24     tag-bits get shift ;
  25
  26 : tag-header ( n -- tagged )
  27     header-bits get shift ;
  28
  29 : untag-fixnum ( n -- tagged )
  30     tag-bits get neg shift ;
  31
  32 : hashcode-shift ( -- n )
  33     tag-bits get header-bits get + ;
  34
  35 : leaf-stack-frame-size ( -- n ) 16 ;
  36
  37 ! We do this in its own compilation unit so that they can be
  38 ! folded below
  39 <<
  40 : cell ( -- n ) OBJ-CELL-SIZE special-object ; foldable
  41
  42 : (fixnum-bits) ( m -- n ) tag-bits get - ; foldable
  43
  44 : (first-bignum) ( m -- n ) (fixnum-bits) 1 - 2^ ; foldable
  45 >>
  46
  47 : cells ( m -- n ) cell * ; inline
  48
  49 : cell-bits ( -- n ) 8 cells ; inline
  50
  51 : 32-bit? ( -- ? ) cell-bits 32 = ; inline
  52
  53 : 64-bit? ( -- ? ) cell-bits 64 = ; inline
  54
  55 : bootstrap-cell ( -- n ) \ cell get cell or ; inline
  56
  57 : bootstrap-cells ( m -- n ) bootstrap-cell * ; inline
  58
  59 : bootstrap-cell-bits ( -- n ) 8 bootstrap-cells ; inline
  60
  61 : first-bignum ( -- n )
  62     cell-bits (first-bignum) ; inline
  63
  64 : fixnum-bits ( -- n )
  65     cell-bits (fixnum-bits) ; inline
  66
  67 : bootstrap-fixnum-bits ( -- n )
  68     bootstrap-cell-bits (fixnum-bits) ; inline
  69
  70 : most-positive-fixnum ( -- n )
  71     first-bignum 1 - >fixnum ; inline
  72
  73 : most-negative-fixnum ( -- n )
  74     first-bignum neg >fixnum ; inline
  75
  76 : (max-array-capacity) ( b -- n )
  77     2 - 2^ 1 - ; inline
  78
  79 : max-array-capacity ( -- n )
  80     fixnum-bits (max-array-capacity) ; inline
  81
  82 : bootstrap-first-bignum ( -- n )
  83     bootstrap-cell-bits (first-bignum) ;
  84
  85 : bootstrap-most-positive-fixnum ( -- n )
  86     bootstrap-first-bignum 1 - ;
  87
  88 : bootstrap-most-negative-fixnum ( -- n )
  89     bootstrap-first-bignum neg ;
  90
  91 : bootstrap-max-array-capacity ( -- n )
  92     bootstrap-fixnum-bits (max-array-capacity) ;
  93
  94 M: bignum >integer
  95     dup most-negative-fixnum most-positive-fixnum between?
  96     [ >fixnum ] when ;
  97
  98 M: real >integer
  99     dup most-negative-fixnum most-positive-fixnum between?
 100     [ >fixnum ] [ >bignum ] if ; inline
 101
 102 UNION: immediate fixnum POSTPONE: f ;