Paste: code in imaginary language Mogun :-)

: drop (| >x |) ;
: dup (| x <x |) ;
: swap (| >x y <x |) ;

GENERIC: downcast ( base -- derived )
GENERIC: cast-unsafe ( base subset -- derived )

SET: fixed { bitcount unsigned } ;

SET: ufixed  = fixed ;
SET: sfixed  = fixed ;

GENERIC: high-bits ( x n -- y )

: high-bits
    (| x n |) [ ufixed? bitcount>> ] [ unsigned? [a,inf] ] bi*
    (| bc n+ |) subset? C! x n bc - shift ;

SET: cell    = fixed { bitcount 32 } ;
SET: pointer = fixed { bitcount 32 } { offsize unsigned } ;

SET: fixnum       < cell ;
SET: tagged-small < cell ;
SET: tagged-large < cell ;

: cell-tags { fixnum tagged-small tagged-large fixnum } ;

: downcast cell? C! dup >ufixed 2 high-bits cell-tags nth cast-unsafe ;

SET: pointer-small = pointer { offsize 12 } ;
SET: pointer-large = pointer { offsize 21 } ;

GENERIC: untag ( tagged -- pointer )
GENERIC: page-mask ( bitcount offsize -- mask )
GENERIC: page ( pointer -- page )

: (untag) C! >ufixed 2 shift ;

: untag tagged-small? C! (untag) >pointer-small ;
: untag tagged-large? C! (untag) >pointer-large ;

: page-mask C! ( >bt >off ) HEX: FFFFFFFF bt integer>ufixed off shift ;

: page pointer? C! dup offsize>> page-mask bitand ;
Author:	Maxim Savchenko
Mode:	factor
Date:	Sat, 23 May 2009 18:03:36