home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / object.h < prev    next >
C/C++ Source or Header  |  2000-12-05  |  19KB  |  512 lines
  1. /* -*-C-*-
  2.  
  3. $Id: object.h,v 9.50 2000/12/05 21:23:46 cph Exp $
  4.  
  5. Copyright (c) 1987-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* This file defines the macros which define and manipulate Scheme
  23.    objects.  This is the lowest level of abstraction in this program. 
  24. */
  25. #ifndef SCM_OBJECT_H
  26. #define SCM_OBJECT_H
  27.  
  28. /* The value in "Wsize.c" for `TYPE_CODE_LENGTH' must match this!! */
  29. #ifndef TYPE_CODE_LENGTH
  30. #  define TYPE_CODE_LENGTH 8
  31. #endif
  32.  
  33. #if defined(MIN_TYPE_CODE_LENGTH) && (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
  34. #  include "Inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
  35. #endif
  36.  
  37. #if (SIZEOF_UNSIGNED_LONG == 4)    /* 32 bit word versions */
  38. #  if (TYPE_CODE_LENGTH == 8)
  39. #    define MAX_TYPE_CODE    0xFF
  40. #    define DATUM_LENGTH    24
  41. #    define FIXNUM_LENGTH    23
  42. #    define FIXNUM_SIGN_BIT    0x00800000
  43. #    define SIGN_MASK        0xFF800000
  44. #    define SMALLEST_FIXNUM    ((long) 0xFF800000)
  45. #    define BIGGEST_FIXNUM    ((long) 0x007FFFFF)
  46. #    define HALF_DATUM_LENGTH    12
  47. #    define HALF_DATUM_MASK    0x00000FFF
  48. #    define DATUM_MASK        0x00FFFFFF
  49. #    define TYPE_CODE_MASK    0xFF000000
  50. #  endif
  51. #  if (TYPE_CODE_LENGTH == 6)
  52. #    define MAX_TYPE_CODE    0x3F
  53. #    define DATUM_LENGTH    26
  54. #    define FIXNUM_LENGTH    25
  55. #    define FIXNUM_SIGN_BIT    0x02000000
  56. #    define SIGN_MASK        0xFE000000
  57. #    define SMALLEST_FIXNUM    ((long) 0xFE000000)
  58. #    define BIGGEST_FIXNUM    ((long) 0x01FFFFFF)
  59. #    define HALF_DATUM_LENGTH    13
  60. #    define HALF_DATUM_MASK    0x00001FFF
  61. #    define DATUM_MASK        0x03FFFFFF
  62. #    define TYPE_CODE_MASK    0XFC000000
  63. #  endif
  64. #endif
  65.  
  66. #ifndef DATUM_LENGTH        /* Safe versions */
  67. #  define MAX_TYPE_CODE        ((1 << TYPE_CODE_LENGTH) - 1)
  68. #  define DATUM_LENGTH        (OBJECT_LENGTH - TYPE_CODE_LENGTH)
  69.    /* FIXNUM_LENGTH does NOT include the sign bit! */
  70. #  define FIXNUM_LENGTH        (DATUM_LENGTH - 1)
  71. #  define FIXNUM_SIGN_BIT    (1L << FIXNUM_LENGTH)
  72. #  define SIGN_MASK        ((long) (-1L << FIXNUM_LENGTH))
  73. #  define SMALLEST_FIXNUM    ((long) (-1L << FIXNUM_LENGTH))
  74. #  define BIGGEST_FIXNUM    ((1L << FIXNUM_LENGTH) - 1)
  75. #  define HALF_DATUM_LENGTH    (DATUM_LENGTH / 2)
  76. #  define HALF_DATUM_MASK    ((1L << HALF_DATUM_LENGTH) - 1)
  77. #  define DATUM_MASK        ((1L << DATUM_LENGTH) - 1)
  78. #  define TYPE_CODE_MASK    (~ DATUM_MASK)
  79. #endif
  80.  
  81. /* Basic object structure */
  82.  
  83. #ifndef OBJECT_TYPE
  84. #ifdef UNSIGNED_SHIFT_BUG
  85. /* This fixes bug in some compilers. */
  86. #define OBJECT_TYPE(object) (((object) >> DATUM_LENGTH) & MAX_TYPE_CODE)
  87. #else
  88. /* Faster for logical shifts */
  89. #define OBJECT_TYPE(object) ((object) >> DATUM_LENGTH)
  90. #endif
  91. #endif
  92.  
  93. #define OBJECT_DATUM(object) ((object) & DATUM_MASK)
  94. #define OBJECT_ADDRESS(object) (DATUM_TO_ADDRESS ((object) & DATUM_MASK))
  95.  
  96. #define MAKE_OBJECT(type, datum)                    \
  97.   ((((unsigned long) (type)) << DATUM_LENGTH) | (datum))
  98.  
  99. #define OBJECT_NEW_DATUM(type_object, datum)                \
  100.   (((type_object) & TYPE_CODE_MASK) | (datum))
  101.  
  102. #define OBJECT_NEW_TYPE(type, datum_object)                \
  103.   (MAKE_OBJECT ((type), (OBJECT_DATUM (datum_object))))
  104.  
  105. #define MAKE_OBJECT_FROM_OBJECTS(type_object, datum_object)        \
  106.   (((type_object) & TYPE_CODE_MASK) | ((datum_object) & DATUM_MASK))
  107.  
  108. #define MAKE_POINTER_OBJECT(type, address)                \
  109.   (MAKE_OBJECT ((type), (ADDRESS_TO_DATUM (address))))
  110.  
  111. #define OBJECT_NEW_ADDRESS(object, address)                \
  112.   (OBJECT_NEW_DATUM ((object), (ADDRESS_TO_DATUM (address))))
  113.  
  114. /* Machine dependencies */
  115.  
  116. #ifndef HEAP_MALLOC
  117. #  define HEAP_MALLOC malloc
  118. #endif
  119.  
  120. #ifdef HEAP_IN_LOW_MEMORY    /* Storing absolute addresses */
  121.  
  122. typedef long relocation_type;    /* Used to relocate pointers on fasload */
  123.  
  124. #define ALLOCATE_HEAP_SPACE(space,low,high) do                \
  125. {                                    \
  126.   unsigned long _space = (space);                    \
  127.   SCHEME_OBJECT * _low                            \
  128.     = ((SCHEME_OBJECT *)                        \
  129.        (HEAP_MALLOC ((sizeof (SCHEME_OBJECT)) * _space)));        \
  130.                                     \
  131.   (low) = _low;                                \
  132.   (high) = (_low + _space);                        \
  133. } while (0)
  134.  
  135. #ifndef DATUM_TO_ADDRESS
  136. #define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) (datum))
  137. #endif
  138.  
  139. #ifndef ADDRESS_TO_DATUM
  140. #define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) (address))
  141. #endif
  142.  
  143. #else /* not HEAP_IN_LOW_MEMORY (portable version) */
  144.  
  145. /* Used to relocate pointers on fasload */
  146.  
  147. typedef SCHEME_OBJECT * relocation_type;
  148.  
  149. extern SCHEME_OBJECT * memory_base;
  150.  
  151. #define ALLOCATE_HEAP_SPACE(space,low,high) do                \
  152. {                                    \
  153.   unsigned long _space = (space);                    \
  154.   memory_base = ((SCHEME_OBJECT *)                    \
  155.          (HEAP_MALLOC ((sizeof (SCHEME_OBJECT)) * _space)));    \
  156.   (low) = memory_base;                            \
  157.   (high) = (memory_base + _space);                    \
  158. } while (0)
  159.  
  160. #ifndef DATUM_TO_ADDRESS
  161. #define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) ((datum) + memory_base))
  162. #endif
  163.  
  164. #ifndef ADDRESS_TO_DATUM
  165. #define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) ((address) - memory_base))
  166. #endif
  167.  
  168. #endif /* HEAP_IN_LOW_MEMORY */
  169.  
  170. #ifndef SCHEME_ADDR_TO_ADDR
  171.   typedef SCHEME_OBJECT * SCHEME_ADDR;
  172. # define SCHEME_ADDR_TO_ADDR(saddr) ((SCHEME_OBJECT *) (saddr))
  173. # define ADDR_TO_SCHEME_ADDR(caddr) ((SCHEME_OBJECT) (caddr))
  174. #endif /* SCHEME_ADDR_TO_ADDR */
  175.  
  176. /* Lots of type predicates */
  177.  
  178. #define FIXNUM_P(object) ((OBJECT_TYPE (object)) == TC_FIXNUM)
  179. #define BIGNUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM)
  180. #define FLONUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FLONUM)
  181. #define COMPLEX_P(object) ((OBJECT_TYPE (object)) == TC_COMPLEX)
  182. #define CHARACTER_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER)
  183. #define STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING)
  184. #define BIT_STRING_P(object) ((OBJECT_TYPE (object)) == TC_BIT_STRING)
  185. #define CELL_P(object) ((OBJECT_TYPE (object)) == TC_CELL)
  186. #define PAIR_P(object) ((OBJECT_TYPE (object)) == TC_LIST)
  187. #define WEAK_PAIR_P(object) ((OBJECT_TYPE (object)) == TC_WEAK_CONS)
  188. #define VECTOR_P(object) ((OBJECT_TYPE (object)) == TC_VECTOR)
  189. #define RECORD_P(object) ((OBJECT_TYPE (object)) == TC_RECORD)
  190. #define BOOLEAN_P(object) (((object) == SHARP_T) || ((object) == SHARP_F))
  191. #define REFERENCE_TRAP_P(object) ((OBJECT_TYPE (object)) == TC_REFERENCE_TRAP)
  192. #define PRIMITIVE_P(object) ((OBJECT_TYPE (object)) == TC_PRIMITIVE)
  193. #define FUTURE_P(object) ((OBJECT_TYPE (object)) == TC_FUTURE)
  194. #define PROMISE_P(object) ((OBJECT_TYPE (object)) == TC_DELAYED)
  195. #define APPARENT_LIST_P(object) (((object) == EMPTY_LIST) || (PAIR_P (object)))
  196. #define CONTROL_POINT_P(object) ((OBJECT_TYPE (object)) == TC_CONTROL_POINT)
  197. #define BROKEN_HEART_P(object) ((OBJECT_TYPE (object)) == TC_BROKEN_HEART)
  198. #define GC_NON_POINTER_P(object) ((GC_Type (object)) == GC_Non_Pointer)
  199. #define GC_CELL_P(object) ((GC_Type (object)) == GC_Cell)
  200. #define GC_PAIR_P(object) ((GC_Type (object)) == GC_Pair)
  201. #define GC_TRIPLE_P(object) ((GC_Type (object)) == GC_Triple)
  202. #define GC_QUADRUPLE_P(object) ((GC_Type (object)) == GC_Quadruple)
  203. #define GC_VECTOR_P(object) ((GC_Type (object)) == GC_Vector)
  204.  
  205. #define COMPILED_CODE_ADDRESS_P(object)                    \
  206.   ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY)
  207.  
  208. #define STACK_ADDRESS_P(object)                        \
  209.   ((OBJECT_TYPE (object)) == TC_STACK_ENVIRONMENT)
  210.  
  211. #define NON_MARKED_VECTOR_P(object)                    \
  212.   ((OBJECT_TYPE (object)) == TC_NON_MARKED_VECTOR)
  213.  
  214. #define SYMBOL_P(object)                        \
  215.   (((OBJECT_TYPE (object)) == TC_INTERNED_SYMBOL) ||            \
  216.    ((OBJECT_TYPE (object)) == TC_UNINTERNED_SYMBOL))
  217.  
  218. #define INTEGER_P(object)                        \
  219.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  220.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM))
  221.  
  222. #define REAL_P(object)                            \
  223.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  224.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) ||                \
  225.    ((OBJECT_TYPE (object)) == TC_BIG_FLONUM))
  226.  
  227. #define NUMBER_P(object)                        \
  228.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  229.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) ||                \
  230.    ((OBJECT_TYPE (object)) == TC_BIG_FLONUM)                \
  231.    ((OBJECT_TYPE (object)) == TC_COMPLEX))
  232.  
  233. #define HUNK3_P(object)                            \
  234.   (((OBJECT_TYPE (object)) == TC_HUNK3_A) ||                \
  235.    ((OBJECT_TYPE (object)) == TC_HUNK3_B))
  236.  
  237. #define INTERPRETER_APPLICABLE_P interpreter_applicable_p
  238.  
  239. #define ENVIRONMENT_P(env)                        \
  240.   ((OBJECT_TYPE (env) == TC_ENVIRONMENT) ||                \
  241.    (OBJECT_TYPE (env) == GLOBAL_ENV))
  242.  
  243. /* Memory Operations */
  244.  
  245. /* The FAST_ operations are used only where the object is known to be
  246.    immutable.  On a parallel processor they don't require atomic
  247.    references. */
  248.  
  249. #define FAST_MEMORY_REF(object, offset)                    \
  250.   ((OBJECT_ADDRESS (object)) [(offset)])
  251.  
  252. #define FAST_MEMORY_SET(object, offset, value)                \
  253.   ((OBJECT_ADDRESS (object)) [(offset)]) = (value)
  254.  
  255. #define MEMORY_LOC(object, offset)                    \
  256.   (& ((OBJECT_ADDRESS (object)) [(offset)]))
  257.  
  258. /* General case memory access requires atomicity for parallel processors. */
  259.  
  260. #define MEMORY_REF(object, offset)                    \
  261.   (MEMORY_FETCH ((OBJECT_ADDRESS (object)) [(offset)]))
  262.  
  263. #define MEMORY_SET(object, offset, value)                \
  264.   MEMORY_STORE (((OBJECT_ADDRESS (object)) [(offset)]), (value))
  265.  
  266. /* Pair Operations */
  267.  
  268. #define FAST_PAIR_CAR(pair) (FAST_MEMORY_REF ((pair), CONS_CAR))
  269. #define FAST_PAIR_CDR(pair) (FAST_MEMORY_REF ((pair), CONS_CDR))
  270. #define FAST_SET_PAIR_CAR(pair, car) FAST_MEMORY_SET ((pair), CONS_CAR, (car))
  271. #define FAST_SET_PAIR_CDR(pair, cdr) FAST_MEMORY_SET ((pair), CONS_CDR, (cdr))
  272. #define PAIR_CAR_LOC(pair) (MEMORY_LOC ((pair), CONS_CAR))
  273. #define PAIR_CDR_LOC(pair) (MEMORY_LOC ((pair), CONS_CDR))
  274.  
  275. #define PAIR_CAR(pair) (MEMORY_REF ((pair), CONS_CAR))
  276. #define PAIR_CDR(pair) (MEMORY_REF ((pair), CONS_CDR))
  277. #define SET_PAIR_CAR(pair, car) MEMORY_SET ((pair), CONS_CAR, (car))
  278. #define SET_PAIR_CDR(pair, cdr) MEMORY_SET ((pair), CONS_CDR, (cdr))
  279.  
  280. /* Vector Operations */
  281.  
  282. #define VECTOR_LENGTH(vector) (OBJECT_DATUM (FAST_MEMORY_REF ((vector), 0)))
  283.  
  284. #define SET_VECTOR_LENGTH(vector, length)                \
  285.   FAST_MEMORY_SET                            \
  286.     ((vector),                                \
  287.      0,                                    \
  288.      (OBJECT_NEW_DATUM ((FAST_MEMORY_REF ((vector), 0)), (length))));
  289.  
  290. #define FAST_VECTOR_REF(vector, index)                    \
  291.   (FAST_MEMORY_REF ((vector), ((index) + 1)))
  292.  
  293. #define FAST_VECTOR_SET(vector, index, value)                \
  294.   FAST_MEMORY_SET ((vector), ((index) + 1), (value))
  295.  
  296. #define VECTOR_LOC(vector, index) (MEMORY_LOC ((vector), ((index) + 1)))
  297. #define VECTOR_REF(vector, index) (MEMORY_REF ((vector), ((index) + 1)))
  298.  
  299. #define VECTOR_SET(vector, index, value)                \
  300.   MEMORY_SET ((vector), ((index) + 1), (value))
  301.  
  302. /* String Operations */
  303.  
  304. /* Add 1 byte to length to account for '\0' at end of string.
  305.    Add 1 word to length to account for string header word. */
  306. #define STRING_LENGTH_TO_GC_LENGTH(length)                \
  307.   ((BYTES_TO_WORDS ((length) + 1)) + 1)
  308.  
  309. #define STRING_LENGTH(string)                        \
  310.   ((long) (MEMORY_REF ((string), STRING_LENGTH_INDEX)))
  311.  
  312. #define SET_STRING_LENGTH(string, length) do                \
  313. {                                    \
  314.   MEMORY_SET ((string), STRING_LENGTH_INDEX, (length));            \
  315.   STRING_SET ((string), (length), '\0');                \
  316. } while (0)
  317.  
  318. /* Subtract 1 to account for the fact that we maintain a '\0'
  319.    at the end of the string. */
  320. #define MAXIMUM_STRING_LENGTH(string)                    \
  321.   ((long) ((((VECTOR_LENGTH (string)) - 1) * (sizeof (SCHEME_OBJECT))) - 1))
  322.  
  323. #define SET_MAXIMUM_STRING_LENGTH(string, length)            \
  324.   SET_VECTOR_LENGTH ((string), (STRING_LENGTH_TO_GC_LENGTH (length)))
  325.  
  326. #define STRING_LOC(string, index)                    \
  327.   (((unsigned char *) (MEMORY_LOC (string, STRING_CHARS))) + (index))
  328.  
  329. #define STRING_REF(string, index)                    \
  330.   ((int) (* (STRING_LOC ((string), (index)))))
  331.  
  332. #define STRING_SET(string, index, c_char)                \
  333.   (* (STRING_LOC ((string), (index)))) = (c_char)
  334.  
  335. /* Character Operations */
  336.  
  337. #define ASCII_LENGTH CHAR_BIT    /* CHAR_BIT in config.h - 8 for unix  */
  338. #define CODE_LENGTH 16
  339. #define BITS_LENGTH 5
  340. #define MIT_ASCII_LENGTH 21
  341.  
  342. #define CHAR_BITS_META         01
  343. #define CHAR_BITS_CONTROL     02
  344. #define CHAR_BITS_CONTROL_META    03
  345.  
  346. #define MAX_ASCII (1L << ASCII_LENGTH)
  347. #define MAX_CODE (1L << CODE_LENGTH)
  348. #define MAX_BITS (1L << BITS_LENGTH)
  349. #define MAX_MIT_ASCII (1L << MIT_ASCII_LENGTH)
  350.  
  351. #define MASK_ASCII (MAX_ASCII - 1)
  352. #define CHAR_MASK_CODE (MAX_CODE - 1)
  353. #define CHAR_MASK_BITS (MAX_BITS - 1)
  354. #define MASK_MIT_ASCII (MAX_MIT_ASCII - 1)
  355.  
  356. #define ASCII_TO_CHAR(ascii) (MAKE_OBJECT (TC_CHARACTER, (ascii)))
  357. #define CHAR_TO_ASCII_P(object) ((OBJECT_DATUM (object)) < MAX_ASCII)
  358. #define CHAR_TO_ASCII(object) ((object) & MASK_ASCII)
  359.  
  360. #define MAKE_CHAR(bucky_bits, code)                    \
  361.   (MAKE_OBJECT                                \
  362.    (TC_CHARACTER,                            \
  363.     (((unsigned long) (bucky_bits)) << (CODE_LENGTH)) | (code)))
  364.  
  365. #define CHAR_BITS(chr)                        \
  366.   ((((unsigned long) (OBJECT_DATUM (chr))) >> CODE_LENGTH) & CHAR_MASK_BITS)
  367.  
  368. #define CHAR_CODE(chr) ((OBJECT_DATUM (chr)) & CHAR_MASK_CODE)
  369.  
  370. /* Fixnum Operations */
  371.  
  372. #define FIXNUM_ZERO_P(fixnum) ((OBJECT_DATUM (fixnum)) == 0)
  373. #define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
  374. #define UNSIGNED_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
  375. #define FIXNUM_EQUAL_P(x, y) ((OBJECT_DATUM (x)) == (OBJECT_DATUM (y)))
  376. #define FIXNUM_LESS_P(x, y) ((FIXNUM_TO_LONG (x)) < (FIXNUM_TO_LONG (y)))
  377.  
  378. #define FIXNUM_POSITIVE_P(fixnum)                    \
  379.   (! ((FIXNUM_ZERO_P (fixnum)) || (FIXNUM_NEGATIVE_P (fixnum))))
  380.  
  381. #define UNSIGNED_FIXNUM_TO_LONG(fixnum) ((long) (OBJECT_DATUM (fixnum)))
  382. #define LONG_TO_UNSIGNED_FIXNUM_P(value) (((value) & SIGN_MASK) == 0)
  383. #define LONG_TO_UNSIGNED_FIXNUM(value) (FIXNUM_ZERO + (value))
  384. #define LONG_TO_FIXNUM(value) (OBJECT_NEW_TYPE (TC_FIXNUM, (value)))
  385.  
  386. #define LONG_TO_FIXNUM_P(value)                        \
  387.   ((((value) & SIGN_MASK) == 0) || (((value) & SIGN_MASK) == SIGN_MASK))
  388.  
  389. #define FIXNUM_TO_LONG(fixnum)                        \
  390.   ((((long) (fixnum)) ^ ((long) FIXNUM_SIGN_BIT))            \
  391.    - ((long) ((((unsigned long) TC_FIXNUM) << DATUM_LENGTH)        \
  392.           | FIXNUM_SIGN_BIT)))
  393.  
  394. #define FIXNUM_TO_DOUBLE(fixnum) ((double) (FIXNUM_TO_LONG (fixnum)))
  395.  
  396. #define DOUBLE_TO_FIXNUM_P(number)                    \
  397.   (((number) > (((double) SMALLEST_FIXNUM) - 0.5)) &&            \
  398.    ((number) < (((double) BIGGEST_FIXNUM) + 0.5)))
  399.  
  400. #ifdef HAVE_DOUBLE_TO_LONG_BUG
  401. #define DOUBLE_TO_FIXNUM double_to_fixnum
  402. #else
  403. #define DOUBLE_TO_FIXNUM(number) (LONG_TO_FIXNUM ((long) (number)))
  404. #endif
  405.  
  406. /* Bignum Operations */
  407.  
  408. #define BIGNUM_ZERO_P(bignum)                        \
  409.   ((bignum_test (bignum)) == bignum_comparison_equal)
  410.  
  411. #define BIGNUM_NEGATIVE_P(bignum)                    \
  412.   ((bignum_test (bignum)) == bignum_comparison_less)
  413.  
  414. #define BIGNUM_POSITIVE_P(bignum)                    \
  415.   ((bignum_test (bignum)) == bignum_comparison_greater)
  416.  
  417. #define BIGNUM_LESS_P(x, y)                        \
  418.   ((bignum_compare ((x), (y))) == bignum_comparison_less)
  419.  
  420. #define BIGNUM_TO_LONG_P(bignum)                    \
  421.   (bignum_fits_in_word_p ((bignum), ((sizeof (long)) * CHAR_BIT), 1))
  422.  
  423. #define BIGNUM_TO_ULONG_P(bignum)                    \
  424.   (bignum_fits_in_word_p ((bignum), ((sizeof (unsigned long)) * CHAR_BIT), 0))
  425.  
  426. /* If precision should not be lost,
  427.    compare to DBL_MANT_DIG instead. */
  428. #define BIGNUM_TO_DOUBLE_P(bignum)                    \
  429.   (bignum_fits_in_word_p ((bignum), DBL_MAX_EXP, 0))
  430.  
  431. /* Flonum Operations */
  432.  
  433. #define FLONUM_SIZE (BYTES_TO_WORDS (sizeof (double)))
  434.  
  435. #define FLONUM_TO_DOUBLE(object)                    \
  436.   (* ((double *) (MEMORY_LOC ((object), 1))))
  437.  
  438. #define FLOAT_TO_FLONUM(expression)                    \
  439.   (double_to_flonum ((double) (expression)))
  440.  
  441. #define FLONUM_TRUNCATE(object)                        \
  442.   (double_to_flonum (double_truncate (FLONUM_TO_DOUBLE (object))))
  443.  
  444. /* Flonum-vector Operations */
  445.  
  446. #define FLOATING_VECTOR_LENGTH(vector)                    \
  447.   ((VECTOR_LENGTH (vector)) / FLONUM_SIZE)
  448.  
  449. #define FLOATING_VECTOR_LOC(vector, index)                \
  450.   ((double *) (VECTOR_LOC ((vector), ((index) * FLONUM_SIZE))))
  451.  
  452. #define FLOATING_VECTOR_REF(vector, index)                \
  453.   (* (FLOATING_VECTOR_LOC ((vector), (index))))
  454.  
  455. #define FLOATING_VECTOR_SET(vector, index, x)                \
  456.   (* (FLOATING_VECTOR_LOC ((vector), (index)))) = ((double) (x))
  457.  
  458. /* Numeric Type Conversions */
  459.  
  460. #define BIGNUM_TO_FIXNUM_P(bignum)                    \
  461.   (bignum_fits_in_word_p ((bignum), (FIXNUM_LENGTH + 1), 1))
  462.  
  463. #define FIXNUM_TO_BIGNUM(fixnum) (long_to_bignum (FIXNUM_TO_LONG (fixnum)))
  464. #define FIXNUM_TO_FLONUM(fixnum) (double_to_flonum (FIXNUM_TO_DOUBLE (fixnum)))
  465. #define BIGNUM_TO_FIXNUM(bignum) (LONG_TO_FIXNUM (bignum_to_long (bignum)))
  466. #define BIGNUM_TO_FLONUM_P BIGNUM_TO_DOUBLE_P
  467. #define BIGNUM_TO_FLONUM(bignum) (double_to_flonum (bignum_to_double (bignum)))
  468. #define FLONUM_TO_BIGNUM(flonum) (double_to_bignum (FLONUM_TO_DOUBLE (flonum)))
  469. #define FLONUM_TO_INTEGER(x) (double_to_integer (FLONUM_TO_DOUBLE (x)))
  470. #define INTEGER_TO_FLONUM_P integer_to_double_p
  471. #define INTEGER_TO_FLONUM(n) (double_to_flonum (integer_to_double (n)))
  472.  
  473. #define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
  474. #define OBJECT_TO_BOOLEAN(object) ((object) != SHARP_F)
  475.  
  476. #define MAKE_BROKEN_HEART(address)                    \
  477.   (BROKEN_HEART_ZERO + (ADDRESS_TO_DATUM (address)))
  478.  
  479. #define BYTES_TO_WORDS(nbytes)                        \
  480.   (((nbytes) + ((sizeof (SCHEME_OBJECT)) - 1)) / (sizeof (SCHEME_OBJECT)))
  481.  
  482. #define ADDRESS_CONSTANT_P(address)                    \
  483.   (((address) >= Constant_Space) && ((address) < Free_Constant))
  484.  
  485. #define ADDRESS_PURE_P(address)                        \
  486.   ((ADDRESS_CONSTANT_P (address)) && (Pure_Test (address)))
  487.  
  488. #define ADDRESS_HEAP_P(address)                        \
  489.   (((address) >= Heap_Bottom) && ((address) < Heap_Top))
  490.  
  491. #define SIDE_EFFECT_IMPURIFY(Old_Pointer, Will_Contain)            \
  492. if ((ADDRESS_CONSTANT_P (OBJECT_ADDRESS (Old_Pointer))) &&        \
  493.     (GC_Type (Will_Contain) != GC_Non_Pointer) &&            \
  494.     (! (ADDRESS_CONSTANT_P (OBJECT_ADDRESS (Will_Contain)))) &&        \
  495.     (Pure_Test (OBJECT_ADDRESS (Old_Pointer))))                \
  496.   signal_error_from_primitive (ERR_WRITE_INTO_PURE_SPACE);        \
  497.  
  498. #ifndef FLOATING_ALIGNMENT
  499. #define FLOATING_ALIGNMENT    0
  500. #endif /* not FLOATING_ALIGNMENT */
  501.  
  502. #define FLOATING_ALIGNED_P(ptr)                        \
  503.   ((((unsigned long) ((ptr) + 1)) & FLOATING_ALIGNMENT) == 0)
  504.  
  505. #define ALIGN_FLOAT(Where) do                        \
  506. {                                    \
  507.   while (! (FLOATING_ALIGNED_P (Where)))                \
  508.     *Where++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));        \
  509. } while (0)
  510.  
  511. #endif /* SCM_OBJECT_H */
  512.