/core/layouts/layouts.factor

http://github.com/abeaumont/factor · Factor · 93 lines · 56 code · 33 blank · 4 comment · 3 complexity · ade9104098e283fc08bf084a27624375 MD5 · raw file

  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 ;
  4. IN: layouts
  5. SYMBOL: data-alignment
  6. SYMBOL: tag-mask
  7. SYMBOL: tag-bits
  8. SYMBOL: num-types
  9. SYMBOL: type-numbers
  10. SYMBOL: mega-cache-size
  11. SYMBOL: header-bits
  12. : type-number ( class -- n )
  13. type-numbers get at ;
  14. : tag-fixnum ( n -- tagged )
  15. tag-bits get shift ;
  16. : tag-header ( n -- tagged )
  17. header-bits get shift ;
  18. : untag-fixnum ( n -- tagged )
  19. tag-bits get neg shift ;
  20. : hashcode-shift ( -- n )
  21. tag-bits get header-bits get + ;
  22. ! We do this in its own compilation unit so that they can be
  23. ! folded below
  24. <<
  25. : cell ( -- n ) OBJ-CELL-SIZE special-object ; foldable
  26. : (fixnum-bits) ( m -- n ) tag-bits get - ; foldable
  27. : (first-bignum) ( m -- n ) (fixnum-bits) 1 - 2^ ; foldable
  28. >>
  29. : cells ( m -- n ) cell * ; inline
  30. : cell-bits ( -- n ) 8 cells ; inline
  31. : bootstrap-cell ( -- n ) \ cell get cell or ; inline
  32. : bootstrap-cells ( m -- n ) bootstrap-cell * ; inline
  33. : bootstrap-cell-bits ( -- n ) 8 bootstrap-cells ; inline
  34. : first-bignum ( -- n )
  35. cell-bits (first-bignum) ; inline
  36. : fixnum-bits ( -- n )
  37. cell-bits (fixnum-bits) ; inline
  38. : most-positive-fixnum ( -- n )
  39. first-bignum 1 - >fixnum ; inline
  40. : most-negative-fixnum ( -- n )
  41. first-bignum neg >fixnum ; inline
  42. : (max-array-capacity) ( b -- n )
  43. 6 - 2^ 1 - ; inline
  44. : max-array-capacity ( -- n )
  45. cell-bits (max-array-capacity) ; inline
  46. : bootstrap-first-bignum ( -- n )
  47. bootstrap-cell-bits (first-bignum) ;
  48. : bootstrap-most-positive-fixnum ( -- n )
  49. bootstrap-first-bignum 1 - ;
  50. : bootstrap-most-negative-fixnum ( -- n )
  51. bootstrap-first-bignum neg ;
  52. : bootstrap-max-array-capacity ( -- n )
  53. bootstrap-cell-bits (max-array-capacity) ;
  54. M: bignum >integer
  55. dup most-negative-fixnum most-positive-fixnum between?
  56. [ >fixnum ] when ;
  57. M: real >integer
  58. dup most-negative-fixnum most-positive-fixnum between?
  59. [ >fixnum ] [ >bignum ] if ; inline
  60. UNION: immediate fixnum POSTPONE: f ;