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 ;
16 SYMBOL: mega-cache-size
20 : type-number ( class -- n )
23 : tag-fixnum ( n -- tagged )
26 : tag-header ( n -- tagged )
27 header-bits get shift ;
29 : untag-fixnum ( n -- tagged )
30 tag-bits get neg shift ;
32 : hashcode-shift ( -- n )
33 tag-bits get header-bits get + ;
35 : leaf-stack-frame-size ( -- n ) 16 ;
37 ! We do this in its own compilation unit so that they can be
40 : cell ( -- n ) OBJ-CELL-SIZE special-object ; foldable
42 : (fixnum-bits) ( m -- n ) tag-bits get - ; foldable
44 : (first-bignum) ( m -- n ) (fixnum-bits) 1 - 2^ ; foldable
47 : cells ( m -- n ) cell * ; inline
49 : cell-bits ( -- n ) 8 cells ; inline
51 : 32-bit? ( -- ? ) cell-bits 32 = ; inline
53 : 64-bit? ( -- ? ) cell-bits 64 = ; inline
55 : bootstrap-cell ( -- n ) \ cell get cell or ; inline
57 : bootstrap-cells ( m -- n ) bootstrap-cell * ; inline
59 : bootstrap-cell-bits ( -- n ) 8 bootstrap-cells ; inline
61 : first-bignum ( -- n )
62 cell-bits (first-bignum) ; inline
64 : fixnum-bits ( -- n )
65 cell-bits (fixnum-bits) ; inline
67 : bootstrap-fixnum-bits ( -- n )
68 bootstrap-cell-bits (fixnum-bits) ; inline
70 : most-positive-fixnum ( -- n )
71 first-bignum 1 - >fixnum ; inline
73 : most-negative-fixnum ( -- n )
74 first-bignum neg >fixnum ; inline
76 ALIAS: max-array-capacity most-positive-fixnum
78 : bootstrap-first-bignum ( -- n )
79 bootstrap-cell-bits (first-bignum) ;
81 : bootstrap-most-positive-fixnum ( -- n )
82 bootstrap-first-bignum 1 - ;
84 : bootstrap-most-negative-fixnum ( -- n )
85 bootstrap-first-bignum neg ;
87 ALIAS: bootstrap-max-array-capacity bootstrap-most-positive-fixnum
90 dup most-negative-fixnum most-positive-fixnum between?
94 dup most-negative-fixnum most-positive-fixnum between?
95 [ >fixnum ] [ >bignum ] if ; inline
97 UNION: immediate fixnum POSTPONE: f ;