2007-09-20 18:09:08 -04:00
|
|
|
! Copyright (C) 2007 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: namespaces math words kernel assocs system classes ;
|
|
|
|
IN: layouts
|
|
|
|
|
|
|
|
SYMBOL: tag-mask
|
|
|
|
|
|
|
|
SYMBOL: num-tags
|
|
|
|
|
|
|
|
SYMBOL: tag-bits
|
|
|
|
|
|
|
|
SYMBOL: num-types
|
|
|
|
|
|
|
|
SYMBOL: tag-numbers
|
|
|
|
|
|
|
|
SYMBOL: type-numbers
|
|
|
|
|
|
|
|
: tag-number ( class -- n )
|
|
|
|
tag-numbers get at [ object tag-number ] unless* ;
|
|
|
|
|
|
|
|
: type-number ( class -- n )
|
|
|
|
type-numbers get at ;
|
|
|
|
|
2008-01-02 19:36:36 -05:00
|
|
|
: tag-fixnum ( n -- tagged )
|
2007-09-20 18:09:08 -04:00
|
|
|
tag-bits get shift ;
|
|
|
|
|
|
|
|
: first-bignum ( -- n )
|
|
|
|
bootstrap-cell-bits tag-bits get - 1 - 2^ ;
|
|
|
|
|
|
|
|
: most-positive-fixnum ( -- n )
|
|
|
|
first-bignum 1- ;
|
|
|
|
|
|
|
|
: most-negative-fixnum ( -- n )
|
|
|
|
first-bignum neg ;
|
2008-02-22 00:47:06 -05:00
|
|
|
|
|
|
|
M: real >integer
|
|
|
|
dup most-negative-fixnum most-positive-fixnum between?
|
|
|
|
[ >fixnum ] [ >bignum ] if ;
|