/core/layouts/layouts.factor

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