1 ! Copyright (C) 2007, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces math words kernel assocs classes
4 math.order kernel.private ;
19 SYMBOL: mega-cache-size
21 : type-number ( class -- n )
24 : tag-number ( class -- n )
25 type-number dup num-tags get >= [ drop object tag-number ] when ;
27 : tag-fixnum ( n -- tagged )
30 : untag-fixnum ( n -- tagged )
31 tag-bits get neg shift ;
33 ! We do this in its own compilation unit so that they can be
36 : cell ( -- n ) 7 getenv ; foldable
38 : (first-bignum) ( m -- n ) tag-bits get - 1 - 2^ ; foldable
41 : cells ( m -- n ) cell * ; inline
43 : cell-bits ( -- n ) 8 cells ; inline
45 : bootstrap-cell ( -- n ) \ cell get cell or ; inline
47 : bootstrap-cells ( m -- n ) bootstrap-cell * ; inline
49 : bootstrap-cell-bits ( -- n ) 8 bootstrap-cells ; inline
51 : first-bignum ( -- n )
52 cell-bits (first-bignum) ; inline
54 : most-positive-fixnum ( -- n )
55 first-bignum 1 - >fixnum ; inline
57 : most-negative-fixnum ( -- n )
58 first-bignum neg >fixnum ; inline
60 : (max-array-capacity) ( b -- n )
63 : max-array-capacity ( -- n )
64 cell-bits (max-array-capacity) ; inline
66 : bootstrap-first-bignum ( -- n )
67 bootstrap-cell-bits (first-bignum) ;
69 : bootstrap-most-positive-fixnum ( -- n )
70 bootstrap-first-bignum 1 - ;
72 : bootstrap-most-negative-fixnum ( -- n )
73 bootstrap-first-bignum neg ;
75 : bootstrap-max-array-capacity ( -- n )
76 bootstrap-cell-bits (max-array-capacity) ;
79 dup most-negative-fixnum most-positive-fixnum between?
83 dup most-negative-fixnum most-positive-fixnum between?
84 [ >fixnum ] [ >bignum ] if ; inline
86 UNION: immediate fixnum POSTPONE: f ;