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 : (max-array-capacity) ( b -- n )
79 : max-array-capacity ( -- n )
80 fixnum-bits (max-array-capacity) ; inline
82 : bootstrap-first-bignum ( -- n )
83 bootstrap-cell-bits (first-bignum) ;
85 : bootstrap-most-positive-fixnum ( -- n )
86 bootstrap-first-bignum 1 - ;
88 : bootstrap-most-negative-fixnum ( -- n )
89 bootstrap-first-bignum neg ;
91 : bootstrap-max-array-capacity ( -- n )
92 bootstrap-fixnum-bits (max-array-capacity) ;
95 dup most-negative-fixnum most-positive-fixnum between?
99 dup most-negative-fixnum most-positive-fixnum between?
100 [ >fixnum ] [ >bignum ] if ; inline
102 UNION: immediate fixnum POSTPONE: f ;