factor/core/layouts/layouts.factor

90 lines
1.9 KiB
Factor
Raw Normal View History

! Copyright (C) 2007, 2009 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
2008-03-12 02:54:29 -04:00
USING: namespaces math words kernel assocs classes
math.order kernel.private ;
2007-09-20 18:09:08 -04:00
IN: layouts
2009-10-20 13:45:00 -04:00
SYMBOL: data-alignment
2007-09-20 18:09:08 -04:00
SYMBOL: tag-mask
SYMBOL: tag-bits
SYMBOL: num-types
SYMBOL: type-numbers
SYMBOL: mega-cache-size
SYMBOL: header-bits
2007-09-20 18:09:08 -04:00
: 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 ;
2009-11-10 22:06:36 -05:00
: tag-header ( n -- tagged )
header-bits get shift ;
2009-11-10 22:06:36 -05:00
: untag-fixnum ( n -- tagged )
tag-bits get neg shift ;
: hashcode-shift ( -- n )
tag-bits get header-bits get + ;
2008-09-27 12:39:14 -04:00
! We do this in its own compilation unit so that they can be
! folded below
<<
: cell ( -- n ) OBJ-CELL-SIZE special-object ; foldable
2008-03-12 02:54:29 -04:00
2008-09-27 12:39:14 -04:00
: (first-bignum) ( m -- n ) tag-bits get - 1 - 2^ ; foldable
>>
2008-03-12 02:54:29 -04:00
: cells ( m -- n ) cell * ; inline
: cell-bits ( -- n ) 8 cells ; inline
: bootstrap-cell ( -- n ) \ cell get cell or ; inline
2008-03-12 02:54:29 -04:00
: bootstrap-cells ( m -- n ) bootstrap-cell * ; inline
2008-03-12 02:54:29 -04:00
: bootstrap-cell-bits ( -- n ) 8 bootstrap-cells ; inline
2008-03-12 02:54:29 -04:00
2007-09-20 18:09:08 -04:00
: first-bignum ( -- n )
2008-09-27 12:39:14 -04:00
cell-bits (first-bignum) ; inline
2007-09-20 18:09:08 -04:00
: most-positive-fixnum ( -- n )
first-bignum 1 - >fixnum ; inline
2007-09-20 18:09:08 -04:00
: most-negative-fixnum ( -- n )
first-bignum neg >fixnum ; inline
: (max-array-capacity) ( b -- n )
6 - 2^ 1 - ; inline
: max-array-capacity ( -- n )
2008-09-27 12:39:14 -04:00
cell-bits (max-array-capacity) ; inline
2008-03-12 02:54:29 -04:00
: bootstrap-first-bignum ( -- n )
bootstrap-cell-bits (first-bignum) ;
: bootstrap-most-positive-fixnum ( -- n )
bootstrap-first-bignum 1 - ;
2008-03-12 02:54:29 -04:00
: bootstrap-most-negative-fixnum ( -- n )
bootstrap-first-bignum neg ;
: bootstrap-max-array-capacity ( -- n )
bootstrap-cell-bits (max-array-capacity) ;
2008-03-08 03:51:26 -05:00
M: bignum >integer
dup most-negative-fixnum most-positive-fixnum between?
[ >fixnum ] when ;
M: real >integer
dup most-negative-fixnum most-positive-fixnum between?
[ >fixnum ] [ >bignum ] if ; inline
UNION: immediate fixnum POSTPONE: f ;